Xref: utzoo comp.sources.bugs:2944 comp.lang.perl:5633 Newsgroups: comp.sources.bugs,comp.lang.perl Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!think.com!sdd.hp.com!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.jpl.nasa.gov (Larry Wall) Subject: perl 4.0 patch #10 Message-ID: <1991Jun10.085522.24824@jpl-devvax.jpl.nasa.gov> Summary: This is an official patch for perl 4.0. Please apply it. Organization: NetLabs, Inc. Date: Mon, 10 Jun 1991 08:55:22 GMT 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 #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 () { ($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 () { ($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 ####