diff options
| -rwxr-xr-x | Configure | 200 | ||||
| -rw-r--r-- | MANIFEST | 2 | ||||
| -rw-r--r-- | Makefile.SH | 45 | ||||
| -rw-r--r-- | README | 4 | ||||
| -rw-r--r-- | config.h.SH | 19 | ||||
| -rw-r--r-- | cons.c | 18 | ||||
| -rw-r--r-- | consarg.c | 9 | ||||
| -rw-r--r-- | doarg.c | 142 | ||||
| -rw-r--r-- | lib/complete.pl | 19 | ||||
| -rw-r--r-- | lib/ctime.pl | 12 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | t/TEST | 3 | ||||
| -rw-r--r-- | x2p/Makefile.SH | 6 | ||||
| -rw-r--r-- | x2p/a2p.y | 10 |
14 files changed, 362 insertions, 129 deletions
@@ -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.12 90/11/10 00:57:30 lwall Locked $ +# $Header: Configure,v 3.0.1.13 91/01/11 17:01:32 lwall Locked $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than @@ -94,6 +94,7 @@ date='' csh='' Log='' Header='' +alignbytes='' bin='' byteorder='' contains='' @@ -103,6 +104,7 @@ d_bcmp='' d_bcopy='' d_bzero='' d_castneg='' +castflags='' d_charsprf='' d_chsize='' d_crypt='' @@ -113,6 +115,7 @@ d_dup2='' d_fchmod='' d_fchown='' d_fcntl='' +d_flexfnam='' d_flock='' d_getgrps='' d_gethent='' @@ -639,39 +642,6 @@ EOSS chmod +x filexp $eunicefix filexp -: determine where public executables go -case "$bin" in -'') - dflt=`./loc . /bin /usr/local/bin /usr/lbin /usr/local /usr/bin` - ;; -*) dflt="$bin" - ;; -esac -cont=true -while $test "$cont" ; do - echo " " - rp="Where do you want to put the public executables? (~name ok) [$dflt]" - $echo $n "$rp $c" - . myread - bin="$ans" - bin=`./filexp "$bin"` - if test -d $bin; then - cont='' - else - case "$fastread" in - yes) dflt=y;; - *) dflt=n;; - esac - rp="Directory $bin doesn't exist. Use that name anyway? [$dflt]" - $echo $n "$rp $c" - . myread - dflt='' - case "$ans" in - y*) cont='';; - esac - fi -done - : determine where manual pages go $cat <<EOM @@ -1196,6 +1166,71 @@ none) ans=''; esac libs="$ans" +: check for size of random number generator +echo " " +case "$alignbytes" in +'') + echo "Checking alignment constraints..." + $cat >try.c <<'EOCP' +struct foobar { + char foo; + double bar; +} try; +main() +{ + printf("%d\n", (char*)&try.bar - (char*)&try.foo); +} +EOCP + if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then + dflt=`./try` + else + dflt='?' + echo "(I can't seem to compile the test program...)" + fi + ;; +*) + dflt="$alignbytes" + ;; +esac +rp="Doubles must be aligned on a how-many-byte boundary? [$dflt]" +$echo $n "$rp $c" +. myread +alignbytes="$ans" +$rm -f try.c try + +: determine where public executables go +case "$bin" in +'') + dflt=`./loc . /bin /usr/local/bin /usr/lbin /usr/local /usr/bin` + ;; +*) dflt="$bin" + ;; +esac +cont=true +while $test "$cont" ; do + echo " " + rp="Where do you want to put the public executables? (~name ok) [$dflt]" + $echo $n "$rp $c" + . myread + bin="$ans" + bin=`./filexp "$bin"` + if test -d $bin; then + cont='' + else + case "$fastread" in + yes) dflt=y;; + *) dflt=n;; + esac + rp="Directory $bin doesn't exist. Use that name anyway? [$dflt]" + $echo $n "$rp $c" + . myread + dflt='' + case "$ans" in + y*) cont='';; + esac + fi +done + : check for ordering of bytes in a long case "$byteorder" in '') @@ -1249,6 +1284,54 @@ $echo $n "$rp $c" byteorder="$ans" $rm -f try.c try +: check for ability to cast negative floats to unsigned +echo " " +echo 'Checking to see if your C compiler can cast weird floats to unsigned' +$cat >try.c <<'EOCP' +main() +{ + double f = -123; + unsigned long along; + unsigned int aint; + unsigned short ashort; + int result = 0; + + along = (unsigned long)f; + aint = (unsigned int)f; + ashort = (unsigned short)f; + if (along != (unsigned long)-123) + result |= 1; + if (aint != (unsigned int)-123) + result |= 1; + if (ashort != (unsigned short)-123) + result |= 1; + f = (double)0x40000000; + f = f + f; + along = (unsigned long)f; + if (along != 0x80000000) + result |= 2; + f -= 1; + along = (unsigned long)f; + if (along != 0x7fffffff) + result |= 1; + f += 2; + along = (unsigned long)f; + if (along != 0x80000001) + result |= 2; + exit(result); +} +EOCP +if $cc -o try $ccflags try.c >/dev/null 2>&1 && ./try; then + d_castneg="$define" + castflags=0 + echo "Yup, it does." +else + d_castneg="$undef" + castflags=$? + echo "Nope, it doesn't." +fi +$rm -f try.* + : see how we invoke the C preprocessor echo " " echo "Now, how can we feed standard input to your C preprocessor..." @@ -1516,35 +1599,6 @@ eval $inlibc set bzero d_bzero eval $inlibc -: check for ability to cast negative floats to unsigned -echo " " -echo 'Checking to see if your C compiler can cast negative float to unsigned' -$cat >try.c <<'EOCP' -main() -{ - double f = -123; - unsigned long along; - unsigned int aint; - unsigned short ashort; - - along = (unsigned long)f; - aint = (unsigned int)f; - ashort = (unsigned short)f; - if (along == 0L || aint == 0 || ashort == 0) - exit(1); - else - exit(0); -} -EOCP -if $cc -o try $ccflags try.c >/dev/null 2>&1 && ./try; then - d_castneg="$define" - echo "Yup, it does." -else - d_castneg="$undef" - echo "Nope, it doesn't." -fi -$rm -f try.* - : see if sprintf is declared as int or pointer to char echo " " cat >.ucbsprf.c <<'EOF' @@ -1703,6 +1757,23 @@ else echo "No fcntl.h found, but that's ok." fi +: see if we can have long filenames +echo " " +rm -f 123456789abcde +if (echo hi >123456789abcdef) 2>/dev/null; then + : not version 8 + if test -f 123456789abcde; then + echo 'You cannot have filenames longer than 14 characters. Sigh.' + d_flexfnam="$undef" + else + echo 'You can have filenames longer than 14 characters.' + d_flexfnam="$define" + fi +else + : version 8 probably + echo "You can't have filenames longer than 14 chars. V8 can't even think about them!" + d_flexfnam="$undef" +fi : see if flock exists set flock d_flock eval $inlibc @@ -2687,6 +2758,7 @@ date='$date' csh='$csh' Log='$Log' Header='$Header' +alignbytes='$alignbytes' bin='$bin' byteorder='$byteorder' contains='$contains' @@ -2696,6 +2768,7 @@ d_bcmp='$d_bcmp' d_bcopy='$d_bcopy' d_bzero='$d_bzero' d_castneg='$d_castneg' +castflags='$castflags' d_charsprf='$d_charsprf' d_chsize='$d_chsize' d_crypt='$d_crypt' @@ -2706,6 +2779,7 @@ d_dup2='$d_dup2' d_fchmod='$d_fchmod' d_fchown='$d_fchown' d_fcntl='$d_fcntl' +d_flexfnam='$d_flexfnam' d_flock='$d_flock' d_getgrps='$d_getgrps' d_gethent='$d_gethent' @@ -83,6 +83,7 @@ h2pl/tcbreak2 cbreak test routine using .pl handy.h Handy definitions hash.c Associative arrays hash.h Public declarations for the above +installperl Perl script to do "make install" dirty work ioctl.pl Sample ioctl.pl lib/abbrev.pl An abbreviation table builder lib/bigfloat.pl An arbitrary precision floating point package @@ -262,4 +263,3 @@ x2p/str.h Public declarations for the above x2p/util.c Utility routines x2p/util.h Public declarations for the above x2p/walk.c Parse tree walker -config_h.SH Produces config.h. diff --git a/Makefile.SH b/Makefile.SH index 700f229249..7a2bfeb857 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -25,9 +25,12 @@ esac echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! -# $Header: Makefile.SH,v 3.0.1.11 90/11/10 01:25:51 lwall Locked $ +# $Header: Makefile.SH,v 3.0.1.12 91/01/11 17:05:17 lwall Locked $ # # $Log: Makefile.SH,v $ +# Revision 3.0.1.12 91/01/11 17:05:17 lwall +# patch42: added installperl script +# # Revision 3.0.1.11 90/11/10 01:25:51 lwall # patch38: new arbitrary precision libraries from Mark Biggar # @@ -314,45 +317,7 @@ perl.man: perl_man.1 perl_man.2 perl_man.3 perl_man.4 patchlevel.h perl cat perl_man.[1-4] >>perl.man install: all -# won't work with csh - export PATH || exit 1 - - rm -f $(bin)/perl.old $(bin)/suidperl $(bin)/taintperl - - mv $(bin)/perl $(bin)/perl.old 2>/dev/null - - if test `pwd` != $(bin); then cp $(public) $(bin); fi - - cd $(bin); \ -for pub in $(public); do \ -chmod +x `basename $$pub`; \ -done - - chmod 755 $(bin)/taintperl 2>/dev/null -!NO!SUBS! - -case "$d_dosuid" in -*define*) - cat >>Makefile <<'!NO!SUBS!' - - chmod 4711 $(bin)/suidperl 2>/dev/null -!NO!SUBS! - ;; -esac - -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 $(scripts) - - cp $(scripts) $(scriptdir) - - sh ./makedir $(privlib) - - \ -if test `pwd` != $(privlib); then \ -cp $(private) lib/*.pl $(privlib); \ -fi -# cd $(privlib); \ -#for priv in $(private); do \ -#chmod +x `basename $$priv`; \ -#done - - if test `pwd` != $(mansrc); then \ -for page in $(manpages); do \ -cp $$page $(mansrc)/`basename $$page .man`.$(manext); \ -done; \ -fi + ./perl installperl cd x2p; $(MAKE) install clean: @@ -102,6 +102,7 @@ Installation SGI machines may need -Ddouble="long float". Ultrix (2.3) may need to hand assemble teval.s with a -J switch. Ultrix on MIPS machines may need -DLANGUAGE_C. + Ultrix 4.0 on MIPS machines may need -Olimit 2820 or so. Ultrix 3.[01] on MIPS needs to undefine WAITPID--the system call is busted. MIPS machines may need to undef d_volatile. MIPS machines may need to turn off -O on perly.c and tperly.c. @@ -110,10 +111,13 @@ Installation Xenix 386 needs -Sm11000 for yacc, and may need -UM_I86. Genix needs to use libc rather than libc_s, or #undef VARARGS. NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR. + A/UX may appears to work with -O -B/usr/lib/big/ optimizer flags. + A/UX needs -lposix to find rewinddir. A/UX may need -ZP -DPOSIX, and -g if big cc is used. FPS machines may need -J and -DBADSWITCH. UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT. Dnix (not dynix) may need to remove -O. + IRIX 3.3 may need to undefine VFORK. If you get syntax errors on '(', try -DCRIPPLED_CC or -DBADSWITCH or both. Machines with half-implemented dbm routines will need to #undef ODBM & NDBM. C's that don't try to restore registers on longjmp() may need -DJMPCLOBBER. diff --git a/config.h.SH b/config.h.SH index 28ede3df93..ad1f80166c 100644 --- a/config.h.SH +++ b/config.h.SH @@ -37,6 +37,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!' #$d_eunice EUNICE /**/ #$d_eunice VMS /**/ +/* ALIGNBYTES: + * This symbol contains the number of bytes required to align a double. + * Usual values are 2, 4, and 8. + */ +#define ALIGNBYTES $alignbytes /**/ + /* BIN: * This symbol holds the name of the directory in which the user wants * to put publicly executable images for the package in question. It @@ -87,7 +93,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!' * This symbol, if defined, indicates that this C compiler knows how to * cast negative numbers to unsigned longs, ints and shorts. */ +/* CASTFLAGS: + * This symbol contains flags that say what difficulties the compiler + * has casting odd floating values to unsigned long: + * 1 = couldn't cast < 0 + * 2 = couldn't cast >= 0x80000000 + */ #$d_castneg CASTNEGFLOAT /**/ +#define CASTFLAGS $castflags /**/ /* CHARSPRINTF: * This symbol is defined if this system declares "char *sprintf()" in @@ -154,6 +167,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!' */ #$d_fcntl FCNTL /**/ +/* FLEXFILENAMES: + * This symbol, if defined, indicates that the system supports filenames + * longer than 14 characters. + */ +#$d_flexfnam FLEXFILENAMES /**/ + /* FLOCK: * This symbol, if defined, indicates that the flock() routine is * available to do file locking. @@ -1,4 +1,4 @@ -/* $Header: cons.c,v 3.0.1.9 90/11/10 01:10:50 lwall Locked $ +/* $Header: cons.c,v 3.0.1.10 91/01/11 17:33:33 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cons.c,v $ + * Revision 3.0.1.10 91/01/11 17:33:33 lwall + * patch42: the perl debugger was dumping core frequently + * patch42: the postincrement to preincrement optimizer was overzealous + * patch42: foreach didn't localize its temp array properly + * * Revision 3.0.1.9 90/11/10 01:10:50 lwall * patch38: random cleanup * @@ -469,7 +474,7 @@ CMD *cur; cmd->c_type = C_EXPR; cmd->ucmd.acmd.ac_stab = Nullstab; cmd->ucmd.acmd.ac_expr = Nullarg; - cmd->c_expr = make_op(O_SUBR, 1, + cmd->c_expr = make_op(O_SUBR, 2, stab2arg(A_WORD,DBstab), Nullarg, Nullarg); @@ -675,7 +680,8 @@ int acmd; if (arg[flp].arg_flags & (AF_PRE|AF_POST)) { cmd->c_flags |= opt; - if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)) { + if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) + && cmd->c_expr->arg_type == O_ITEM) { arg[flp].arg_flags &= ~AF_POST; /* prefer ++$foo to $foo++ */ arg[flp].arg_flags |= AF_PRE; /* if value not wanted */ } @@ -1305,8 +1311,8 @@ int willsave; /* willsave passes down the tree */ if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) { if (lastcmd && lastcmd->c_type == C_EXPR && - lastcmd->ucmd.acmd.ac_expr) { - ARG *arg = lastcmd->ucmd.acmd.ac_expr; + lastcmd->c_expr) { + ARG *arg = lastcmd->c_expr; if (arg->arg_type == O_ASSIGN && arg[1].arg_type == A_LEXPR && @@ -1315,7 +1321,7 @@ int willsave; /* willsave passes down the tree */ stab_name( arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab), 5)) { /* array generated for foreach */ - (void)localize(arg[1].arg_ptr.arg_arg); + (void)localize(arg); } } @@ -1,4 +1,4 @@ -/* $Header: consarg.c,v 3.0.1.7 90/10/15 15:55:28 lwall Locked $ +/* $Header: consarg.c,v 3.0.1.8 91/01/11 17:37:31 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: consarg.c,v $ + * Revision 3.0.1.8 91/01/11 17:37:31 lwall + * patch42: assignment to a slice didn't supply an array context to RHS + * patch42: suppressed variable suicide on local($a,$b) = @_ + * * Revision 3.0.1.7 90/10/15 15:55:28 lwall * patch29: defined @foo was behaving inconsistently * patch29: -5 % 5 was wrong @@ -721,6 +725,7 @@ register ARG *arg; else if (arg1->arg_type == O_ASLICE) { arg1->arg_type = O_LASLICE; if (arg->arg_type == O_ASSIGN) { + dehoist(arg,2); arg[1].arg_flags |= AF_ARYOK; arg[2].arg_flags |= AF_ARYOK; } @@ -728,6 +733,7 @@ register ARG *arg; else if (arg1->arg_type == O_HSLICE) { arg1->arg_type = O_LHSLICE; if (arg->arg_type == O_ASSIGN) { + dehoist(arg,2); arg[1].arg_flags |= AF_ARYOK; arg[2].arg_flags |= AF_ARYOK; } @@ -1066,6 +1072,7 @@ ARG *arg2; thisexpr++; if (arg_common(arg1,thisexpr,1)) return 0; /* hit eval or do {} */ + stab_lastexpr(defstab) = thisexpr; /* pretend to hit @_ */ if (arg_common(arg2,thisexpr,0)) return 0; /* hit identifier again */ return 1; @@ -1,4 +1,4 @@ -/* $Header: doarg.c,v 3.0.1.9 90/11/10 01:14:31 lwall Locked $ +/* $Header: doarg.c,v 3.0.1.10 91/01/11 17:41:39 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,12 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doarg.c,v $ + * Revision 3.0.1.10 91/01/11 17:41:39 lwall + * patch42: added binary and hex pack/unpack options + * patch42: fixed casting problem with n and N pack options + * patch42: fixed printf("%c", 0) + * patch42: the perl debugger was dumping core frequently + * * Revision 3.0.1.9 90/11/10 01:14:31 lwall * patch38: random cleanup * patch38: optimized join('',...) @@ -516,6 +522,120 @@ int *arglast; } } break; + case 'B': + case 'b': + { + char *savepat = pat; + int saveitems = items; + + fromstr = NEXTFROM; + aptr = str_get(fromstr); + if (pat[-1] == '*') + len = fromstr->str_cur; + pat = aptr; + aint = str->str_cur; + str->str_cur += (len+7)/8; + STR_GROW(str, str->str_cur + 1); + aptr = str->str_ptr + aint; + if (len > fromstr->str_cur) + len = fromstr->str_cur; + aint = len; + items = 0; + if (datumtype == 'B') { + for (len = 0; len++ < aint;) { + items |= *pat++ & 1; + if (len & 7) + items <<= 1; + else { + *aptr++ = items & 0xff; + items = 0; + } + } + } + else { + for (len = 0; len++ < aint;) { + if (*pat++ & 1) + items |= 128; + if (len & 7) + items >>= 1; + else { + *aptr++ = items & 0xff; + items = 0; + } + } + } + if (aint & 7) { + if (datumtype == 'B') + items <<= 7 - (aint & 7); + else + items >>= 7 - (aint & 7); + *aptr++ = items & 0xff; + } + pat = str->str_ptr + str->str_cur; + while (aptr <= pat) + *aptr++ = '\0'; + + pat = savepat; + items = saveitems; + } + break; + case 'H': + case 'h': + { + char *savepat = pat; + int saveitems = items; + + fromstr = NEXTFROM; + aptr = str_get(fromstr); + if (pat[-1] == '*') + len = fromstr->str_cur; + pat = aptr; + aint = str->str_cur; + str->str_cur += (len+1)/2; + STR_GROW(str, str->str_cur + 1); + aptr = str->str_ptr + aint; + if (len > fromstr->str_cur) + len = fromstr->str_cur; + aint = len; + items = 0; + if (datumtype == 'H') { + for (len = 0; len++ < aint;) { + if (isalpha(*pat)) + items |= ((*pat++ & 15) + 9) & 15; + else + items |= *pat++ & 15; + if (len & 1) + items <<= 4; + else { + *aptr++ = items & 0xff; + items = 0; + } + } + } + else { + for (len = 0; len++ < aint;) { + if (isalpha(*pat)) + items |= (((*pat++ & 15) + 9) & 15) << 4; + else + items |= (*pat++ & 15) << 4; + if (len & 1) + items >>= 4; + else { + *aptr++ = items & 0xff; + items = 0; + } + } + } + if (aint & 1) + *aptr++ = items & 0xff; + pat = str->str_ptr + str->str_cur; + while (aptr <= pat) + *aptr++ = '\0'; + + pat = savepat; + items = saveitems; + } + break; case 'C': case 'c': while (len-- > 0) { @@ -577,11 +697,11 @@ int *arglast; case 'N': while (len-- > 0) { fromstr = NEXTFROM; - along = (long)str_gnum(fromstr); + aulong = U_L(str_gnum(fromstr)); #ifdef HTONL - along = htonl(along); + aulong = htonl(aulong); #endif - str_ncat(str,(char*)&along,sizeof(long)); + str_ncat(str,(char*)&aulong,sizeof(unsigned long)); } break; case 'L': @@ -696,6 +816,7 @@ register STR **sarg; *t = '\0'; (void)sprintf(xs,f); len++; + xlen = strlen(xs); break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': @@ -711,9 +832,12 @@ register STR **sarg; if (strEQ(f,"%c")) { /* some printfs fail on null chars */ *xs = xlen; xs[1] = '\0'; + xlen = 1; } - else + else { (void)sprintf(xs,f,xlen); + xlen = strlen(xs); + } break; case 'D': dolong = TRUE; @@ -725,6 +849,7 @@ register STR **sarg; (void)sprintf(xs,f,(long)str_gnum(*(sarg++))); else (void)sprintf(xs,f,(int)str_gnum(*(sarg++))); + xlen = strlen(xs); break; case 'X': case 'O': dolong = TRUE; @@ -737,11 +862,13 @@ register STR **sarg; (void)sprintf(xs,f,U_L(value)); else (void)sprintf(xs,f,U_I(value)); + xlen = strlen(xs); break; case 'E': case 'e': case 'f': case 'G': case 'g': ch = *(++t); *t = '\0'; (void)sprintf(xs,f,str_gnum(*(sarg++))); + xlen = strlen(xs); break; case 's': ch = *(++t); @@ -767,11 +894,11 @@ register STR **sarg; *t = ch; (void)sprintf(buf,tokenbuf+64,xs); xs = buf; + xlen = strlen(xs); break; } /* end of switch, copy results */ *t = ch; - xlen = strlen(xs); STR_GROW(str, str->str_cur + (f - s) + len + 1); str_ncat(str, s, f - s); str_ncat(str, xs, xlen); @@ -880,6 +1007,9 @@ int *arglast; csv->hasargs = hasargs; curcsv = csv; if (sub->usersub) { + csv->hasargs = 0; + csv->savearray = Null(ARRAY*);; + csv->argarray = Null(ARRAY*); st[sp] = arg->arg_ptr.arg_str; if (!hasargs) items = 0; diff --git a/lib/complete.pl b/lib/complete.pl index b59bee32ee..73d3649f8d 100644 --- a/lib/complete.pl +++ b/lib/complete.pl @@ -7,6 +7,7 @@ ;# This routine provides word completion. ;# (TAB) attempts word completion. ;# (^D) prints completion list. +;# (These may be changed by setting $Complete'complete, etc.) ;# ;# Diagnostics: ;# Bell when word completion fails. @@ -15,13 +16,23 @@ ;# The tty driver is put into raw mode. ;# ;# Bugs: -;# The erase and kill characters are hard coded. ;# ;# Usage: ;# $input = do Complete('prompt_string', @completion_list); ;# +CONFIG: { + package Complete; + + $complete = "\004"; + $kill = "\025"; + $erase1 = "\177"; + $erase2 = "\010"; +} + sub Complete { + package Complete; + local ($prompt) = shift (@_); local ($c, $cmp, $l, $r, $ret, $return, $test); @_cmp_lst = sort @_; @@ -49,21 +60,21 @@ sub Complete { print $test = substr ($test, $r, $l - $r); $r = length ($return .= $test); } - elsif ($c eq "\004") { # (^D) completion list + elsif ($c eq $complete) { # (^D) completion list print "\r\n"; foreach $cmp (@_cmp_lst) { print "$cmp\r\n" if $cmp =~ /^$return/; } redo loop; } - elsif ($c eq "\025" && $r) { # (^U) kill + elsif ($c eq $kill && $r) { # (^U) kill $return = ''; $r = 0; print "\r\n"; redo loop; } # (DEL) || (BS) erase - elsif ($c eq "\177" || $c eq "\010") { + elsif ($c eq $erase1 || $c eq $erase2) { if($r) { print "\b \b"; chop ($return); diff --git a/lib/ctime.pl b/lib/ctime.pl index f910db757d..fe6ef51538 100644 --- a/lib/ctime.pl +++ b/lib/ctime.pl @@ -12,11 +12,17 @@ ;# #include <ctime.pl> # see the -P and -I option in perl.man ;# $Date = &ctime(time); -@DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); -@MoY = ('Jan','Feb','Mar','Apr','May','Jun', - 'Jul','Aug','Sep','Oct','Nov','Dec'); +CONFIG: { + package ctime; + + @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); + @MoY = ('Jan','Feb','Mar','Apr','May','Jun', + 'Jul','Aug','Sep','Oct','Nov','Dec'); +} sub ctime { + package ctime; + local($time) = @_; local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst); diff --git a/patchlevel.h b/patchlevel.h index dc3e5edbe4..f037018fd1 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 41 +#define PATCHLEVEL 42 @@ -1,6 +1,6 @@ #!./perl -# $Header: TEST,v 3.0.1.2 90/11/10 02:09:07 lwall Locked $ +# $Header: TEST,v 3.0.1.3 91/01/11 18:28:17 lwall Locked $ # This is written in a peculiar style, since we're trying to avoid # most of the constructs we'll be testing for. @@ -62,6 +62,7 @@ while ($test = shift) { $next = 1; $ok = 1; } else { + $next = $1, $ok = 0, last if /^not ok ([0-9]*)/; if (/^ok (.*)/ && $1 == $next) { $next = $next + 1; } else { diff --git a/x2p/Makefile.SH b/x2p/Makefile.SH index 119a60dae2..4ab3ec9c12 100644 --- a/x2p/Makefile.SH +++ b/x2p/Makefile.SH @@ -5,6 +5,7 @@ case $CONFIG in '') if test ! -f config.sh; then ln ../config.sh . || \ + ln -s ../config.sh . || \ ln ../../config.sh . || \ ln ../../../config.sh . || \ (echo "Can't find config.sh."; exit 1) @@ -18,9 +19,12 @@ case "$mallocsrc" in esac echo "Extracting x2p/Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! -# $Header: Makefile.SH,v 3.0.1.7 90/11/10 02:20:15 lwall Locked $ +# $Header: Makefile.SH,v 3.0.1.8 91/01/11 18:34:40 lwall Locked $ # # $Log: Makefile.SH,v $ +# Revision 3.0.1.8 91/01/11 18:34:40 lwall +# patch42: x2p/Makefile.SH blew up on /afs misfeature +# # Revision 3.0.1.7 90/11/10 02:20:15 lwall # patch38: random cleanup # @@ -1,5 +1,5 @@ %{ -/* $Header: a2p.y,v 3.0.1.2 90/08/09 05:47:26 lwall Locked $ +/* $Header: a2p.y,v 3.0.1.3 91/01/11 18:35:57 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -7,6 +7,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: a2p.y,v $ + * Revision 3.0.1.3 91/01/11 18:35:57 lwall + * patch42: a2p didn't recognize split with regular expression + * patch42: a2p didn't handle > redirection right + * * Revision 3.0.1.2 90/08/09 05:47:26 lwall * patch19: a2p didn't handle {foo = (bar == 123)} * @@ -219,6 +223,8 @@ term : variable { $$ = oper2(OSUBSTR,$3,$5); } | SPLIT '(' expr ',' VAR ',' expr ')' { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),$7); } + | SPLIT '(' expr ',' VAR ',' REGEX ')' + { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),oper1(OREGEX,$7));} | SPLIT '(' expr ',' VAR ')' { $$ = oper2(OSPLIT,$3,aryrefarg(numary($5))); } | INDEX '(' expr ',' expr ')' @@ -371,7 +377,7 @@ simple ; redir : '>' %prec FIELD - { $$ = oper1(OREDIR,$1); } + { $$ = oper1(OREDIR,string(">",1)); } | GRGR { $$ = oper1(OREDIR,string(">>",2)); } | '|' |