Newsgroups: comp.sources.misc From: lwall@netlabs.com (Larry Wall) Subject: v25i065: perl - The perl programming language, Patch16 Message-ID: <1991Nov13.214519.3898@sparky.imd.sterling.com> X-Md4-Signature: 804831971202fcf3ea912a072808a5da Date: Wed, 13 Nov 1991 21:45:19 GMT Approved: kent@sparky.imd.sterling.com Submitted-by: lwall@netlabs.com (Larry Wall) Posting-number: Volume 25, Issue 65 Archive-name: perl/patch16 Environment: UNIX, MS-DOS, OS2 Patch-To: perl: Volume 18, Issue 19-54 System: perl version 4.0 Patch #: 16 Priority: MED-HIGH Subject: patch #11, continued Description: See patch #11. 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 #define PATCHLEVEL 16 Index: lib/perldb.pl Prereq: 4.0.1.1 *** lib/perldb.pl.old Tue Nov 5 19:27:07 1991 --- lib/perldb.pl Tue Nov 5 19:27:08 1991 *************** *** 1,6 **** package DB; ! $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:17:44 $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. --- 1,10 ---- package DB; ! # modified Perl debugger, to be run from Emacs in perldb-mode ! # Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990 ! # Johan Vromans -- upgrade to 4.0 pl 10 ! ! $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:55:58 $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. *************** *** 10,15 **** --- 14,22 ---- # have a breakpoint. It also inserts a do 'perldb.pl' before the first line. # # $Log: perldb.pl,v $ + # Revision 4.0.1.2 91/11/05 17:55:58 lwall + # patch11: perldb.pl modified to run within emacs in perldb-mode + # # Revision 4.0.1.1 91/06/07 11:17:44 lwall # patch4: added $^P variable to control calling of perldb routines # patch4: debugger sometimes listed wrong number of lines for a statement *************** *** 57,64 **** $| = 1; # for real STDOUT $sub = ''; $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; ! print OUT "\nLoading DB routines from $header\n\nEnter h for help.\n\n"; sub DB { &save; --- 64,79 ---- $| = 1; # for real STDOUT $sub = ''; + # Is Perl being run from Emacs? + $emacs = $main'ARGV[$[] eq '-emacs'; + shift(@main'ARGV) if $emacs; + $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; ! print OUT "\nLoading DB routines from $header\n"; ! print OUT ("Emacs support ", ! $emacs ? "enabled" : "available", ! ".\n"); ! print OUT "\nEnter h for help.\n\n"; sub DB { &save; *************** *** 78,88 **** } } if ($single || $trace || $signal) { ! print OUT "$package'" unless $sub =~ /'/; ! print OUT "$sub($filename:$line):\t",$dbline[$line]; ! for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { ! last if $dbline[$i] =~ /^\s*(;|}|#|\n)/; ! print OUT "$sub($filename:$i):\t",$dbline[$i]; } } $evalarg = $action, &eval if $action; --- 93,107 ---- } } if ($single || $trace || $signal) { ! if ($emacs) { ! print OUT "\032\032$filename:$line:0\n"; ! } else { ! print OUT "$package'" unless $sub =~ /'/; ! print OUT "$sub($filename:$line):\t",$dbline[$line]; ! for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { ! last if $dbline[$i] =~ /^\s*(}|#|\n)/; ! print OUT "$sub($filename:$i):\t",$dbline[$i]; ! } } } $evalarg = $action, &eval if $action; *************** *** 244,252 **** $i = $2; $i = $line if $i eq '.'; $i = 1 if $i < 1; ! for (; $i <= $end; $i++) { ! print OUT "$i:\t", $dbline[$i]; ! last if $signal; } $start = $i; # remember in case they want more $start = $max if $start > $max; --- 263,276 ---- $i = $2; $i = $line if $i eq '.'; $i = 1 if $i < 1; ! if ($emacs) { ! print OUT "\032\032$filename:$i:0\n"; ! $i = $end; ! } else { ! for (; $i <= $end; $i++) { ! print OUT "$i:\t", $dbline[$i]; ! last if $signal; ! } } $start = $i; # remember in case they want more $start = $max if $start > $max; *************** *** 393,399 **** $start = 1 if ($start > $max); last if ($start == $end); if ($dbline[$start] =~ m'."\n$pat\n".'i) { ! print OUT "$start:\t", $dbline[$start], "\n"; last; } } '; --- 417,427 ---- $start = 1 if ($start > $max); last if ($start == $end); if ($dbline[$start] =~ m'."\n$pat\n".'i) { ! if ($emacs) { ! print OUT "\032\032$filename:$start:0\n"; ! } else { ! print OUT "$start:\t", $dbline[$start], "\n"; ! } last; } } '; *************** *** 417,423 **** $start = $max if ($start <= 0); last if ($start == $end); if ($dbline[$start] =~ m'."\n$pat\n".'i) { ! print OUT "$start:\t", $dbline[$start], "\n"; last; } } '; --- 445,455 ---- $start = $max if ($start <= 0); last if ($start == $end); if ($dbline[$start] =~ m'."\n$pat\n".'i) { ! if ($emacs) { ! print OUT "\032\032$filename:$start:0\n"; ! } else { ! print OUT "$start:\t", $dbline[$start], "\n"; ! } last; } } '; Index: perly.y *** perly.y.old Tue Nov 5 19:27:37 1991 --- perly.y Tue Nov 5 19:27:37 1991 *************** *** 1,4 **** ! /* $RCSfile: perly.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:42:34 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: perly.y,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:17:38 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * License or the Artistic License, as specified in the README file. * * $Log: perly.y,v $ + * Revision 4.0.1.2 91/11/05 18:17:38 lwall + * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!) + * patch11: once-thru blocks didn't display right in the debugger + * patch11: debugger got confused over nested subroutine definitions + * * Revision 4.0.1.1 91/06/07 11:42:34 lwall * patch4: new copyright notice * *************** *** 18,23 **** --- 23,32 ---- #include "INTERN.h" #include "perl.h" + /*SUPPRESS 530*/ + /*SUPPRESS 593*/ + /*SUPPRESS 595*/ + STAB *scrstab; ARG *arg4; /* rarely used arguments to make_op() */ ARG *arg5; *************** *** 36,41 **** --- 45,52 ---- FCMD *formval; } + %token '{' ')' + %token WORD %token APPEND OPEN SSELECT LOOPEX %token USING FORMAT DO SHIFT PUSH POP LVALFUN *************** *** 49,55 **** %token SUBST PATTERN %token RSTRING TRANS ! %type prog decl format remember %type block lineseq line loop cond sideff nexpr else %type expr sexpr cexpr csexpr term handle aryword hshword %type texpr listop bareword --- 60,66 ---- %token SUBST PATTERN %token RSTRING TRANS ! %type prog decl format remember crp %type block lineseq line loop cond sideff nexpr else %type expr sexpr cexpr csexpr term handle aryword hshword %type texpr listop bareword *************** *** 110,115 **** --- 121,128 ---- block : '{' remember lineseq '}' { $$ = block_head($3); + if (cmdline > $1) + cmdline = $1; if (savestack->ary_fill > $2) restorelist($2); } ; *************** *** 190,196 **** { cmdline = $2; $$ = wopt(add_label($1, invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); } ! | label FOR REG '(' expr ')' compblock { cmdline = $2; /* * The following gobbledygook catches EXPRs that --- 203,209 ---- { cmdline = $2; $$ = wopt(add_label($1, invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); } ! | label FOR REG '(' expr crp compblock { cmdline = $2; /* * The following gobbledygook catches EXPRs that *************** *** 229,235 **** make_ccmd(C_WHILE,$5,$7) ))); } } ! | label FOR '(' expr ')' compblock { cmdline = $2; if ($4->arg_type != O_ARRAY) { scrstab = aadd(genstab()); --- 242,248 ---- make_ccmd(C_WHILE,$5,$7) ))); } } ! | label FOR '(' expr crp compblock { cmdline = $2; if ($4->arg_type != O_ARRAY) { scrstab = aadd(genstab()); *************** *** 303,309 **** ; subrout : SUB WORD block ! { make_sub($2,$3); } ; package : PACKAGE WORD ';' --- 316,325 ---- ; subrout : SUB WORD block ! { make_sub($2,$3); ! cmdline = NOLINE; ! if (savestack->ary_fill > $1) ! restorelist($1); } ; package : PACKAGE WORD ';' *************** *** 443,456 **** stab2arg(A_STAB, $1 == O_FTTTY?stabent("STDIN",TRUE):defstab), Nullarg, Nullarg); } ! | LOCAL '(' expr ')' { $$ = l(localize(make_op(O_ASSIGN, 1, localize(listish(make_list($3))), Nullarg,Nullarg))); } ! | '(' expr ',' ')' { $$ = make_list($2); } - | '(' expr ')' - { $$ = make_list($2); } | '(' ')' { $$ = make_list(Nullarg); } | DO sexpr %prec FILETEST --- 459,470 ---- stab2arg(A_STAB, $1 == O_FTTTY?stabent("STDIN",TRUE):defstab), Nullarg, Nullarg); } ! | LOCAL '(' expr crp { $$ = l(localize(make_op(O_ASSIGN, 1, localize(listish(make_list($3))), Nullarg,Nullarg))); } ! | '(' expr crp { $$ = make_list($2); } | '(' ')' { $$ = make_list(Nullarg); } | DO sexpr %prec FILETEST *************** *** 478,484 **** stab2arg(A_STAB,hadd($1)), jmaybe($3), Nullarg); } ! | '(' expr ')' '[' expr ']' %prec '(' { $$ = make_op(O_LSLICE, 3, Nullarg, listish(make_list($5)), --- 492,498 ---- stab2arg(A_STAB,hadd($1)), jmaybe($3), Nullarg); } ! | '(' expr crp '[' expr ']' %prec '(' { $$ = make_op(O_LSLICE, 3, Nullarg, listish(make_list($5)), *************** *** 513,552 **** { $$ = $1; } | TRANS %prec '(' { $$ = $1; } ! | DO WORD '(' expr ')' { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,TRUE)), make_list($4), Nullarg); Safefree($2); $2 = Nullch; $$->arg_flags |= AF_DEPR; } ! | AMPER WORD '(' expr ')' { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,TRUE)), make_list($4), Nullarg); Safefree($2); $2 = Nullch; } | DO WORD '(' ')' { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,TRUE)), make_list(Nullarg), Nullarg); $$->arg_flags |= AF_DEPR; } | AMPER WORD '(' ')' { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,TRUE)), make_list(Nullarg), Nullarg); } | AMPER WORD { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,TRUE)), Nullarg, Nullarg); } ! | DO REG '(' expr ')' { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, stab2arg(A_STAB,$2), make_list($4), Nullarg); $$->arg_flags |= AF_DEPR; } ! | AMPER REG '(' expr ')' { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, stab2arg(A_STAB,$2), make_list($4), --- 527,566 ---- { $$ = $1; } | TRANS %prec '(' { $$ = $1; } ! | DO WORD '(' expr crp { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,MULTI)), make_list($4), Nullarg); Safefree($2); $2 = Nullch; $$->arg_flags |= AF_DEPR; } ! | AMPER WORD '(' expr crp { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,MULTI)), make_list($4), Nullarg); Safefree($2); $2 = Nullch; } | DO WORD '(' ')' { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,MULTI)), make_list(Nullarg), Nullarg); $$->arg_flags |= AF_DEPR; } | AMPER WORD '(' ')' { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,MULTI)), make_list(Nullarg), Nullarg); } | AMPER WORD { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, ! stab2arg(A_WORD,stabent($2,MULTI)), Nullarg, Nullarg); } ! | DO REG '(' expr crp { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, stab2arg(A_STAB,$2), make_list($4), Nullarg); $$->arg_flags |= AF_DEPR; } ! | AMPER REG '(' expr crp { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2, stab2arg(A_STAB,$2), make_list($4), *************** *** 574,583 **** --- 588,605 ---- Nullarg,Nullarg); } | UNIOP { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); } + | UNIOP block + { $$ = make_op($1,1,cmd_to_arg($2),Nullarg,Nullarg); } | UNIOP sexpr { $$ = make_op($1,1,$2,Nullarg,Nullarg); } | SSELECT { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);} + | SSELECT WORD + { $$ = make_op(O_SELECT, 1, + stab2arg(A_WORD,stabent($2,TRUE)), + Nullarg, + Nullarg); + Safefree($2); $2 = Nullch; } | SSELECT '(' handle ')' { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); } | SSELECT '(' sexpr csexpr csexpr csexpr ')' *************** *** 628,637 **** | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')' { arg4 = $7; arg5 = $8; $$ = make_op($1, 5, $3, $5, $6); } ! | PUSH '(' aryword cexpr ')' { $$ = make_op($1, 2, $3, ! make_list($4), Nullarg); } | POP aryword %prec '(' { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); } --- 650,659 ---- | FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')' { arg4 = $7; arg5 = $8; $$ = make_op($1, 5, $3, $5, $6); } ! | PUSH '(' aryword ',' expr crp { $$ = make_op($1, 2, $3, ! make_list($5), Nullarg); } | POP aryword %prec '(' { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); } *************** *** 671,677 **** $3, listish(make_list($4)), Nullarg); } ! | FLIST '(' expr ')' { $$ = make_op($1, 1, make_list($3), Nullarg, --- 693,699 ---- $3, listish(make_list($4)), Nullarg); } ! | FLIST '(' expr crp { $$ = make_op($1, 1, make_list($3), Nullarg, *************** *** 752,757 **** --- 774,784 ---- stab2arg(A_STAB,$2), maybelistish($1,make_list($3)), Nullarg); } + | LISTOP block expr + { $$ = make_op($1,2, + cmd_to_arg($2), + maybelistish($1,make_list($3)), + Nullarg); } ; handle : WORD *************** *** 774,779 **** --- 801,812 ---- { $$ = stab2arg(A_STAB,$1); } ; + crp : ',' ')' + { $$ = 1; } + | ')' + { $$ = 0; } + ; + /* * NOTE: The following entry must stay at the end of the file so that * reduce/reduce conflicts resolve to it only if it's the only option. *************** *** 785,791 **** $$->arg_type = O_ITEM; $$[1].arg_type = A_SINGLE; $$[1].arg_ptr.arg_str = str_make($1,0); ! for (s = $1; *s && islower(*s); s++) ; if (dowarn && !*s) warn( "\"%s\" may clash with future reserved word", --- 818,824 ---- $$->arg_type = O_ITEM; $$[1].arg_type = A_SINGLE; $$[1].arg_ptr.arg_str = str_make($1,0); ! for (s = $1; *s && isLOWER(*s); s++) ; if (dowarn && !*s) warn( "\"%s\" may clash with future reserved word", Index: regcomp.c *** regcomp.c.old Tue Nov 5 19:27:40 1991 --- regcomp.c Tue Nov 5 19:27:41 1991 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $RCSfile: regcomp.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:48:24 $ * * $Log: regcomp.c,v $ * Revision 4.0.1.2 91/06/07 11:48:24 lwall * patch4: new copyright notice * patch4: /(x+) \1/ incorrectly optimized to not match "xxx xx" --- 7,21 ---- * blame Henry for some of the lack of readability. */ ! /* $RCSfile: regcomp.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:22:28 $ * * $Log: regcomp.c,v $ + * Revision 4.0.1.3 91/11/05 18:22:28 lwall + * patch11: minimum match length calculation in regexp is now cumulative + * patch11: initial .* in pattern had dependency on value of $* + * patch11: certain patterns made use of garbage pointers from uncleared memory + * patch11: prepared for ctype implementations that don't define isascii() + * * Revision 4.0.1.2 91/06/07 11:48:24 lwall * patch4: new copyright notice * patch4: /(x+) \1/ incorrectly optimized to not match "xxx xx" *************** *** 22,28 **** * 4.0 baseline. * */ ! /* * regcomp and regexec -- regsub and regerror are not used in perl * --- 28,34 ---- * 4.0 baseline. * */ ! /*SUPPRESS 112*/ /* * regcomp and regexec -- regsub and regerror are not used in perl * *************** *** 150,155 **** --- 156,162 ---- int backish; int backest; int curback; + int minlen; extern char *safemalloc(); extern char *savestr(); int sawplus = 0; *************** *** 168,174 **** regnpar = 1; regsize = 0L; regcode = ®dummy; ! regc(MAGIC); if (reg(0, &flags) == NULL) { Safefree(regprecomp); regprecomp = Nullch; --- 175,181 ---- regnpar = 1; regsize = 0L; regcode = ®dummy; ! regc((char)MAGIC); if (reg(0, &flags) == NULL) { Safefree(regprecomp); regprecomp = Nullch; *************** *** 193,199 **** regparse = exp; regnpar = 1; regcode = r->program; ! regc(MAGIC); if (reg(0, &flags) == NULL) return(NULL); --- 200,206 ---- regparse = exp; regnpar = 1; regcode = r->program; ! regc((char)MAGIC); if (reg(0, &flags) == NULL) return(NULL); *************** *** 233,239 **** r->regstclass = first; else if (OP(first) == BOL || (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) ) { ! r->reganch = ROPT_ANCH; /* kinda turn .* into ^.* */ first = NEXTOPER(first); goto again; } --- 240,247 ---- r->regstclass = first; else if (OP(first) == BOL || (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) ) { ! /* kinda turn .* into ^.* */ ! r->reganch = ROPT_ANCH | ROPT_IMPLICIT; first = NEXTOPER(first); goto again; } *************** *** 259,264 **** --- 267,273 ---- longish = str_make("",0); longest = str_make("",0); len = 0; + minlen = 0; curback = 0; backish = 0; backest = 0; *************** *** 278,283 **** --- 287,293 ---- first = scan; while (OP(t = regnext(scan)) == CLOSE) scan = t; + minlen += *OPERAND(first); if (curback - backish == len) { str_ncat(longish, OPERAND(first)+1, *OPERAND(first)); *************** *** 303,311 **** --- 313,328 ---- backest = backish; } str_nset(longish,"",0); + if (OP(scan) == PLUS && + index(simple,OP(NEXTOPER(scan)))) + minlen++; + else if (OP(scan) == CURLY && + index(simple,OP(NEXTOPER(scan)+4))) + minlen += ARG1(scan); } else if (index(simple,OP(scan))) { curback++; + minlen++; len = 0; if (longish->str_cur > longest->str_cur) { str_sset(longest,longish); *************** *** 328,335 **** && (!r->regstart || ! !fbminstr(r->regstart->str_ptr, ! r->regstart->str_ptr + r->regstart->str_cur, longest) ) ) --- 345,353 ---- && (!r->regstart || ! !fbminstr((unsigned char*) r->regstart->str_ptr, ! (unsigned char *) r->regstart->str_ptr ! + r->regstart->str_cur, longest) ) ) *************** *** 354,361 **** r->do_folding = fold; r->nparens = regnpar - 1; ! New(1002, r->startp, regnpar, char*); ! New(1002, r->endp, regnpar, char*); #ifdef DEBUGGING if (debug & 512) regdump(r); --- 372,380 ---- r->do_folding = fold; r->nparens = regnpar - 1; ! r->minlen = minlen; ! Newz(1002, r->startp, regnpar, char*); ! Newz(1002, r->endp, regnpar, char*); #ifdef DEBUGGING if (debug & 512) regdump(r); *************** *** 515,521 **** if (op == '{' && regcurly(regparse)) { next = regparse + 1; max = Nullch; ! while (isdigit(*next) || *next == ',') { if (*next == ',') { if (max) break; --- 534,540 ---- if (op == '{' && regcurly(regparse)) { next = regparse + 1; max = Nullch; ! while (isDIGIT(*next) || *next == ',') { if (*next == ',') { if (max) break; *************** *** 758,764 **** else { regsawback = 1; ret = reganode(REF, num); ! while (isascii(*regparse) && isdigit(*regparse)) regparse++; *flagp |= SIMPLE; } --- 777,783 ---- else { regsawback = 1; ret = reganode(REF, num); ! while (isDIGIT(*regparse)) regparse++; *flagp |= SIMPLE; } *************** *** 839,845 **** case 'c': p++; ender = *p++; ! if (islower(ender)) ender = toupper(ender); ender ^= 64; break; --- 858,864 ---- case 'c': p++; ender = *p++; ! if (isLOWER(ender)) ender = toupper(ender); ender ^= 64; break; *************** *** 846,852 **** case '0': case '1': case '2': case '3':case '4': case '5': case '6': case '7': case '8':case '9': if (*p == '0' || ! (isdigit(p[1]) && atoi(p) >= regnpar) ) { ender = scanoct(p, 3, &numlen); p += numlen; } --- 865,871 ---- case '0': case '1': case '2': case '3':case '4': case '5': case '6': case '7': case '8':case '9': if (*p == '0' || ! (isDIGIT(p[1]) && atoi(p) >= regnpar) ) { ender = scanoct(p, 3, &numlen); p += numlen; } *************** *** 868,874 **** ender = *p++; break; } ! if (regfold && isupper(ender)) ender = tolower(ender); if (ISMULT2(p)) { /* Back off on ?+*. */ if (len) --- 887,893 ---- ender = *p++; break; } ! if (regfold && isUPPER(ender)) ender = tolower(ender); if (ISMULT2(p)) { /* Back off on ?+*. */ if (len) *************** *** 992,998 **** break; case 'c': class = *regparse++; ! if (islower(class)) class = toupper(class); class ^= 64; break; --- 1011,1017 ---- break; case 'c': class = *regparse++; ! if (isLOWER(class)) class = toupper(class); class ^= 64; break; *************** *** 1019,1025 **** } for ( ; lastclass <= class; lastclass++) { regset(bits,def,lastclass); ! if (regfold && isupper(lastclass)) regset(bits,def,tolower(lastclass)); } lastclass = class; --- 1038,1044 ---- } for ( ; lastclass <= class; lastclass++) { regset(bits,def,lastclass); ! if (regfold && isUPPER(lastclass)) regset(bits,def,tolower(lastclass)); } lastclass = class; *************** *** 1226,1238 **** { if (*s++ != '{') return FALSE; ! if (!isdigit(*s)) return FALSE; ! while (isdigit(*s)) s++; if (*s == ',') s++; ! while (isdigit(*s)) s++; if (*s != '}') return FALSE; --- 1245,1257 ---- { if (*s++ != '{') return FALSE; ! if (!isDIGIT(*s)) return FALSE; ! while (isDIGIT(*s)) s++; if (*s == ',') s++; ! while (isDIGIT(*s)) s++; if (*s != '}') return FALSE; *************** *** 1292,1300 **** --- 1311,1322 ---- fprintf(stderr,"anchored "); if (r->reganch & ROPT_SKIP) fprintf(stderr,"plus "); + if (r->reganch & ROPT_IMPLICIT) + fprintf(stderr,"implicit "); if (r->regmust != NULL) fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr, r->regback); + fprintf(stderr, "minlen %d ", r->minlen); fprintf(stderr,"\n"); } Index: regexec.c *** regexec.c.old Tue Nov 5 19:27:44 1991 --- regexec.c Tue Nov 5 19:27:44 1991 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $RCSfile: regexec.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:50:33 $ * * $Log: regexec.c,v $ * Revision 4.0.1.2 91/06/07 11:50:33 lwall * patch4: new copyright notice * patch4: // wouldn't use previous pattern if it started with a null character --- 7,19 ---- * blame Henry for some of the lack of readability. */ ! /* $RCSfile: regexec.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:23:55 $ * * $Log: regexec.c,v $ + * Revision 4.0.1.3 91/11/05 18:23:55 lwall + * patch11: prepared for ctype implementations that don't define isascii() + * patch11: initial .* in pattern had dependency on value of $* + * * Revision 4.0.1.2 91/06/07 11:50:33 lwall * patch4: new copyright notice * patch4: // wouldn't use previous pattern if it started with a null character *************** *** 21,27 **** * 4.0 baseline. * */ ! /* * regcomp and regexec -- regsub and regerror are not used in perl * --- 25,31 ---- * 4.0 baseline. * */ ! /*SUPPRESS 112*/ /* * regcomp and regexec -- regsub and regerror are not used in perl * *************** *** 65,75 **** int regnarrate = 0; #endif - #define isALNUM(c) (isascii(c) && (isalpha(c) || isdigit(c) || c == '_')) - #define isSPACE(c) (isascii(c) && isspace(c)) - #define isDIGIT(c) (isascii(c) && isdigit(c)) - #define isUPPER(c) (isascii(c) && isupper(c)) - /* * regexec and friends */ --- 69,74 ---- *************** *** 221,227 **** if (prog->reganch & ROPT_ANCH) { if (regtry(prog, string)) goto got_it; ! else if (multiline) { if (minlen) dontbother = minlen - 1; strend -= dontbother; --- 220,226 ---- if (prog->reganch & ROPT_ANCH) { if (regtry(prog, string)) goto got_it; ! else if (multiline || (prog->reganch & ROPT_IMPLICIT)) { if (minlen) dontbother = minlen - 1; strend -= dontbother; *************** *** 279,284 **** --- 278,284 ---- } goto phooey; } + /*SUPPRESS 560*/ if (c = prog->regstclass) { int doevery = (prog->reganch & ROPT_SKIP) == 0; *************** *** 721,726 **** --- 721,727 ---- if (regmatch(NEXTOPER(scan))) return(1); #ifdef REGALIGN + /*SUPPRESS 560*/ if (n = NEXT(scan)) scan += n; else Index: stab.c *** stab.c.old Tue Nov 5 19:27:48 1991 --- stab.c Tue Nov 5 19:27:49 1991 *************** *** 1,4 **** ! /* $RCSfile: stab.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:55:53 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: stab.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:35:33 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,18 ---- * License or the Artistic License, as specified in the README file. * * $Log: stab.c,v $ + * Revision 4.0.1.3 91/11/05 18:35:33 lwall + * patch11: length($x) was sometimes wrong for numeric $x + * patch11: perl now issues warning if $SIG{'ALARM'} is referenced + * patch11: *foo = undef coredumped + * patch11: solitary subroutine references no longer trigger typo warnings + * patch11: local(*FILEHANDLE) had a memory leak + * * Revision 4.0.1.2 91/06/07 11:55:53 lwall * patch4: new copyright notice * patch4: added $^P variable to control calling of perldb routines *************** *** 247,253 **** char *s; if (str->str_rare) ! return stab_val(stab)->str_cur; switch (*stab->str_magic->str_ptr) { case '1': case '2': case '3': case '4': --- 254,260 ---- char *s; if (str->str_rare) ! return str_len(stab_val(stab)); switch (*stab->str_magic->str_ptr) { case '1': case '2': case '3': case '4': *************** *** 303,309 **** case '\\': return (STRLEN)orslen; default: ! return stab_str(str)->str_cur; } } --- 310,316 ---- case '\\': return (STRLEN)orslen; default: ! return str_len(stab_str(str)); } } *************** *** 311,317 **** register STR *mstr; STR *str; { ! STAB *stab = mstr->str_u.str_stab; register char *s; int i; --- 318,324 ---- register STR *mstr; STR *str; { ! STAB *stab; register char *s; int i; *************** *** 338,343 **** --- 345,352 ---- case 'S': s = str_get(str); i = whichsig(mstr->str_ptr); /* ...no, a brick */ + if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM"))) + warn("No such signal: SIG%s", mstr->str_ptr); if (strEQ(s,"IGNORE")) #ifndef lint (void)signal(i,SIG_IGN); *************** *** 356,361 **** --- 365,371 ---- break; #ifdef SOME_DBM case 'D': + stab = mstr->str_u.str_stab; hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str); break; #endif *************** *** 363,368 **** --- 373,379 ---- { CMD *cmd; + stab = mstr->str_u.str_stab; i = str_true(str); str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE); cmd = str->str_magic->str_u.str_cmd; *************** *** 371,386 **** } break; case '#': afill(stab_array(stab), (int)str_gnum(str) - arybase); break; case 'X': /* merely a copy of a * string */ break; case '*': ! s = str_get(str); if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) { if (!*s) { STBP *stbp; (void)savenostab(stab); /* schedule a free of this stab */ if (stab->str_len) Safefree(stab->str_ptr); --- 382,400 ---- } break; case '#': + stab = mstr->str_u.str_stab; afill(stab_array(stab), (int)str_gnum(str) - arybase); break; case 'X': /* merely a copy of a * string */ break; case '*': ! s = str->str_pok ? str_get(str) : ""; if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) { + stab = mstr->str_u.str_stab; if (!*s) { STBP *stbp; + /*SUPPRESS 701*/ (void)savenostab(stab); /* schedule a free of this stab */ if (stab->str_len) Safefree(stab->str_ptr); *************** *** 402,408 **** if (!stab_io(stab)) stab_io(stab) = stio_new(); } ! str_sset(str,stab); } break; case 's': { --- 416,422 ---- if (!stab_io(stab)) stab_io(stab) = stio_new(); } ! str_sset(str, (STR*) stab); } break; case 's': { *************** *** 422,427 **** --- 436,444 ---- break; case 0: + /*SUPPRESS 560*/ + if (!(stab = mstr->str_u.str_stab)) + break; switch (*stab->str_magic->str_ptr) { case '\004': /* ^D */ #ifdef DEBUGGING *************** *** 711,716 **** --- 728,734 ---- sig_name[sig], stab_name(stab) ); return; } + /*SUPPRESS 701*/ saveaptr(&stack); str = Str_new(15, sizeof(CSV)); str->str_state = SS_SCSV; *************** *** 791,797 **** char *prevquote = Nullch; bool global = FALSE; ! if (isascii(*name) && isupper(*name)) { if (*name > 'I') { if (*name == 'S' && ( strEQ(name, "SIG") || --- 809,815 ---- char *prevquote = Nullch; bool global = FALSE; ! if (isUPPER(*name)) { if (*name > 'I') { if (*name == 'S' && ( strEQ(name, "SIG") || *************** *** 822,830 **** sawquote = Nullch; name++; } ! else if (!isalpha(*name) || global) stash = defstash; ! else if (curcmd == &compiling) stash = curstash; else stash = curcmd->c_stash; --- 840,848 ---- sawquote = Nullch; name++; } ! else if (!isALPHA(*name) || global) stash = defstash; ! else if ((CMD*)curcmd == &compiling) stash = curstash; else stash = curcmd->c_stash; *************** *** 833,838 **** --- 851,857 ---- char *s, *d; *sawquote = '\0'; + /*SUPPRESS 560*/ if (s = prevquote) { strncpy(tmpbuf,name,s-name+1); d = tmpbuf+(s-name+1); *************** *** 869,880 **** strcpy(stab_magic(stab),"StB"); stab_val(stab) = Str_new(72,0); stab_line(stab) = curcmd->c_line; ! str_magic(stab,stab,'*',name,len); stab_stash(stab) = stash; ! if (isdigit(*name) && *name != '0') { stab_flags(stab) = SF_VMAGIC; str_magic(stab_val(stab), stab, 0, Nullch, 0); } return stab; } } --- 888,901 ---- strcpy(stab_magic(stab),"StB"); stab_val(stab) = Str_new(72,0); stab_line(stab) = curcmd->c_line; ! str_magic((STR*)stab, stab, '*', name, len); stab_stash(stab) = stash; ! if (isDIGIT(*name) && *name != '0') { stab_flags(stab) = SF_VMAGIC; str_magic(stab_val(stab), stab, 0, Nullch, 0); } + if (add & 2) + stab->str_pok |= SP_MULTI; return stab; } } *************** *** 945,955 **** --- 966,979 ---- stab_xhash(stab) = Null(HASH*); str_free(stab_val(stab)); stab_val(stab) = Nullstr; + /*SUPPRESS 560*/ if (stio = stab_io(stab)) { do_close(stab,FALSE); Safefree(stio->top_name); Safefree(stio->fmt_name); + Safefree(stio); } + /*SUPPRESS 560*/ if (sub = stab_sub(stab)) { afree(sub->tosave); cmd_free(sub->cmd); Index: stab.h *** stab.h.old Tue Nov 5 19:27:51 1991 --- stab.h Tue Nov 5 19:27:52 1991 *************** *** 1,4 **** ! /* $RCSfile: stab.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:56:35 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: stab.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:36:15 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * License or the Artistic License, as specified in the README file. * * $Log: stab.h,v $ + * Revision 4.0.1.2 91/11/05 18:36:15 lwall + * patch11: length($x) was sometimes wrong for numeric $x + * * Revision 4.0.1.1 91/06/07 11:56:35 lwall * patch4: new copyright notice * patch4: length($`), length($&), length($') now optimized to avoid string copy *************** *** 100,106 **** STRLEN stab_len(); #define STAB_STR(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_str(stab_val(tmpstab)->str_magic) : stab_val(tmpstab)) ! #define STAB_LEN(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_len(stab_val(tmpstab)->str_magic) : stab_val(tmpstab)->str_cur) #define STAB_GET(s) (tmpstab = (s), str_get(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab))) #define STAB_GNUM(s) (tmpstab = (s), str_gnum(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab))) --- 103,109 ---- STRLEN stab_len(); #define STAB_STR(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_str(stab_val(tmpstab)->str_magic) : stab_val(tmpstab)) ! #define STAB_LEN(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_len(stab_val(tmpstab)->str_magic) : str_len(stab_val(tmpstab))) #define STAB_GET(s) (tmpstab = (s), str_get(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab))) #define STAB_GNUM(s) (tmpstab = (s), str_gnum(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab))) Index: t/op/stat.t *** t/op/stat.t.old Tue Nov 5 19:28:06 1991 --- t/op/stat.t Tue Nov 5 19:28:06 1991 *************** *** 1,6 **** #!./perl ! # $RCSfile: stat.t,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:02:42 $ print "1..56\n"; --- 1,6 ---- #!./perl ! # $RCSfile: stat.t,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:44:44 $ print "1..56\n"; *************** *** 9,23 **** $DEV = `ls -l /dev`; unlink "Op.stat.tmp"; ! open(foo, ">Op.stat.tmp"); ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, ! $blksize,$blocks) = stat(foo); if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";} 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); sleep 2; --- 9,23 ---- $DEV = `ls -l /dev`; unlink "Op.stat.tmp"; ! open(FOO, ">Op.stat.tmp"); ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, ! $blksize,$blocks) = stat(FOO); if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";} 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); sleep 2; *************** *** 141,164 **** if (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";} if (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";} ! open(foo,'op/stat.t'); ! if (-T foo) {print "ok 45\n";} else {print "not ok 45\n";} ! if (! -B foo) {print "ok 46\n";} else {print "not ok 46\n";} ! $_ = ; ! if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";} ! if (-T foo) {print "ok 48\n";} else {print "not ok 48\n";} ! if (! -B foo) {print "ok 49\n";} else {print "not ok 49\n";} ! close(foo); ! open(foo,'op/stat.t'); ! $_ = ; ! if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";} ! if (-T foo) {print "ok 51\n";} else {print "not ok 51\n";} ! if (! -B foo) {print "ok 52\n";} else {print "not ok 52\n";} ! seek(foo,0,0); ! if (-T foo) {print "ok 53\n";} else {print "not ok 53\n";} ! if (! -B foo) {print "ok 54\n";} else {print "not ok 54\n";} ! close(foo); if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";} if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";} --- 141,173 ---- if (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";} if (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";} ! open(FOO,'op/stat.t'); ! eval { -T FOO; }; ! if ($@ =~ /not implemented/) { ! print "# $@"; ! for (45 .. 54) { ! print "ok $_\n"; ! } ! } ! else { ! if (-T FOO) {print "ok 45\n";} else {print "not ok 45\n";} ! if (! -B FOO) {print "ok 46\n";} else {print "not ok 46\n";} ! $_ = ; ! if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";} ! if (-T FOO) {print "ok 48\n";} else {print "not ok 48\n";} ! if (! -B FOO) {print "ok 49\n";} else {print "not ok 49\n";} ! close(FOO); ! open(FOO,'op/stat.t'); ! $_ = ; ! if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";} ! if (-T FOO) {print "ok 51\n";} else {print "not ok 51\n";} ! if (! -B FOO) {print "ok 52\n";} else {print "not ok 52\n";} ! seek(FOO,0,0); ! if (-T FOO) {print "ok 53\n";} else {print "not ok 53\n";} ! if (! -B FOO) {print "ok 54\n";} else {print "not ok 54\n";} ! } ! close(FOO); if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";} if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";} Index: hints/stellar.sh *** hints/stellar.sh.old Tue Nov 5 19:26:37 1991 --- hints/stellar.sh Tue Nov 5 19:26:38 1991 *************** *** 0 **** --- 1,2 ---- + optimize="-O0" + ccflags="$ccflags -nw" Index: str.c *** str.c.old Tue Nov 5 19:27:54 1991 --- str.c Tue Nov 5 19:27:55 1991 *************** *** 1,4 **** ! /* $RCSfile: str.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:27:54 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: str.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:40:51 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * License or the Artistic License, as specified in the README file. * * $Log: str.c,v $ + * Revision 4.0.1.4 91/11/05 18:40:51 lwall + * patch11: $foo .= could overrun malloced memory + * patch11: \$ didn't always make it through double-quoter to regexp routines + * patch11: prepared for ctype implementations that don't define isascii() + * * Revision 4.0.1.3 91/06/10 01:27:54 lwall * patch10: $) and $| incorrectly handled in run-time patterns * *************** *** 255,260 **** --- 260,266 ---- } str_nset(dstr,sstr->str_ptr,sstr->str_cur); } + /*SUPPRESS 560*/ if (dstr->str_nok = sstr->str_nok) dstr->str_u.str_nval = sstr->str_u.str_nval; else { *************** *** 556,561 **** --- 562,568 ---- *mid = '\0'; bigstr->str_cur = mid - big; } + /*SUPPRESS 560*/ else if (i = mid - big) { /* faster from front */ midend -= littlelen; mid = midend; *************** *** 709,719 **** --- 716,728 ---- (void)str_2ptr(str2); if (str1->str_cur < str2->str_cur) { + /*SUPPRESS 560*/ if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur)) return retval < 0 ? -1 : 1; else return -1; } + /*SUPPRESS 560*/ else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur)) return retval < 0 ? -1 : 1; else if (str1->str_cur == str2->str_cur) *************** *** 742,748 **** cnt = fp->_cnt; /* get count into register */ str->str_nok = 0; /* invalidate number */ str->str_pok = 1; /* validate pointer */ ! if (str->str_len <= cnt + 1) { /* make sure we have the room */ if (cnt > 80 && str->str_len > append) { shortbuffered = cnt - str->str_len + append + 1; cnt -= shortbuffered; --- 751,757 ---- cnt = fp->_cnt; /* get count into register */ str->str_nok = 0; /* invalidate number */ str->str_pok = 1; /* validate pointer */ ! if (str->str_len - append <= cnt + 1) { /* make sure we have the room */ if (cnt > 80 && str->str_len > append) { shortbuffered = cnt - str->str_len + append + 1; cnt -= shortbuffered; *************** *** 928,941 **** if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) { str_ncat(str, t, s - t); ++s; ! if (isalpha(*s)) { str_ncat(str, "$c", 2); sawcase = (*s != 'E'); } else { ! if (*nointrp && s+1 < send) ! if (*s != '@' && (*s != '$' || index(nointrp,s[1]))) str_ncat(str,s-1,1); str_ncat(str, "$b", 2); } str_ncat(str, s, 1); --- 937,957 ---- if (*s == '\\' && s[1] && index("$@[{\\]}lLuUE",s[1])) { str_ncat(str, t, s - t); ++s; ! if (isALPHA(*s)) { str_ncat(str, "$c", 2); sawcase = (*s != 'E'); } else { ! if (*nointrp) { /* in a regular expression */ ! if (*s == '@') /* always strip \@ */ /*SUPPRESS 530*/ ! ; ! else if (*s == '$') { ! if (s+1 >= send || index(nointrp, s[1])) ! str_ncat(str,s-1,1); /* only strip \$ for vars */ ! } ! else /* don't strip \\, \[, \{ etc. */ str_ncat(str,s-1,1); + } str_ncat(str, "$b", 2); } str_ncat(str, s, 1); *************** *** 952,958 **** else if ((*s == '@' || *s == '$') && s+1 < send) { str_ncat(str,t,s-t); t = s; ! if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) s++; s = scanident(s,send,tokenbuf); if (*t == '@' && --- 968,974 ---- else if ((*s == '@' || *s == '$') && s+1 < send) { str_ncat(str,t,s-t); t = s; ! if (*s == '$' && s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) s++; s = scanident(s,send,tokenbuf); if (*t == '@' && *************** *** 988,993 **** --- 1004,1010 ---- case '\'': case '"': if (s[-1] != '$') { + /*SUPPRESS 68*/ s = cpytill(tokenbuf,s+1,send,*s,&len); if (s >= send) fatal("Unterminated string"); *************** *** 1002,1011 **** d = checkpoint; if (*d == '{' && s[-1] == '}') { /* maybe {n,m} */ ++d; ! if (isdigit(*d)) { /* matches /^{\d,?\d*}$/ */ if (*++d == ',') ++d; ! while (isdigit(*d)) d++; if (d == s - 1) s = checkpoint; /* Is {n,m}! Backoff! */ --- 1019,1028 ---- d = checkpoint; if (*d == '{' && s[-1] == '}') { /* maybe {n,m} */ ++d; ! if (isDIGIT(*d)) { /* matches /^{\d,?\d*}$/ */ if (*++d == ',') ++d; ! while (isDIGIT(*d)) d++; if (d == s - 1) s = checkpoint; /* Is {n,m}! Backoff! */ *************** *** 1022,1030 **** weight += 150; else if (d[1] == '$') weight -= 3; ! if (isdigit(d[1])) { if (d[2]) { ! if (isdigit(d[2]) && !d[3]) weight -= 10; } else --- 1039,1047 ---- weight += 150; else if (d[1] == '$') weight -= 3; ! if (isDIGIT(d[1])) { if (d[2]) { ! if (isDIGIT(d[2]) && !d[3]) weight -= 10; } else *************** *** 1037,1044 **** case '&': case '$': weight -= seen[un_char] * 10; ! if (isalpha(d[1]) || isdigit(d[1]) || ! d[1] == '_') { d = scanident(d,s,tokenbuf); if (stabent(tokenbuf,FALSE)) weight -= 100; --- 1054,1060 ---- case '&': case '$': weight -= seen[un_char] * 10; ! if (isALNUM(d[1])) { d = scanident(d,s,tokenbuf); if (stabent(tokenbuf,FALSE)) weight -= 100; *************** *** 1062,1070 **** weight += 1; else if (index("rnftb",d[1])) weight += 40; ! else if (isdigit(d[1])) { weight += 40; ! while (d[1] && isdigit(d[1])) d++; } } --- 1078,1086 ---- weight += 1; else if (index("rnftb",d[1])) weight += 40; ! else if (isDIGIT(d[1])) { weight += 40; ! while (d[1] && isDIGIT(d[1])) d++; } } *************** *** 1082,1088 **** else weight -= 1; default: ! if (isalpha(*d) && d[1] && isalpha(d[1])) { bufptr = d; if (yylex() != WORD) weight -= 150; --- 1098,1104 ---- else weight -= 1; default: ! if (isALPHA(*d) && d[1] && isALPHA(d[1])) { bufptr = d; if (yylex() != WORD) weight -= 150; *************** *** 1243,1249 **** register char *send; { while (s < send) { ! if (isascii(*s) && islower(*s)) *s = toupper(*s); s++; } --- 1259,1265 ---- register char *send; { while (s < send) { ! if (isLOWER(*s)) *s = toupper(*s); s++; } *************** *** 1254,1260 **** register char *send; { while (s < send) { ! if (isascii(*s) && isupper(*s)) *s = tolower(*s); s++; } --- 1270,1276 ---- register char *send; { while (s < send) { ! if (isUPPER(*s)) *s = tolower(*s); s++; } *************** *** 1280,1287 **** return; } d = str->str_ptr; ! while (isalpha(*d)) d++; ! while (isdigit(*d)) d++; if (*d) { str_numset(str,atof(str->str_ptr) + 1.0); /* punt */ return; --- 1296,1303 ---- return; } d = str->str_ptr; ! while (isALPHA(*d)) d++; ! while (isDIGIT(*d)) d++; if (*d) { str_numset(str,atof(str->str_ptr) + 1.0); /* punt */ return; *************** *** 1288,1294 **** } d--; while (d >= str->str_ptr) { ! if (isdigit(*d)) { if (++*d <= '9') return; *(d--) = '0'; --- 1304,1310 ---- } d--; while (d >= str->str_ptr) { ! if (isDIGIT(*d)) { if (++*d <= '9') return; *(d--) = '0'; *************** *** 1295,1301 **** } else { ++*d; ! if (isalpha(*d)) return; *(d--) -= 'z' - 'a' + 1; } --- 1311,1317 ---- } else { ++*d; ! if (isALPHA(*d)) return; *(d--) -= 'z' - 'a' + 1; } *************** *** 1305,1311 **** str->str_cur++; for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--) *d = d[-1]; ! if (isdigit(d[1])) *d = '1'; else *d = d[1]; --- 1321,1327 ---- str->str_cur++; for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--) *d = d[-1]; ! if (isDIGIT(d[1])) *d = '1'; else *d = d[1]; *** End of Patch 16 *** exit 0 # Just in case... -- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM Sterling Software, IMD UUCP: uunet!sparky!kent Phone: (402) 291-8300 FAX: (402) 291-4362 Please send comp.sources.misc-related mail to kent@uunet.uu.net.