perl 1.0 patch #21
The Superuser
lroot at devvax.JPL.NASA.GOV
Sat Feb 6 18:58:23 AEST 1988
System: perl version 1.0
Patch #: 21
Priority: varied
Subject: /foo/i && s//bar/; TEST nonportabilities; bare blocks can blow core
From: jbs at EDDIE.MIT.EDU (Jeff Siegal)
From: psivax!uunet!hocpb!rer (Rick Richardson)
From: mlm at ei.ecn.purdue.edu (Michael L. McLean)
From: lwall at jpl-devvax.jpl.nasa.gov (me)
Description:
TEST didn't find subtests if . wasn't in $PATH.
Some of the tests depended on the existence of /etc/termcap, which
isn't guaranteed.
The construct "/foo/ && s//bar/" didn't work as intended, so certain
sed scripts didn't work right when translated to perl.
There was no way to get at the code for doing case-insensitive
searches, so I added an i modifier.
Null loops and blocks (which are loops that execute just once) did
not pop the loop label off the stack properly. Hence perl would
dump core eventually on "perl -n -e '{print;}' </usr/dict/words".
Fix: From rn, say "| patch -p0 -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p0 -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After applying patch:
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 jpl-devvax.jpl.nasa.gov
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 1.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU in Internet notation, 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.
You can also get the patches via anonymous FTP from
jpl-devvax.jpl.nasa.gov (128.149.8.43).
Index: patchlevel.h
Prereq: 20
1c1
< #define PATCHLEVEL 20
---
> #define PATCHLEVEL 21
Index: t/TEST
Prereq: 1.0.1.2
*** t/TEST.old Sat Feb 6 00:31:03 1988
--- t/TEST Sat Feb 6 00:31:04 1988
***************
*** 1,6 ****
#!./perl
! # $Header: TEST,v 1.0.1.2 88/02/04 00:14:07 root Exp $
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
--- 1,6 ----
#!./perl
! # $Header: TEST,v 1.0.1.3 88/02/06 00:24:22 root Exp $
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
***************
*** 23,34 ****
}
$bad = 0;
while ($test = shift) {
! if ($test =~ /.*\.orig$/) {
next;
}
print "$test...";
if ($sharpbang) {
! open(results,"$test|") || (print "can't run.\n");
} else {
open(script,"$test") || die "Can't run $test";
$_ = <script>;
--- 23,34 ----
}
$bad = 0;
while ($test = shift) {
! if ($test =~ /\.orig$/) {
next;
}
print "$test...";
if ($sharpbang) {
! open(results,"./$test|") || (print "can't run.\n");
} else {
open(script,"$test") || die "Can't run $test";
$_ = <script>;
Index: arg.c
Prereq: 1.0.1.9
*** arg.c.old Sat Feb 6 00:29:07 1988
--- arg.c Sat Feb 6 00:29:15 1988
***************
*** 1,6 ****
! /* $Header: arg.c,v 1.0.1.9 88/02/04 17:47:31 root Exp $
*
* $Log: arg.c,v $
* Revision 1.0.1.9 88/02/04 17:47:31 root
* patch20: made failing fork/exec exit.
*
--- 1,9 ----
! /* $Header: arg.c,v 1.0.1.10 88/02/06 00:17:48 root Exp $
*
* $Log: arg.c,v $
+ * Revision 1.0.1.10 88/02/06 00:17:48 root
+ * patch21: fixed code so /foo/ && s//bar/ would work. Also /foo/i.
+ *
* Revision 1.0.1.9 88/02/04 17:47:31 root
* patch20: made failing fork/exec exit.
*
***************
*** 61,77 ****
if (debug & 8)
deb("2.SPAT /%s/\n",t);
#endif
! if (d = compile(&spat->spat_compex,t,TRUE,FALSE)) {
#ifdef DEBUGGING
deb("/%s/: %s\n", t, d);
#endif
return FALSE;
}
! if (spat->spat_compex.complen <= 1 && curspat)
! spat = curspat;
if (execute(&spat->spat_compex, s, TRUE, 0)) {
if (spat->spat_compex.numsubs)
curspat = spat;
return TRUE;
}
else
--- 64,82 ----
if (debug & 8)
deb("2.SPAT /%s/\n",t);
#endif
! if (d = compile(&spat->spat_compex,t,TRUE,
! spat->spat_flags & SPAT_FOLD )) {
#ifdef DEBUGGING
deb("/%s/: %s\n", t, d);
#endif
return FALSE;
}
! if (!*spat->spat_compex.precomp && lastspat)
! spat = lastspat;
if (execute(&spat->spat_compex, s, TRUE, 0)) {
if (spat->spat_compex.numsubs)
curspat = spat;
+ lastspat = spat;
return TRUE;
}
else
***************
*** 89,96 ****
deb("2.SPAT %c%s%c\n",ch,spat->spat_compex.precomp,ch);
}
#endif
! if (spat->spat_compex.complen <= 1 && curspat)
! spat = curspat;
if (spat->spat_first) {
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_first);
--- 94,101 ----
deb("2.SPAT %c%s%c\n",ch,spat->spat_compex.precomp,ch);
}
#endif
! if (!*spat->spat_compex.precomp && lastspat)
! spat = lastspat;
if (spat->spat_first) {
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_first);
***************
*** 103,108 ****
--- 108,114 ----
if (execute(&spat->spat_compex, s, TRUE, 0)) {
if (spat->spat_compex.numsubs)
curspat = spat;
+ lastspat = spat;
if (spat->spat_flags & SPAT_USE_ONCE)
spat->spat_flags |= SPAT_USED;
return TRUE;
***************
*** 131,137 ****
char *d;
m = str_get(eval(spat->spat_runtime,Null(STR***)));
! if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
#ifdef DEBUGGING
deb("/%s/: %s\n", m, d);
#endif
--- 137,144 ----
char *d;
m = str_get(eval(spat->spat_runtime,Null(STR***)));
! if (d = compile(&spat->spat_compex,m,TRUE,
! spat->spat_flags & SPAT_FOLD )) {
#ifdef DEBUGGING
deb("/%s/: %s\n", m, d);
#endif
***************
*** 143,150 ****
deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
}
#endif
! if (spat->spat_compex.complen <= 1 && curspat)
! spat = curspat;
if (spat->spat_first) {
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_first);
--- 150,157 ----
deb("2.SPAT /%s/\n",spat->spat_compex.precomp);
}
#endif
! if (!*spat->spat_compex.precomp && lastspat)
! spat = lastspat;
if (spat->spat_first) {
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_first);
***************
*** 160,165 ****
--- 167,173 ----
dstr = str_new(str_len(str));
if (spat->spat_compex.numsubs)
curspat = spat;
+ lastspat = spat;
do {
if (iters++ > 10000)
fatal("Substitution loop?\n");
***************
*** 239,245 ****
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
}
! if (d = compile(&spat->spat_compex,m,TRUE,FALSE)) {
#ifdef DEBUGGING
deb("/%s/: %s\n", m, d);
#endif
--- 247,254 ----
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
}
! if (d = compile(&spat->spat_compex,m,TRUE,
! spat->spat_flags & SPAT_FOLD )) {
#ifdef DEBUGGING
deb("/%s/: %s\n", m, d);
#endif
Index: t/base.term
Prereq: 1.0
*** t/base.term.old Sat Feb 6 00:31:16 1988
--- t/base.term Sat Feb 6 00:31:17 1988
***************
*** 1,6 ****
#!./perl
! # $Header: base.term,v 1.0 87/12/18 13:11:59 root Exp $
print "1..6\n";
--- 1,6 ----
#!./perl
! # $Header: base.term,v 1.0.1.1 88/02/06 00:25:14 root Exp $
print "1..6\n";
***************
*** 32,36 ****
open(try, "/dev/null") || (die "Can't open /dev/null.");
if (<try> eq '') {print "ok 5\n";} else {print "not ok 5\n";}
! open(try, "/etc/termcap") || (die "Can't open /etc/termcap.");
if (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";}
--- 32,36 ----
open(try, "/dev/null") || (die "Can't open /dev/null.");
if (<try> eq '') {print "ok 5\n";} else {print "not ok 5\n";}
! open(try, "../Makefile") || (die "Can't open ../Makefile.");
if (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";}
Index: cmd.c
Prereq: 1.0.1.2
*** cmd.c.old Sat Feb 6 00:29:28 1988
--- cmd.c Sat Feb 6 00:29:30 1988
***************
*** 1,6 ****
! /* $Header: cmd.c,v 1.0.1.2 88/02/04 11:15:58 root Exp $
*
* $Log: cmd.c,v $
* Revision 1.0.1.2 88/02/04 11:15:58 root
* patch18: regularized includes.
*
--- 1,9 ----
! /* $Header: cmd.c,v 1.0.1.3 88/02/06 00:18:47 root Exp $
*
* $Log: cmd.c,v $
+ * Revision 1.0.1.3 88/02/06 00:18:47 root
+ * patch21: fixed loop and block exits to pop label stack consistently.
+ *
* Revision 1.0.1.2 88/02/04 11:15:58 root
* patch18: regularized includes.
*
***************
*** 108,122 ****
olddlevel = dlevel;
#endif
curspat = oldspat;
! #ifdef DEBUGGING
! if (debug & 4) {
! deb("(Popping label #%d %s)\n",loop_ptr,
! loop_stack[loop_ptr].loop_label);
! }
! #endif
! loop_ptr--;
! cmd = cmd->c_next;
! goto tail_recursion_entry;
case O_NEXT: /* not done unless go_to found */
go_to = Nullch;
goto next_iter;
--- 111,117 ----
olddlevel = dlevel;
#endif
curspat = oldspat;
! goto next_cmd;
case O_NEXT: /* not done unless go_to found */
go_to = Nullch;
goto next_iter;
***************
*** 155,162 ****
goto finish_while;
}
cmd = cmd->c_next;
! if (cmd && cmd->c_head == cmd) /* reached end of while loop */
return retstr; /* targ isn't in this block */
goto tail_recursion_entry;
}
}
--- 150,167 ----
goto finish_while;
}
cmd = cmd->c_next;
! if (cmd && cmd->c_head == cmd)
! /* reached end of while loop */
return retstr; /* targ isn't in this block */
+ if (cmdflags & CF_ONCE) {
+ #ifdef DEBUGGING
+ if (debug & 4) {
+ deb("(Popping label #%d %s)\n",loop_ptr,
+ loop_stack[loop_ptr].loop_label);
+ }
+ #endif
+ loop_ptr--;
+ }
goto tail_recursion_entry;
}
}
***************
*** 311,320 ****
maybe:
if (cmdflags & CF_INVERT)
match = !match;
! if (!match && cmd->c_type != C_IF) {
! cmd = cmd->c_next;
! goto tail_recursion_entry;
! }
}
/* now to do the actual command, if any */
--- 316,323 ----
maybe:
if (cmdflags & CF_INVERT)
match = !match;
! if (!match && cmd->c_type != C_IF)
! goto next_cmd;
}
/* now to do the actual command, if any */
***************
*** 374,388 ****
case O_LAST:
retstr = &str_no;
curspat = oldspat;
! #ifdef DEBUGGING
! if (debug & 4) {
! deb("(Popping label #%d %s)\n",loop_ptr,
! loop_stack[loop_ptr].loop_label);
! }
! #endif
! loop_ptr--;
! cmd = cmd->c_next;
! goto tail_recursion_entry;
case O_NEXT:
goto next_iter;
case O_REDO:
--- 377,383 ----
case O_LAST:
retstr = &str_no;
curspat = oldspat;
! goto next_cmd;
case O_NEXT:
goto next_iter;
case O_REDO:
***************
*** 403,409 ****
#endif
cmd_exec(cmd->ucmd.ccmd.cc_true);
}
! /* actually, this spot is never reached anymore since the above
* cmd_exec() returns through longjmp(). Hooray for structure.
*/
next_iter:
--- 398,404 ----
#endif
cmd_exec(cmd->ucmd.ccmd.cc_true);
}
! /* actually, this spot is rarely reached anymore since the above
* cmd_exec() returns through longjmp(). Hooray for structure.
*/
next_iter:
***************
*** 429,435 ****
--- 424,440 ----
cmdflags |= CF_COND; /* now test the condition */
goto until_loop;
}
+ next_cmd:
cmd = cmd->c_next;
+ if (cmdflags & CF_ONCE) {
+ #ifdef DEBUGGING
+ if (debug & 4) {
+ deb("(Popping label #%d %s)\n",loop_ptr,
+ loop_stack[loop_ptr].loop_label);
+ }
+ #endif
+ loop_ptr--;
+ }
goto tail_recursion_entry;
}
Index: t/op.eval
*** t/op.eval.old Sat Feb 6 00:31:25 1988
--- t/op.eval Sat Feb 6 00:31:28 1988
***************
*** 1,6 ****
#!./perl
! print "1..7\n";
eval 'print "ok 1\n";';
--- 1,6 ----
#!./perl
! print "1..8\n";
eval 'print "ok 1\n";';
***************
*** 20,22 ****
--- 20,29 ----
if ($@ =~ /Search/) {print "ok 6\n";} else {print "not ok 6\n";}
print eval '"ok 7\n";';
+
+ # calculate a factorial with recursive evals
+
+ $foo = 5;
+ $fact = 'if ($foo <= 1) {1;} else {push(@x,$foo--); (eval $fact) * pop(@x);}';
+ $ans = eval $fact;
+ if ($ans == 120) {print "ok 8\n";} else {print "not ok 8\n";}
Index: t/op.flip
Prereq: 1.0
*** t/op.flip.old Sat Feb 6 00:31:38 1988
--- t/op.flip Sat Feb 6 00:31:39 1988
***************
*** 1,6 ****
#!./perl
! # $Header: op.flip,v 1.0 87/12/18 13:13:34 root Exp $
print "1..8\n";
--- 1,6 ----
#!./perl
! # $Header: op.flip,v 1.0.1.1 88/02/06 00:26:12 root Exp $
print "1..8\n";
***************
*** 17,23 ****
@a = ('a','b','c','d','e','f','g');
! open(of,'/etc/termcap');
while (<of>) {
(3 .. 5) && $foo .= $_;
}
--- 17,23 ----
@a = ('a','b','c','d','e','f','g');
! open(of,'../Makefile');
while (<of>) {
(3 .. 5) && $foo .= $_;
}
Index: t/op.pat
Prereq: 1.0
*** t/op.pat.old Sat Feb 6 00:31:49 1988
--- t/op.pat Sat Feb 6 00:31:50 1988
***************
*** 1,7 ****
#!./perl
! # $Header: op.pat,v 1.0 87/12/18 13:14:07 root Exp $
! print "1..22\n";
$x = "abc\ndef\n";
--- 1,7 ----
#!./perl
! # $Header: op.pat,v 1.0.1.1 88/02/06 00:26:35 root Exp $
! print "1..23\n";
$x = "abc\ndef\n";
***************
*** 54,56 ****
--- 54,58 ----
if (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
+
+ if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
Index: t/op.subst
Prereq: 1.0
*** t/op.subst.old Sat Feb 6 00:31:59 1988
--- t/op.subst Sat Feb 6 00:32:01 1988
***************
*** 1,8 ****
#!./perl
! # $Header: op.subst,v 1.0 87/12/18 13:14:30 root Exp $
! print "1..7\n";
$x = 'foo';
$_ = "x";
--- 1,8 ----
#!./perl
! # $Header: op.subst,v 1.0.1.1 88/02/06 00:27:19 root Exp $
! print "1..8\n";
$x = 'foo';
$_ = "x";
***************
*** 36,38 ****
--- 36,41 ----
if (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
{print "ok 7\n";} else {print "not ok 7\n";}
+
+ $_ = 'ABACADA';
+ if (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8\n";}
Index: perl.man.1
Prereq: 1.0.1.3
*** perl.man.1.old Sat Feb 6 00:29:45 1988
--- perl.man.1 Sat Feb 6 00:29:48 1988
***************
*** 1,7 ****
.rn '' }`
! ''' $Header: perl.man.1,v 1.0.1.3 88/02/04 17:48:02 root Exp $
'''
''' $Log: perl.man.1,v $
''' Revision 1.0.1.3 88/02/04 17:48:02 root
''' patch20: added missing chop($user); to example in chown.
'''
--- 1,10 ----
.rn '' }`
! ''' $Header: perl.man.1,v 1.0.1.4 88/02/06 00:19:44 root Exp $
'''
''' $Log: perl.man.1,v $
+ ''' Revision 1.0.1.4 88/02/06 00:19:44 root
+ ''' patch21: documented -v, /foo/i.
+ '''
''' Revision 1.0.1.3 88/02/04 17:48:02 root
''' patch20: added missing chop($user); to example in chown.
'''
***************
*** 246,251 ****
--- 249,257 ----
if ($xyz) { print "true\en"; }
.fi
+ .TP 5
+ .B \-v
+ prints the version and patchlevel of your perl executable.
.Sh "Data Types and Objects"
.PP
Perl has about two and a half data types: strings, arrays of strings, and
***************
*** 785,791 ****
.PP
Along with the literals and variables mentioned earlier,
the following operations can serve as terms in an expression:
! .Ip "/PATTERN/" 8 4
Searches a string for a pattern, and returns true (1) or false ('').
If no string is specified via the =~ or !~ operator,
the $_ string is searched.
--- 791,797 ----
.PP
Along with the literals and variables mentioned earlier,
the following operations can serve as terms in an expression:
! .Ip "/PATTERN/i" 8 4
Searches a string for a pattern, and returns true (1) or false ('').
If no string is specified via the =~ or !~ operator,
the $_ string is searched.
***************
*** 794,799 ****
--- 800,807 ----
.Sp
If you prepend an `m' you can use any pair of characters as delimiters.
This is particularly useful for matching Unix path names that contain `/'.
+ If the final delimiter is followed by the optional letter `i', the matching is
+ done in a case-insensitive manner.
.Sp
Examples:
.nf
***************
*** 800,806 ****
.ne 4
open(tty, '/dev/tty');
! <tty> \|=~ \|/\|^[Yy]\|/ \|&& \|do foo(\|); # do foo if desired
if (/Version: \|*\|([0-9.]*\|)\|/\|) { $version = $1; }
--- 808,814 ----
.ne 4
open(tty, '/dev/tty');
! <tty> \|=~ \|/\|^y\|/i \|&& \|do foo(\|); # do foo if desired
if (/Version: \|*\|([0-9.]*\|)\|/\|) { $version = $1; }
Index: perl.man.2
Prereq: 1.0.1.4
*** perl.man.2.old Sat Feb 6 00:30:03 1988
--- perl.man.2 Sat Feb 6 00:30:08 1988
***************
*** 1,7 ****
''' Beginning of part 2
! ''' $Header: perl.man.2,v 1.0.1.4 88/02/04 17:48:31 root Exp $
'''
''' $Log: perl.man.2,v $
''' Revision 1.0.1.4 88/02/04 17:48:31 root
''' patch20: documented return values of system better.
'''
--- 1,10 ----
''' Beginning of part 2
! ''' $Header: perl.man.2,v 1.0.1.5 88/02/06 00:22:26 root Exp $
'''
''' $Log: perl.man.2,v $
+ ''' Revision 1.0.1.5 88/02/06 00:22:26 root
+ ''' patch21: documented s/foo/bar/i.
+ '''
''' Revision 1.0.1.4 88/02/04 17:48:31 root
''' patch20: documented return values of system better.
'''
***************
*** 259,269 ****
reset; \h'|2i'# just reset ?? searches
.fi
! .Ip "s/PATTERN/REPLACEMENT/g" 8 3
Searches a string for a pattern, and if found, replaces that pattern with the
replacement text and returns the number of substitutions made.
Otherwise it returns false (0).
The \*(L"g\*(R" is optional, and if present, indicates that all occurences
of the pattern are to be replaced.
Any delimiter may replace the slashes; if single quotes are used, no
interpretation is done on the replacement string.
--- 262,275 ----
reset; \h'|2i'# just reset ?? searches
.fi
! .Ip "s/PATTERN/REPLACEMENT/gi" 8 3
Searches a string for a pattern, and if found, replaces that pattern with the
replacement text and returns the number of substitutions made.
Otherwise it returns false (0).
The \*(L"g\*(R" is optional, and if present, indicates that all occurences
+ of the pattern are to be replaced.
+ The \*(L"i\*(R" is also optional, and if present, indicates that matching
+ is to be done in a case-insensitive manner.
of the pattern are to be replaced.
Any delimiter may replace the slashes; if single quotes are used, no
interpretation is done on the replacement string.
Index: perly.c
Prereq: 1.0.1.4
*** perly.c.old Sat Feb 6 00:30:32 1988
--- perly.c Sat Feb 6 00:30:39 1988
***************
*** 1,6 ****
! char rcsid[] = "$Header: perly.c,v 1.0.1.4 88/02/03 16:25:19 root Exp $";
/*
* $Log: perly.c,v $
* Revision 1.0.1.4 88/02/03 16:25:19 root
* patch15: 1+$foo confused tokener.
* Also, the return value in do_eval got tromped by cmd_free().
--- 1,9 ----
! char rcsid[] = "$Header: perly.c,v 1.0.1.5 88/02/06 00:22:51 root Exp $";
/*
* $Log: perly.c,v $
+ * Revision 1.0.1.5 88/02/06 00:22:51 root
+ * patch21: added /foo/i, /$var/.
+ *
* Revision 1.0.1.4 88/02/03 16:25:19 root
* patch15: 1+$foo confused tokener.
* Also, the return value in do_eval got tromped by cmd_free().
***************
*** 932,937 ****
--- 935,955 ----
if (!*s)
fatal("Search pattern not terminated:\n%s",str_get(linestr));
s++;
+ if (*s == 'i') {
+ s++;
+ spat->spat_flags |= SPAT_FOLD;
+ }
+ for (d=tokenbuf; *d; d++) {
+ if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
+ register ARG *arg;
+
+ spat->spat_runtime = arg = op_new(1);
+ arg->arg_type = O_ITEM;
+ arg[1].arg_type = A_DOUBLE;
+ arg[1].arg_ptr.arg_str = str_make(tokenbuf);
+ goto got_pat; /* skip compiling for now */
+ }
+ }
if (*tokenbuf == '^') {
spat->spat_first = scanconst(tokenbuf+1);
if (spat->spat_first) {
***************
*** 949,956 ****
spat->spat_flags |= SPAT_SCANALL;
}
}
! if (d = compile(&spat->spat_compex,tokenbuf,TRUE,FALSE))
fatal(d);
yylval.arg = make_match(O_MATCH,stab_to_arg(A_STAB,defstab),spat);
return s;
}
--- 967,976 ----
spat->spat_flags |= SPAT_SCANALL;
}
}
! if (d = compile(&spat->spat_compex,tokenbuf,TRUE,
! spat->spat_flags & SPAT_FOLD ))
fatal(d);
+ got_pat:
yylval.arg = make_match(O_MATCH,stab_to_arg(A_STAB,defstab),spat);
return s;
}
***************
*** 999,1010 ****
if (!*s)
fatal("Substitution replacement not terminated:\n%s",str_get(linestr));
spat->spat_repl = yylval.arg;
! if (*s == 'g') {
! s++;
! spat->spat_flags &= ~SPAT_USE_ONCE;
}
! else
! spat->spat_flags |= SPAT_USE_ONCE;
yylval.arg = make_match(O_SUBST,stab_to_arg(A_STAB,defstab),spat);
return s;
}
--- 1019,1036 ----
if (!*s)
fatal("Substitution replacement not terminated:\n%s",str_get(linestr));
spat->spat_repl = yylval.arg;
! spat->spat_flags |= SPAT_USE_ONCE;
! while (*s == 'g' || *s == 'i') {
! if (*s == 'g') {
! s++;
! spat->spat_flags &= ~SPAT_USE_ONCE;
! }
! if (*s == 'i') {
! s++;
! spat->spat_flags |= SPAT_FOLD;
! }
}
! spat->spat_compex.do_folding = spat->spat_flags & SPAT_FOLD;
yylval.arg = make_match(O_SUBST,stab_to_arg(A_STAB,defstab),spat);
return s;
}
Index: spat.h
Prereq: 1.0.1.1
*** spat.h.old Sat Feb 6 00:30:54 1988
--- spat.h Sat Feb 6 00:30:55 1988
***************
*** 1,6 ****
! /* $Header: spat.h,v 1.0.1.1 88/02/02 11:24:37 root Exp $
*
* $Log: spat.h,v $
* Revision 1.0.1.1 88/02/02 11:24:37 root
* patch13: added flag for stripping leading spaces on split.
*
--- 1,9 ----
! /* $Header: spat.h,v 1.0.1.2 88/02/06 00:23:48 root Exp $
*
* $Log: spat.h,v $
+ * Revision 1.0.1.2 88/02/06 00:23:48 root
+ * patch21: add SPAT_FOLD flag for case insensitive searches.
+ *
* Revision 1.0.1.1 88/02/02 11:24:37 root
* patch13: added flag for stripping leading spaces on split.
*
***************
*** 24,31 ****
--- 27,36 ----
#define SPAT_SCANFIRST 4 /* initial constant not anchored */
#define SPAT_SCANALL 8 /* initial constant is whole pat */
#define SPAT_SKIPWHITE 16 /* skip leading whitespace for split */
+ #define SPAT_FOLD 32 /* case insensitivity */
EXT SPAT *spat_root; /* list of all spats */
EXT SPAT *curspat; /* what to do \ interps from */
+ EXT SPAT *lastspat; /* what to use in place of null pattern */
#define Nullspat Null(SPAT*)
Index: util.c
Prereq: 1.0.1.3
*** util.c.old Sat Feb 6 00:32:14 1988
--- util.c Sat Feb 6 00:32:16 1988
***************
*** 1,6 ****
! /* $Header: util.c,v 1.0.1.3 88/02/04 11:17:05 root Exp $
*
* $Log: util.c,v $
* Revision 1.0.1.3 88/02/04 11:17:05 root
* patch18: regularized includes.
*
--- 1,9 ----
! /* $Header: util.c,v 1.0.1.4 88/02/06 00:28:14 root Exp $
*
* $Log: util.c,v $
+ * Revision 1.0.1.4 88/02/06 00:28:14 root
+ * patch21: added trap in saferealloc() for null pointer on input.
+ *
* Revision 1.0.1.3 88/02/04 11:17:05 root
* patch18: regularized includes.
*
***************
*** 58,63 ****
--- 61,68 ----
char *ptr;
char *realloc();
+ if (!where)
+ fatal("Null realloc\n");
ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
#ifdef DEBUGGING
if (debug & 128) {
More information about the Comp.sources.bugs
mailing list