lwall@netlabs.com (Larry Wall) (06/20/91)
Submitted-by: Larry Wall <lwall@netlabs.com> Posting-number: Volume 20, Issue 62 Archive-name: perl/patch10 Patch-To: perl: Volume 18, Issue 19-54 System: perl version 4.0 Patch #: 10 Priority: HIGH Subject: pack(hh,1) dumped core Subject: read didn't work from character special files open for writing Subject: close-on-exec wrongly set on system file descriptors Subject: //g only worked first time through Subject: perl -v printed incorrect copyright notice Subject: certain pattern optimizations were botched Subject: documented some newer features in addenda Subject: $) and $| incorrectly handled in run-time patterns Subject: added tests for case-insensitive regular expressions Subject: m'$foo' now treats string as single quoted 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: Configure -d make depend make make test make install If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@netlabs.com If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 4.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. Index: patchlevel.h Prereq: 9 1c1 < #define PATCHLEVEL 9 --- > #define PATCHLEVEL 10 Index: doarg.c *** doarg.c.old Mon Jun 10 01:32:56 1991 --- doarg.c Mon Jun 10 01:33:01 1991 *************** *** 1,4 **** ! /* $RCSfile: doarg.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:42:17 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: doarg.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:18:41 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * License or the Artistic License, as specified in the README file. * * $Log: doarg.c,v $ + * Revision 4.0.1.3 91/06/10 01:18:41 lwall + * patch10: pack(hh,1) dumped core + * * Revision 4.0.1.2 91/06/07 10:42:17 lwall * patch4: new copyright notice * patch4: // wouldn't use previous pattern if it started with a null character *************** *** 494,502 **** case 'b': { char *savepat = pat; ! int saveitems = items; fromstr = NEXTFROM; aptr = str_get(fromstr); if (pat[-1] == '*') len = fromstr->str_cur; --- 497,506 ---- case 'b': { char *savepat = pat; ! int saveitems; fromstr = NEXTFROM; + saveitems = items; aptr = str_get(fromstr); if (pat[-1] == '*') len = fromstr->str_cur; *************** *** 551,559 **** case 'h': { char *savepat = pat; ! int saveitems = items; fromstr = NEXTFROM; aptr = str_get(fromstr); if (pat[-1] == '*') len = fromstr->str_cur; --- 555,564 ---- case 'h': { char *savepat = pat; ! int saveitems; fromstr = NEXTFROM; + saveitems = items; aptr = str_get(fromstr); if (pat[-1] == '*') len = fromstr->str_cur; Index: doio.c *** doio.c.old Mon Jun 10 01:33:20 1991 --- doio.c Mon Jun 10 01:33:26 1991 *************** *** 1,4 **** ! /* $RCSfile: doio.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:53:39 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: doio.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:21:19 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * License or the Artistic License, as specified in the README file. * * $Log: doio.c,v $ + * Revision 4.0.1.3 91/06/10 01:21:19 lwall + * patch10: read didn't work from character special files open for writing + * patch10: close-on-exec wrongly set on system file descriptors + * * Revision 4.0.1.2 91/06/07 10:53:39 lwall * patch4: new copyright notice * patch4: system fd's are now treated specially *************** *** 237,243 **** (void)fclose(fp); goto say_false; } ! if (S_ISSOCK(statbuf.st_mode) || (S_ISCHR(statbuf.st_mode) && writing)) stio->type = 's'; /* in case a socket was passed in to us */ #ifdef S_IFMT else if (!(statbuf.st_mode & S_IFMT)) --- 241,247 ---- (void)fclose(fp); goto say_false; } ! if (S_ISSOCK(statbuf.st_mode)) stio->type = 's'; /* in case a socket was passed in to us */ #ifdef S_IFMT else if (!(statbuf.st_mode & S_IFMT)) *************** *** 244,253 **** stio->type = 's'; /* some OS's return 0 on fstat()ed socket */ #endif } - #if defined(HAS_FCNTL) && defined(F_SETFD) - fd = fileno(fp); - fcntl(fd,F_SETFD,fd > maxsysfd); - #endif if (saveifp) { /* must use old fp? */ fd = fileno(saveifp); if (saveofp) { --- 248,253 ---- *************** *** 263,278 **** } fp = saveifp; } stio->ifp = fp; if (writing) { ! if (stio->type != 's') ! stio->ofp = fp; ! else if (!(stio->ofp = fdopen(fileno(fp),"w"))) { fclose(fp); stio->ifp = Nullfp; goto say_false; } } return TRUE; --- 263,284 ---- } fp = saveifp; } + #if defined(HAS_FCNTL) && defined(F_SETFD) + fd = fileno(fp); + fcntl(fd,F_SETFD,fd > maxsysfd); + #endif stio->ifp = fp; if (writing) { ! if (stio->type == 's' ! || (stio->type == '>' && S_ISCHR(statbuf.st_mode)) ) { if (!(stio->ofp = fdopen(fileno(fp),"w"))) { fclose(fp); stio->ifp = Nullfp; goto say_false; } + } + else + stio->ofp = fp; } return TRUE; Index: dolist.c *** dolist.c.old Mon Jun 10 01:33:39 1991 --- dolist.c Mon Jun 10 01:33:43 1991 *************** *** 1,4 **** ! /* $RCSfile: dolist.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:58:28 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: dolist.c,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:22:15 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * License or the Artistic License, as specified in the README file. * * $Log: dolist.c,v $ + * Revision 4.0.1.2 91/06/10 01:22:15 lwall + * patch10: //g only worked first time through + * * Revision 4.0.1.1 91/06/07 10:58:28 lwall * patch4: new copyright notice * patch4: added global modifier for pattern matches *************** *** 202,207 **** --- 205,212 ---- goto gotcha; } else { + if (global) + spat->spat_regexp->startp[0] = Nullch; if (gimme == G_ARRAY) return sp; str_sset(str,&str_no); *************** *** 276,281 **** --- 281,288 ---- nope: spat->spat_regexp->startp[0] = Nullch; ++spat->spat_short->str_u.str_useful; + if (global) + spat->spat_regexp->startp[0] = Nullch; if (gimme == G_ARRAY) return sp; str_sset(str,&str_no); Index: t/op/pat.t *** t/op/pat.t.old Mon Jun 10 01:35:45 1991 --- t/op/pat.t Mon Jun 10 01:35:47 1991 *************** *** 1,8 **** #!./perl ! # $RCSfile: pat.t,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:01:26 $ ! print "1..48\n"; $x = "abc\ndef\n"; --- 1,8 ---- #!./perl ! # $RCSfile: pat.t,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:29:34 $ ! print "1..51\n"; $x = "abc\ndef\n"; *************** *** 174,176 **** --- 174,184 ---- $x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9"; print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n"; + + $xyz = 'xyz'; + print "abc" =~ /^abc$|$xyz/ ? "ok 49\n" : "not ok 49\n"; + + # perl 4.009 says "unmatched ()" + eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"'; + print $@ eq "" ? "ok 50\n" : "not ok 50\n"; + print $result eq "abc:bc" ? "ok 51\n" : "not ok 51\n"; Index: perl.c *** perl.c.old Mon Jun 10 01:33:57 1991 --- perl.c Mon Jun 10 01:34:01 1991 *************** *** 1,4 **** ! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.3 $$Date: 91/06/07 11:40:18 $\nPatch level: ###\n"; /* * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.4 $$Date: 91/06/10 01:23:07 $\nPatch level: ###\n"; /* * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * License or the Artistic License, as specified in the README file. * * $Log: perl.c,v $ + * Revision 4.0.1.4 91/06/10 01:23:07 lwall + * patch10: perl -v printed incorrect copyright notice + * * Revision 4.0.1.3 91/06/07 11:40:18 lwall * patch4: changed old $^P to $^X * *************** *** 1199,1206 **** #endif #endif fputs("\n\ ! Perl may be copied only under the terms of the GNU General Public License,\n\ ! a copy of which can be found with the Perl 4.0 distribution kit.\n",stdout); #ifdef MSDOS usage(origargv[0]); #endif --- 1202,1209 ---- #endif #endif fputs("\n\ ! Perl may be copied only under the terms of either the Artistic License or the\n\ ! GNU General Public License, which may be found in the Perl 4.0 source kit.\n",stdout); #ifdef MSDOS usage(origargv[0]); #endif Index: perl.h *** perl.h.old Mon Jun 10 01:34:12 1991 --- perl.h Mon Jun 10 01:34:14 1991 *************** *** 1,4 **** ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:28:33 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:25:10 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * License or the Artistic License, as specified in the README file. * * $Log: perl.h,v $ + * Revision 4.0.1.3 91/06/10 01:25:10 lwall + * patch10: certain pattern optimizations were botched + * * Revision 4.0.1.2 91/06/07 11:28:33 lwall * patch4: new copyright notice * patch4: made some allowances for "semi-standard" C *************** *** 749,754 **** --- 752,758 ---- STR *interp(); void free_arg(); STIO *stio_new(); + void hoistmust(); EXT struct stat statbuf; EXT struct stat statcache; Index: perl.man *** perl.man.old Mon Jun 10 01:34:47 1991 --- perl.man Mon Jun 10 01:35:01 1991 *************** *** 1,7 **** .rn '' }` ! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:41:23 $ ''' ''' $Log: perl.man,v $ ''' Revision 4.0.1.2 91/06/07 11:41:23 lwall ''' patch4: added global modifier for pattern matches ''' patch4: default top-of-form format is now FILEHANDLE_TOP --- 1,10 ---- .rn '' }` ! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:26:02 $ ''' ''' $Log: perl.man,v $ + ''' Revision 4.0.1.3 91/06/10 01:26:02 lwall + ''' patch10: documented some newer features in addenda + ''' ''' Revision 4.0.1.2 91/06/07 11:41:23 lwall ''' patch4: added global modifier for pattern matches ''' patch4: default top-of-form format is now FILEHANDLE_TOP *************** *** 5802,5807 **** --- 5805,5815 ---- The .B $/ variable may now be set to a multi-character delimiter. + .PP + There is now a g modifier on ordinary pattern matching that causes it + to iterate through a string finding multiple matches. + .PP + All of the $^X variables are new except for $^T. .SH BUGS .PP .I Perl Index: t/op/re_tests *** t/op/re_tests.old Mon Jun 10 01:35:52 1991 --- t/op/re_tests Mon Jun 10 01:35:54 1991 *************** *** 135,137 **** --- 135,274 ---- a[-]?c ac y $& ac (abc)\1 abcabc y $1 abc ([a-c]*)\1 abcabc y $1 abc + 'abc'i ABC y $& ABC + 'abc'i XBC n - - + 'abc'i AXC n - - + 'abc'i ABX n - - + 'abc'i XABCY y $& ABC + 'abc'i ABABC y $& ABC + 'ab*c'i ABC y $& ABC + 'ab*bc'i ABC y $& ABC + 'ab*bc'i ABBC y $& ABBC + 'ab*bc'i ABBBBC y $& ABBBBC + 'ab{0,}bc'i ABBBBC y $& ABBBBC + 'ab+bc'i ABBC y $& ABBC + 'ab+bc'i ABC n - - + 'ab+bc'i ABQ n - - + 'ab{1,}bc'i ABQ n - - + 'ab+bc'i ABBBBC y $& ABBBBC + 'ab{1,}bc'i ABBBBC y $& ABBBBC + 'ab{1,3}bc'i ABBBBC y $& ABBBBC + 'ab{3,4}bc'i ABBBBC y $& ABBBBC + 'ab{4,5}bc'i ABBBBC n - - + 'ab?bc'i ABBC y $& ABBC + 'ab?bc'i ABC y $& ABC + 'ab{0,1}bc'i ABC y $& ABC + 'ab?bc'i ABBBBC n - - + 'ab?c'i ABC y $& ABC + 'ab{0,1}c'i ABC y $& ABC + '^abc$'i ABC y $& ABC + '^abc$'i ABCC n - - + '^abc'i ABCC y $& ABC + '^abc$'i AABC n - - + 'abc$'i AABC y $& ABC + '^'i ABC y $& + '$'i ABC y $& + 'a.c'i ABC y $& ABC + 'a.c'i AXC y $& AXC + 'a.*c'i AXYZC y $& AXYZC + 'a.*c'i AXYZD n - - + 'a[bc]d'i ABC n - - + 'a[bc]d'i ABD y $& ABD + 'a[b-d]e'i ABD n - - + 'a[b-d]e'i ACE y $& ACE + 'a[b-d]'i AAC y $& AC + 'a[-b]'i A- y $& A- + 'a[b-]'i A- y $& A- + 'a[b-a]'i - c - - + 'a[]b'i - c - - + 'a['i - c - - + 'a]'i A] y $& A] + 'a[]]b'i A]B y $& A]B + 'a[^bc]d'i AED y $& AED + 'a[^bc]d'i ABD n - - + 'a[^-b]c'i ADC y $& ADC + 'a[^-b]c'i A-C n - - + 'a[^]b]c'i A]C n - - + 'a[^]b]c'i ADC y $& ADC + 'ab|cd'i ABC y $& AB + 'ab|cd'i ABCD y $& AB + '()ef'i DEF y $&-$1 EF- + '()*'i - c - - + '*a'i - c - - + '^*'i - c - - + '$*'i - c - - + '(*)b'i - c - - + '$b'i B n - - + 'a\'i - c - - + 'a\(b'i A(B y $&-$1 A(B- + 'a\(*b'i AB y $& AB + 'a\(*b'i A((B y $& A((B + 'a\\b'i A\B y $& A\B + 'abc)'i - c - - + '(abc'i - c - - + '((a))'i ABC y $&-$1-$2 A-A-A + '(a)b(c)'i ABC y $&-$1-$2 ABC-A-C + 'a+b+c'i AABBABC y $& ABC + 'a{1,}b{1,}c'i AABBABC y $& ABC + 'a**'i - c - - + 'a*?'i - c - - + '(a*)*'i - c - - + '(a*)+'i - c - - + '(a|)*'i - c - - + '(a*|b)*'i - c - - + '(a+|b)*'i AB y $&-$1 AB-B + '(a+|b){0,}'i AB y $&-$1 AB-B + '(a+|b)+'i AB y $&-$1 AB-B + '(a+|b){1,}'i AB y $&-$1 AB-B + '(a+|b)?'i AB y $&-$1 A-A + '(a+|b){0,1}'i AB y $&-$1 A-A + '(^)*'i - c - - + '(ab|)*'i - c - - + ')('i - c - - + '[^ab]*'i CDE y $& CDE + 'abc'i n - - + 'a*'i y $& + '([abc])*d'i ABBBCD y $&-$1 ABBBCD-C + '([abc])*bcd'i ABCD y $&-$1 ABCD-A + 'a|b|c|d|e'i E y $& E + '(a|b|c|d|e)f'i EF y $&-$1 EF-E + '((a*|b))*'i - c - - + 'abcd*efg'i ABCDEFG y $& ABCDEFG + 'ab*'i XABYABBBZ y $& AB + 'ab*'i XAYABBBZ y $& A + '(ab|cd)e'i ABCDE y $&-$1 CDE-CD + '[abhgefdc]ij'i HIJ y $& HIJ + '^(ab|cd)e'i ABCDE n x$1y XY + '(abc|)ef'i ABCDEF y $&-$1 EF- + '(a|b)c*d'i ABCD y $&-$1 BCD-B + '(ab|ab*)bc'i ABC y $&-$1 ABC-A + 'a([bc]*)c*'i ABC y $&-$1 ABC-BC + 'a([bc]*)(c*d)'i ABCD y $&-$1-$2 ABCD-BC-D + 'a([bc]+)(c*d)'i ABCD y $&-$1-$2 ABCD-BC-D + 'a([bc]*)(c+d)'i ABCD y $&-$1-$2 ABCD-B-CD + 'a[bcd]*dcdcde'i ADCDCDE y $& ADCDCDE + 'a[bcd]+dcdcde'i ADCDCDE n - - + '(ab|a)b*c'i ABC y $&-$1 ABC-AB + '((a)(b)c)(d)'i ABCD y $1-$2-$3-$4 ABC-A-B-D + '[a-zA-Z_][a-zA-Z0-9_]*'i ALPHA y $& ALPHA + '^a(bc+|b[eh])g|.h$'i ABH y $&-$1 BH- + '(bc+d$|ef*g.|h?i(j|k))'i EFFGZ y $&-$1-$2 EFFGZ-EFFGZ- + '(bc+d$|ef*g.|h?i(j|k))'i IJ y $&-$1-$2 IJ-IJ-J + '(bc+d$|ef*g.|h?i(j|k))'i EFFG n - - + '(bc+d$|ef*g.|h?i(j|k))'i BCDD n - - + '(bc+d$|ef*g.|h?i(j|k))'i REFFGZ y $&-$1-$2 EFFGZ-EFFGZ- + '((((((((((a))))))))))'i A y $10 A + '((((((((((a))))))))))\10'i AA y $& AA + '((((((((((a))))))))))\41'i AA n - - + '((((((((((a))))))))))\41'i A! y $& A! + '(((((((((a)))))))))'i A y $& A + 'multiple words of text'i UH-UH n - - + 'multiple words'i MULTIPLE WORDS, YEAH y $& MULTIPLE WORDS + '(.*)c(.*)'i ABCDE y $&-$1-$2 ABCDE-AB-DE + '\((.*), (.*)\)'i (A, B) y ($2, $1) (B, A) + '[k]'i AB n - - + 'abcd'i ABCD y $&-\$&-\\$& ABCD-$&-\ABCD + 'a(bc)d'i ABCD y $1-\$1-\\$1 BC-$1-\BC + 'a[-]?c'i AC y $& AC + '(abc)\1'i ABCABC y $1 ABC + '([a-c]*)\1'i ABCABC y $1 ABC Index: t/op/regexp.t Prereq: 4.0 *** t/op/regexp.t.old Mon Jun 10 01:36:00 1991 --- t/op/regexp.t Mon Jun 10 01:36:01 1991 *************** *** 1,6 **** #!./perl ! # $Header: regexp.t,v 4.0 91/03/20 01:54:22 lwall Locked $ open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || die "Can't open re_tests"; --- 1,6 ---- #!./perl ! # $RCSfile: regexp.t,v $$Revision: 4.0.1.1 $$Date: 91/06/10 01:30:29 $ open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || die "Can't open re_tests"; *************** *** 11,20 **** print "1..$numtests\n"; open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || die "Can't open re_tests"; while (<TESTS>) { ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_); $input = join(':',$pat,$subject,$result,$repl,$expect); ! eval "\$match = (\$subject =~ \$pat); \$got = \"$repl\";"; if ($result eq 'c') { if ($@ ne '') {print "ok $.\n";} else {print "not ok $.\n";} } --- 11,22 ---- print "1..$numtests\n"; open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || die "Can't open re_tests"; + $| = 1; while (<TESTS>) { ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_); $input = join(':',$pat,$subject,$result,$repl,$expect); ! $pat = "'$pat'" unless $pat =~ /^'/; ! eval "\$match = (\$subject =~ m$pat); \$got = \"$repl\";"; if ($result eq 'c') { if ($@ ne '') {print "ok $.\n";} else {print "not ok $.\n";} } Index: str.c *** str.c.old Mon Jun 10 01:35:33 1991 --- str.c Mon Jun 10 01:35:37 1991 *************** *** 1,4 **** ! /* $RCSfile: str.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:58:13 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: str.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:27:54 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * License or the Artistic License, as specified in the README file. * * $Log: str.c,v $ + * Revision 4.0.1.3 91/06/10 01:27:54 lwall + * patch10: $) and $| incorrectly handled in run-time patterns + * * Revision 4.0.1.2 91/06/07 11:58:13 lwall * patch4: new copyright notice * patch4: taint check on undefined string could cause core dump *************** *** 939,946 **** ++s; t = s; } ! else if ((*s == '@' || (*s == '$' && !index(nointrp,s[1]))) && ! s+1 < send) { str_ncat(str,t,s-t); t = s; if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) --- 942,955 ---- ++s; t = s; } ! else if (*s == '$' && s+1 < send && *nointrp && index(nointrp,s[1])) { ! str_ncat(str, t, s - t); ! str_ncat(str, "$b", 2); ! str_ncat(str, s, 2); ! s += 2; ! t = s; ! } ! else if ((*s == '@' || *s == '$') && s+1 < send) { str_ncat(str,t,s-t); t = s; if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) *************** *** 1171,1176 **** --- 1180,1188 ---- if (s-t > 0) str_ncat(str,t,s-t); switch(*++s) { + default: + fatal("panic: unknown interp cookie\n"); + break; case 'a': str_scat(str,*++elem); break; Index: toke.c *** toke.c.old Mon Jun 10 01:36:15 1991 --- toke.c Mon Jun 10 01:36:21 1991 *************** *** 1,4 **** ! /* $RCSfile: toke.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:05:56 $ * * Copyright (c) 1991, Larry Wall * --- 1,4 ---- ! /* $RCSfile: toke.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:32:26 $ * * Copyright (c) 1991, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * License or the Artistic License, as specified in the README file. * * $Log: toke.c,v $ + * Revision 4.0.1.3 91/06/10 01:32:26 lwall + * patch10: m'$foo' now treats string as single quoted + * patch10: certain pattern optimizations were botched + * * Revision 4.0.1.2 91/06/07 12:05:56 lwall * patch4: new copyright notice * patch4: debugger lost track of lines in eval *************** *** 1514,1519 **** --- 1518,1524 ---- int len; SPAT savespat; STR *str = Str_new(93,0); + char delim; Newz(801,spat,1,SPAT); spat->spat_next = curstash->tbl_spatroot; /* link into spat list */ *************** *** 1538,1544 **** yylval.arg = Nullarg; return s; } ! s++; while (*s == 'i' || *s == 'o' || *s == 'g') { if (*s == 'i') { s++; --- 1543,1549 ---- yylval.arg = Nullarg; return s; } ! delim = *s++; while (*s == 'i' || *s == 'o' || *s == 'g') { if (*s == 'i') { s++; *************** *** 1556,1562 **** } len = str->str_cur; e = str->str_ptr + len; ! for (d = str->str_ptr; d < e; d++) { if (*d == '\\') d++; else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') || --- 1561,1571 ---- } len = str->str_cur; e = str->str_ptr + len; ! if (delim == '\'') ! d = e; ! else ! d = str->str_ptr; ! for (; d < e; d++) { if (*d == '\\') d++; else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') || *************** *** 1738,1743 **** --- 1747,1753 ---- return s; } + void hoistmust(spat) register SPAT *spat; { *************** *** 1744,1752 **** if (!spat->spat_short && spat->spat_regexp->regstart && (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH) ) { - spat->spat_short = spat->spat_regexp->regstart; if (!(spat->spat_regexp->reganch & ROPT_ANCH)) spat->spat_flags |= SPAT_SCANFIRST; } else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */ if (spat->spat_short && --- 1754,1764 ---- if (!spat->spat_short && spat->spat_regexp->regstart && (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH) ) { if (!(spat->spat_regexp->reganch & ROPT_ANCH)) spat->spat_flags |= SPAT_SCANFIRST; + else if (spat->spat_flags & SPAT_FOLD) + return; + spat->spat_short = str_smake(spat->spat_regexp->regstart); } else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */ if (spat->spat_short && #### End of Patch 10 #### 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.