perl 4.0 patch #10
Larry Wall
lwall at jpl-devvax.jpl.nasa.gov
Mon Jun 10 18:55:22 AEST 1991
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 at 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 ####
More information about the Comp.sources.bugs
mailing list