See patch #9.
-#!/bin/perl
+#! /usr/bin/perl
-# $Header: gsh,v 3.0 89/10/18 15:14:36 lwall Locked $
+# $Header: gsh,v 3.0.1.1 90/02/28 17:14:10 lwall Locked $
# Do rsh globally--see man page
sub getswitches {
while ($ARGV[0] =~ /^-/) { # parse switches
- $ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift,next);
- $ARGV[0] =~ /^-s/ && ($silent++,shift,next);
- $ARGV[0] =~ /^-d/ && ($dodist++,shift,next);
- $ARGV[0] =~ /^-n/ && ($n=' -n',shift,next);
- $ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift,shift,next);
+ $ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift(@ARGV),next);
+ $ARGV[0] =~ /^-s/ && ($silent++,shift(@ARGV),next);
+ $ARGV[0] =~ /^-d/ && ($dodist++,shift(@ARGV),next);
+ $ARGV[0] =~ /^-n/ && ($n=' -n',shift(@ARGV),next);
+ $ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift(@ARGV),shift(@ARGV),
+ next);
last;
}
}
* kit sizes from getting too big.
*/
-/* $Header: evalargs.xc,v 3.0.1.3 89/11/17 15:25:07 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.4 90/02/28 17:38:37 lwall Locked $
*
* $Log: evalargs.xc,v $
+ * Revision 3.0.1.4 90/02/28 17:38:37 lwall
+ * patch9: $#foo -= 2 didn't work
+ *
* Revision 3.0.1.3 89/11/17 15:25:07 lwall
* patch5: constant numeric subscripts disappeared in ?:
*
++sp;
stab = argptr.arg_stab;
str = stab_array(argptr.arg_stab)->ary_magic;
- if (argflags & (AF_PRE|AF_POST))
+ if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
#ifdef DEBUGGING
tmps = "LARYLEN";
break;
case A_WANTARRAY:
{
- extern int wantarray;
-
if (wantarray == G_ARRAY)
st[++sp] = &str_yes;
else
str_cat(tmpstr,
"|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
#endif
- (void)do_open(last_in_stab,tmpstr->str_ptr);
+ (void)do_open(last_in_stab,tmpstr->str_ptr,
+ tmpstr->str_cur);
fp = stab_io(last_in_stab)->ifp;
str_free(tmpstr);
}
-/* $Header: form.c,v 3.0 89/10/18 15:17:26 lwall Locked $
+/* $Header: form.c,v 3.0.1.1 90/02/28 17:39:34 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: form.c,v $
+ * Revision 3.0.1.1 90/02/28 17:39:34 lwall
+ * patch9: ... in format threw off subsequent field
+ *
* Revision 3.0 89/10/18 15:17:26 lwall
* 3.0 baseline
*
*d++ = '.';
*d++ = '.';
*d++ = '.';
+ size -= 3;
}
while (*chophere && index(chopset,*chophere))
chophere++;
-;# $Header: getopt.pl,v 3.0 89/10/18 15:19:26 lwall Locked $
+;# $Header: getopt.pl,v 3.0.1.1 90/02/28 17:41:59 lwall Locked $
;# Process single-character switches with switch clustering. Pass one argument
;# which is a string containing all switches that take an argument. For each
sub Getopt {
local($argumentative) = @_;
local($_,$first,$rest);
+ local($[) = 0;
while (($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
sub Getopts {
local($argumentative) = @_;
- local(@args,$_,$first,$rest);
+ local(@args,$_,$first,$rest,$errs);
+ local($[) = 0;
@args = split( / */, $argumentative );
while(($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
}
}
else {
- print stderr "Unknown option: $first\n";
+ print STDERR "Unknown option: $first\n";
+ ++$errs;
if($rest ne '') {
$ARGV[0] = "-$rest";
}
}
}
}
+ $errs == 0;
}
1;
$blksize = 8192 unless $blksize;
$key =~ s/[^\w\s]//g if $dict;
$key =~ y/A-Z/a-z/ if $fold;
- $max = $size + $blksize - 1;
- $max -= $size % $blksize;
- while ($max - $min > $blksize) {
- $mid = ($max + $min) / 2;
- die "look: internal error" if $mid % $blksize;
- seek(FH,$mid,0);
- $_ = <FH>; # probably a partial line
+ $max = int($size / $blksize);
+ while ($max - $min > 1) {
+ $mid = int(($max + $min) / 2);
+ seek(FH,$mid * $blksize,0);
+ $_ = <FH> if $mid; # probably a partial line
$_ = <FH>;
chop;
s/[^\w\s]//g if $dict;
$max = $mid;
}
}
+ $min *= $blksize;
seek(FH,$min,0);
+ <FH> if $min;
while (<FH>) {
chop;
s/[^\w\s]//g if $dict;
-#define PATCHLEVEL 10
+#define PATCHLEVEL 11
-/* $Header: perl.h,v 3.0.1.4 89/12/21 20:07:35 lwall Locked $
+/* $Header: perl.h,v 3.0.1.5 90/02/28 17:52:28 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.h,v $
+ * Revision 3.0.1.5 90/02/28 17:52:28 lwall
+ * patch9: Configure now determines whether volatile is supported
+ * patch9: volatilized some more variables for super-optimizing compilers
+ * patch9: unused VREG symbol deleted
+ * patch9: perl can now start up other interpreters scripts
+ * patch9: you may now undef $/ to have no input record separator
+ * patch9: nested evals clobbered their longjmp environment
+ *
* Revision 3.0.1.4 89/12/21 20:07:35 lwall
* patch7: arranged for certain registers to be restored after longjmp()
* patch7: Configure now compiles a test program to figure out time.h fiasco
*
*/
-#ifdef __STDC__
+#define VOIDUSED 1
+#include "config.h"
+
+#if defined(HASVOLATILE) || defined(__STDC__)
#define VOLATILE volatile
-#define VREG
#else
#define VOLATILE
-#define VREG register
#endif
-#define VOIDUSED 1
-#include "config.h"
-
#ifdef IAMSUID
# ifndef TAINT
# define TAINT
void do_join();
void do_sprintf();
void do_accept();
+void do_pipe();
void do_vecset();
void savelist();
void saveitem();
void savesptr();
void savehptr();
void restorelist();
+void repeatcpy();
HASH *savehash();
ARRAY *saveary();
+EXT char **origargv;
+EXT int origargc;
EXT line_t line INIT(0);
EXT line_t subline INIT(0);
EXT STR *subname INIT(Nullstr);
EXT char *filename;
EXT char *origfilename;
-EXT FILE *rsfp;
+EXT FILE * VOLATILE rsfp;
EXT char buf[1024];
EXT char *bufptr;
EXT char *oldbufptr;
EXT STR *linestr INIT(Nullstr);
-EXT char record_separator INIT('\n');
+EXT int record_separator INIT('\n');
EXT int rslen INIT(1);
EXT char *ofs INIT(Nullch);
EXT int ofslen INIT(0);
EXT bool sawstudy INIT(FALSE); /* do fbminstr on all strings */
EXT bool sawi INIT(FALSE); /* study must assume case insensitive */
EXT bool sawvec INIT(FALSE);
+EXT bool localizing INIT(FALSE); /* are we processing a local() list? */
#ifdef CSH
char *cshname INIT(CSH);
EXT char tokenbuf[256];
EXT int expectterm INIT(TRUE); /* how to interpret ambiguous tokens */
-EXT int in_eval INIT(FALSE); /* trap fatal errors? */
+EXT VOLATILE int in_eval INIT(FALSE); /* trap fatal errors? */
EXT int multiline INIT(0); /* $*--do strings hold >1 line? */
EXT int forkprocess; /* so do_open |- can return proc# */
EXT int do_undump INIT(0); /* -u or dump seen? */
EXT int unsafe;
#ifdef DEBUGGING
-EXT int debug INIT(0);
+EXT VOLATILE int debug INIT(0);
EXT int dlevel INIT(0);
EXT int dlmax INIT(128);
EXT char *debname;
EXT int loop_max INIT(128);
EXT jmp_buf top_env;
-EXT jmp_buf eval_env;
-EXT char *goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
+EXT char * VOLATILE goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
EXT ARRAY *stack; /* THE STACK */
-EXT ARRAY *savestack; /* to save non-local values on */
+EXT ARRAY * VOLATILE savestack; /* to save non-local values on */
EXT ARRAY *tosave; /* strings to save on recursive subroutine */
EXT ARRAY *pidstatary; /* keep pids and statuses by fd for mypopen */
+EXT int *di; /* for tmp use in debuggers */
+EXT char *dc;
+EXT short *ds;
+
double atof();
long time();
struct tm *gmtime(), *localtime();
.rn '' }`
-''' $Header: perl.man.1,v 3.0.1.2 89/11/17 15:30:03 lwall Locked $
+''' $Header: perl.man.1,v 3.0.1.3 90/02/28 17:54:32 lwall Locked $
'''
''' $Log: perl.man.1,v $
+''' Revision 3.0.1.3 90/02/28 17:54:32 lwall
+''' patch9: @array in scalar context now returns length of array
+''' patch9: in manual, example of open and ?: was backwards
+'''
''' Revision 3.0.1.2 89/11/17 15:30:03 lwall
''' patch5: fixed some manual typos and indent problems
'''
.fi
.PP
+If you evaluate an array in a scalar context, it returns the length of
+the array.
+The following is always true:
+.nf
+
+ @whatever == $#whatever \- $[ + 1;
+
+.fi
+.PP
Multi-dimensional arrays are not directly supported, but see the discussion
of the $; variable later for a means of emulating multiple subscripts with
an associative array.
+You could also write a subroutine to turn multiple subscripts into a single
+subscript.
.PP
Every data type has its own namespace.
You can, without fear of conflict, use the same name for a scalar variable,
from that file (newline included, so it's never false until EOF, at
which time an undefined value is returned).
Ordinarily you must assign that value to a variable,
-but there is one situation where in which an automatic assignment happens.
+but there is one situation where an automatic assignment happens.
If (and only if) the input symbol is the only thing inside the conditional of a
.I while
loop, the value is
if (!open(foo)) { die "Can't open $foo: $!"; }
die "Can't open $foo: $!" unless open(foo);
open(foo) || die "Can't open $foo: $!"; # foo or bust!
- open(foo) ? die "Can't open $foo: $!" : \'hi mom\';
+ open(foo) ? \'hi mom\' : die "Can't open $foo: $!";
# a bit exotic, that last one
.fi
''' Beginning of part 2
-''' $Header: perl.man.2,v 3.0.1.2 89/11/17 15:30:16 lwall Locked $
+''' $Header: perl.man.2,v 3.0.1.3 90/02/28 17:55:58 lwall Locked $
'''
''' $Log: perl.man.2,v $
+''' Revision 3.0.1.3 90/02/28 17:55:58 lwall
+''' patch9: grep now returns number of items matched in scalar context
+''' patch9: documented in-place modification capabilites of grep
+'''
''' Revision 3.0.1.2 89/11/17 15:30:16 lwall
''' patch5: fixed some manual typos and indent problems
'''
Evaluates EXPR for each element of LIST (locally setting $_ to each element)
and returns the array value consisting of those elements for which the
expression evaluated to true.
+In a scalar context, returns the number of times the expression was true.
.nf
@foo = grep(!/^#/, @bar); # weed out comments
.fi
+Note that, since $_ is a reference into the array value, it can be
+used to modify the elements of the array.
+While this is useful and supported, it can cause bizarre results if
+the LIST contains literal values.
.Ip "hex(EXPR)" 8 4
.Ip "hex EXPR" 8
Returns the decimal value of EXPR interpreted as an hex string.
''' Beginning of part 3
-''' $Header: perl.man.3,v 3.0.1.3 89/12/21 20:10:12 lwall Locked $
+''' $Header: perl.man.3,v 3.0.1.4 90/02/28 18:00:09 lwall Locked $
'''
''' $Log: perl.man.3,v $
+''' Revision 3.0.1.4 90/02/28 18:00:09 lwall
+''' patch9: added pipe function
+''' patch9: documented how to handle arbitrary weird characters in filenames
+''' patch9: documented the unflushed buffers problem on piped opens
+''' patch9: documented how to force top of page
+'''
''' Revision 3.0.1.3 89/12/21 20:10:12 lwall
''' patch7: documented that s`pat`repl` does command substitution on replacement
''' patch7: documented that $timeleft from select() is likely not implemented
.fi
Explicitly closing any piped filehandle causes the parent process to wait for the
child to finish, and returns the status value in $?.
+Note: on any operation which may do a fork,
+unflushed buffers remain unflushed in both
+processes, which means you may need to set $| to
+avoid duplicate output.
+.Sp
+The filename that is passed to open will have leading and trailing
+whitespace deleted.
+In order to open a file with arbitrary weird characters in it, it's necessary
+to protect any leading and trailing whitespace thusly:
+.nf
+
+.ne 2
+ $file =~ s#^(\es)#./$1#;
+ open(FOO, "< $file\e0");
+
+.fi
.Ip "opendir(DIRHANDLE,EXPR)" 8 3
Opens a directory named EXPR for processing by readdir(), telldir(), seekdir(),
rewinddir() and closedir().
.fi
The same template may generally also be used in the unpack function.
+.Ip "pipe(READHANDLE,WRITEHANDLE)" 8 3
+Opens a pair of connected pipes like the corresponding system call.
+Note that if you set up a loop of piped processes, deadlock can occur
+unless you are very careful.
+In addition, note that perl's pipes use stdio buffering, so you may need
+to set $| to flush your WRITEHANDLE after each command, depending on
+the application.
+[Requires version 3.0 patchlevel 9.]
.Ip "pop(ARRAY)" 8
.Ip "pop ARRAY" 8 6
Pops and returns the last value of the array, shortening the array by 1.
.Ip "split" 8
Splits a string into an array of strings, and returns it.
(If not in an array context, returns the number of fields found and splits
-into the @_ array.)
+into the @_ array.
+(In an array context, you can force the split into @_
+by using ?? as the pattern delimiters, but it still returns the array value.))
If EXPR is omitted, splits the $_ string.
If PATTERN is also omitted, splits on whitespace (/[\ \et\en]+/).
Anything matching PATTERN is taken to be a delimiter separating the fields.
.Sp
Top of form processing is handled automatically:
if there is insufficient room on the current page for the formatted
-record, the page is advanced, a special top-of-page format is used
+record, the page is advanced by writing a form feed,
+a special top-of-page format is used
to format the new page header, and then the record is written.
By default the top-of-page format is \*(L"top\*(R", but it
may be set to the
format of your choice by assigning the name to the $^ variable.
+The number of lines remaining on the current page is in variable $-, which
+can be set to 0 to force a new page.
.Sp
If FILEHANDLE is unspecified, output goes to the current default output channel,
which starts out as
''' Beginning of part 4
-''' $Header: perl.man.4,v 3.0.1.4 89/12/21 20:12:39 lwall Locked $
+''' $Header: perl.man.4,v 3.0.1.5 90/02/28 18:01:52 lwall Locked $
'''
''' $Log: perl.man.4,v $
+''' Revision 3.0.1.5 90/02/28 18:01:52 lwall
+''' patch9: $0 is now always the command name
+'''
''' Revision 3.0.1.4 89/12/21 20:12:39 lwall
''' patch7: documented that package'filehandle works as well as $package'variable
''' patch7: documented which identifiers are always in package main
not be relied upon.)
$+ returns whatever the last bracket match matched.
$& returns the entire matched string.
-($0 normally returns the same thing, but don't depend on it.)
+($0 used to return the same thing, but not any more.)
$\` returns everything before the matched string.
$\' returns everything after the matched string.
Examples:
Contains the name of the file containing the
.I perl
script being executed.
-The value should be copied elsewhere before any pattern matching happens, which
-clobbers $0.
(Mnemonic: same as sh and ksh.)
.Ip $<digit> 8
Contains the subpattern from the corresponding set of parentheses in the last
For instance, you could make aliases like these:
.nf
- $DBalias{'len'} = 's/^len(.*)/p length(\e$1)/';
- $DBalias{'stop'} = 's/^stop (at|in)/b/';
- $DBalias{'.'} =
- 's/^./p "\e$DBsub(\e$DBline):\et\e$DBline[\e$DBline]"/';
+ $DB'alias{'len'} = 's/^len(.*)/p length($1)/';
+ $DB'alias{'stop'} = 's/^stop (at|in)/b/';
+ $DB'alias{'.'} =
+ 's/^\e./p "\e$DB\e'sub(\e$DB\e'line):\et",\e$DB\e'line[\e$DB\e'line]/';
.fi
.Sh "Setuid Scripts"
.Ip * 4 2
The current input line is normally in $_, not $0.
It generally does not have the newline stripped.
-($0 is initially the name of the program executed, then the last matched
-string.)
+($0 is the name of the program executed.)
.Ip * 4 2
$<digit> does not refer to fields\*(--it refers to substrings matched by the last
match pattern.
OFS \h'|2.5i'$,
ORS \h'|2.5i'$\e
RLENGTH \h'|2.5i'length($&)
- RS \h'|2.5i'$\/
+ RS \h'|2.5i'$/
RSTART \h'|2.5i'length($\`)
SUBSEP \h'|2.5i'$;
-/* $Header: perl.y,v 3.0.1.3 89/12/21 20:13:41 lwall Locked $
+/* $Header: perl.y,v 3.0.1.4 90/02/28 18:03:23 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.y,v $
+ * Revision 3.0.1.4 90/02/28 18:03:23 lwall
+ * patch9: line numbers were bogus during certain portions of foreach evaluation
+ *
* Revision 3.0.1.3 89/12/21 20:13:41 lwall
* patch7: send() didn't allow a TO argument
*
stab2arg(A_STAB,scrstab),
Nullarg,Nullarg ),
$7)))));
+ $$->c_line = $2;
+ $$->c_head->c_line = $2;
}
else {
$$ = wopt(over($3,add_label($1,
stab2arg(A_STAB,scrstab),
Nullarg,Nullarg ),
$6)))));
+ $$->c_line = $2;
+ $$->c_head->c_line = $2;
}
else { /* lisp, anyone? */
$$ = wopt(over(defstab,add_label($1,
-char rcsid[] = "$Header: perly.c,v 3.0.1.3 89/12/21 20:15:41 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.4 90/02/28 18:06:41 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perly.c,v $
+ * Revision 3.0.1.4 90/02/28 18:06:41 lwall
+ * patch9: perl can now start up other interpreters scripts
+ * patch9: nested evals clobbered their longjmp environment
+ * patch9: eval could mistakenly return undef in array context
+ *
* Revision 3.0.1.3 89/12/21 20:15:41 lwall
* patch7: ANSI strerror() is now supported
* patch7: errno may now be a macro with an lvalue
register char *s;
char *index(), *strcpy(), *getenv();
bool dosearch = FALSE;
- char **origargv = argv;
#ifdef DOSUID
char *validarg = "";
#endif
#endif
#endif
+ origargv = argv;
+ origargc = argc;
uid = (int)getuid();
euid = (int)geteuid();
gid = (int)getgid();
egid = (int)getegid();
if (do_undump) {
do_undump = 0;
- loop_ptr = 0; /* start label stack again */
+ loop_ptr = -1; /* start label stack again */
goto just_doit;
}
(void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
str_numset(STAB_STR(tmpstab),(double)getpid());
if (setjmp(top_env)) /* sets goto_targ on longjump */
- loop_ptr = 0; /* start label stack again */
+ loop_ptr = -1; /* start label stack again */
#ifdef DEBUGGING
if (debug & 1024)
CMD *myroot;
ARRAY *ar;
int i;
- char *oldfile = filename;
- line_t oldline = line;
- int oldtmps_base = tmps_base;
- int oldsave = savestack->ary_fill;
- SPAT *oldspat = curspat;
+ char * VOLATILE oldfile = filename;
+ VOLATILE line_t oldline = line;
+ VOLATILE int oldtmps_base = tmps_base;
+ VOLATILE int oldsave = savestack->ary_fill;
+ SPAT * VOLATILE oldspat = curspat;
static char *last_eval = Nullch;
static CMD *last_root = Nullcmd;
VOLATILE int sp = arglast[0];
+ char *tmps;
tmps_base = tmps_max;
if (curstash != stash) {
in_eval++;
oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
bufend = bufptr + linestr->str_cur;
- if (setjmp(eval_env)) {
+ if (++loop_ptr >= loop_max) {
+ loop_max += 128;
+ Renew(loop_stack, loop_max, struct loop);
+ }
+ loop_stack[loop_ptr].loop_label = "_EVAL_";
+ loop_stack[loop_ptr].loop_sp = sp;
+#ifdef DEBUGGING
+ if (debug & 4) {
+ deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+ }
+#endif
+ if (setjmp(loop_stack[loop_ptr].loop_env)) {
retval = 1;
last_root = Nullcmd;
}
}
myroot = eval_root; /* in case cmd_exec does another eval! */
if (retval || error_count) {
- str = &str_undef;
+ st = stack->ary_array;
+ sp = arglast[0];
+ if (gimme != G_ARRAY)
+ st[++sp] = &str_undef;
last_root = Nullcmd; /* can't free on error, for some reason */
if (rsfp) {
fclose(rsfp);
cmd_free(myroot);
}
in_eval--;
+#ifdef DEBUGGING
+ if (debug & 4) {
+ tmps = loop_stack[loop_ptr].loop_label;
+ deb("(Popping label #%d %s)\n",loop_ptr,
+ tmps ? tmps : "" );
+ }
+#endif
+ loop_ptr--;
filename = oldfile;
line = oldline;
tmps_base = oldtmps_base;
* blame Henry for some of the lack of readability.
*/
-/* $Header: regcomp.c,v 3.0.1.1 89/11/11 04:51:04 lwall Locked $
+/* $Header: regcomp.c,v 3.0.1.2 90/02/28 18:08:35 lwall Locked $
*
* $Log: regcomp.c,v $
+ * Revision 3.0.1.2 90/02/28 18:08:35 lwall
+ * patch9: /[\200-\377]/ didn't work on machines with signed chars
+ *
* Revision 3.0.1.1 89/11/11 04:51:04 lwall
* patch2: /[\000]/ didn't work
*
{
if (regcode == ®dummy)
return;
+ c &= 255;
if (def)
bits[c >> 3] &= ~(1 << (c & 7));
else
* blame Henry for some of the lack of readability.
*/
-/* $Header: regexec.c,v 3.0.1.2 89/12/21 20:16:27 lwall Locked $
+/* $Header: regexec.c,v 3.0.1.3 90/02/28 18:14:39 lwall Locked $
*
* $Log: regexec.c,v $
+ * Revision 3.0.1.3 90/02/28 18:14:39 lwall
+ * patch9: /[\200-\377]/ didn't work on machines with signed chars
+ * patch9: \d, \w, and \s could misfire on characters with high bit set
+ * patch9: /\bfoo/i didn't work
+ *
* Revision 3.0.1.2 89/12/21 20:16:27 lwall
* patch7: certain patterns didn't match correctly at end of string
*
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
*/
*/
static char *regprecomp;
static char *reginput; /* String-input pointer. */
+static char regprev; /* char before regbol, \n if none */
static char *regbol; /* Beginning of input, for ^ check. */
static char *regeol; /* End of input, for $ check. */
static char **regstartp; /* Pointer to startp array. */
register int tmp;
int minlen = 0; /* must match at least this many chars */
int dontbother = 0; /* how many characters not to try at end */
- int beginning = (string == strbeg); /* is ^ valid at stringarg? */
/* Be paranoid... */
if (prog == NULL || string == NULL) {
return(0);
}
+ if (string == strbeg) /* is ^ valid at stringarg? */
+ regprev = '\n';
+ else
+ regprev = stringarg[-1];
regprecomp = prog->precomp;
/* Check validity of program. */
if (UCHARAT(prog->program) != MAGIC) {
string = c;
strend = string + i;
for (s = string; s < strend; s++)
- if (isupper(*s))
+ if (isUPPER(*s))
*s = tolower(*s);
}
/* If there is a "must appear" string, look for it. */
s = string;
if (prog->regmust != Nullstr) {
- if (beginning && screamer) {
+ if (stringarg == strbeg && screamer) {
if (screamfirst[prog->regmust->str_rare] >= 0)
s = screaminstr(screamer,prog->regmust);
else
}
/* Mark beginning of line for ^ . */
- if (beginning)
- regbol = string;
- else
- regbol = NULL;
+ regbol = string;
/* Mark end of line for $ (and such) */
regeol = strend;
case ANYOF: case ANYBUT:
c = OPERAND(c);
while (s < strend) {
- i = *s;
+ i = UCHARAT(s);
if (!(c[i >> 3] & (1 << (i&7))))
if (regtry(prog, s))
goto got_it;
dontbother++,strend--;
if (s != string) {
i = s[-1];
- tmp = (isalpha(i) || isdigit(i) || i == '_');
+ tmp = isALNUM(i);
}
else
- tmp = 0; /* assume not alphanumeric */
+ tmp = isALNUM(regprev); /* assume not alphanumeric */
while (s < strend) {
i = *s;
- if (tmp != (isalpha(i) || isdigit(i) || i == '_')) {
+ if (tmp != isALNUM(i)) {
tmp = !tmp;
if (regtry(prog, s))
goto got_it;
dontbother++,strend--;
if (s != string) {
i = s[-1];
- tmp = (isalpha(i) || isdigit(i) || i == '_');
+ tmp = isALNUM(i);
}
else
- tmp = 0; /* assume not alphanumeric */
+ tmp = isALNUM(regprev); /* assume not alphanumeric */
while (s < strend) {
i = *s;
- if (tmp != (isalpha(i) || isdigit(i) || i == '_'))
+ if (tmp != isALNUM(i))
tmp = !tmp;
else if (regtry(prog, s))
goto got_it;
case ALNUM:
while (s < strend) {
i = *s;
- if (isalpha(i) || isdigit(i) || i == '_')
+ if (isALNUM(i))
if (regtry(prog, s))
goto got_it;
s++;
case NALNUM:
while (s < strend) {
i = *s;
- if (!isalpha(i) && !isdigit(i) && i != '_')
+ if (!isALNUM(i))
if (regtry(prog, s))
goto got_it;
s++;
break;
case SPACE:
while (s < strend) {
- if (isspace(*s))
+ if (isSPACE(*s))
if (regtry(prog, s))
goto got_it;
s++;
break;
case NSPACE:
while (s < strend) {
- if (!isspace(*s))
+ if (!isSPACE(*s))
if (regtry(prog, s))
goto got_it;
s++;
break;
case DIGIT:
while (s < strend) {
- if (isdigit(*s))
+ if (isDIGIT(*s))
if (regtry(prog, s))
goto got_it;
s++;
break;
case NDIGIT:
while (s < strend) {
- if (!isdigit(*s))
+ if (!isDIGIT(*s))
if (regtry(prog, s))
goto got_it;
s++;
switch (OP(scan)) {
case BOL:
- if (locinput == regbol ||
+ if (locinput == regbol ? regprev == '\n' :
((nextchar || locinput < regeol) &&
locinput[-1] == '\n') )
{
case ALNUM:
if (!nextchar)
return(0);
- if (!isalpha(nextchar) && !isdigit(nextchar) &&
- nextchar != '_')
+ if (!isALNUM(nextchar))
return(0);
nextchar = *++locinput;
break;
case NALNUM:
if (!nextchar && locinput >= regeol)
return(0);
- if (isalpha(nextchar) || isdigit(nextchar) ||
- nextchar == '_')
+ if (isALNUM(nextchar))
return(0);
nextchar = *++locinput;
break;
case NBOUND:
case BOUND:
if (locinput == regbol) /* was last char in word? */
- ln = 0;
+ ln = isALNUM(regprev);
else
- ln = (isalpha(locinput[-1]) ||
- isdigit(locinput[-1]) ||
- locinput[-1] == '_' );
- n = (isalpha(nextchar) || isdigit(nextchar) ||
- nextchar == '_' ); /* is next char in word? */
+ ln = isALNUM(locinput[-1]);
+ n = isALNUM(nextchar); /* is next char in word? */
if ((ln == n) == (OP(scan) == BOUND))
return(0);
break;
case SPACE:
if (!nextchar && locinput >= regeol)
return(0);
- if (!isspace(nextchar))
+ if (!isSPACE(nextchar))
return(0);
nextchar = *++locinput;
break;
case NSPACE:
if (!nextchar)
return(0);
- if (isspace(nextchar))
+ if (isSPACE(nextchar))
return(0);
nextchar = *++locinput;
break;
case DIGIT:
- if (!isdigit(nextchar))
+ if (!isDIGIT(nextchar))
return(0);
nextchar = *++locinput;
break;
case NDIGIT:
if (!nextchar && locinput >= regeol)
return(0);
- if (isdigit(nextchar))
+ if (isDIGIT(nextchar))
return(0);
nextchar = *++locinput;
break;
}
break;
case ALNUM:
- while (isalpha(*scan) || isdigit(*scan) || *scan == '_')
+ while (isALNUM(*scan))
scan++;
break;
case NALNUM:
- while (scan < loceol && (!isalpha(*scan) && !isdigit(*scan) &&
- *scan != '_'))
+ while (scan < loceol && !isALNUM(*scan))
scan++;
break;
case SPACE:
- while (scan < loceol && isspace(*scan))
+ while (scan < loceol && isSPACE(*scan))
scan++;
break;
case NSPACE:
- while (scan < loceol && !isspace(*scan))
+ while (scan < loceol && !isSPACE(*scan))
scan++;
break;
case DIGIT:
- while (isdigit(*scan))
+ while (isDIGIT(*scan))
scan++;
break;
case NDIGIT:
- while (scan < loceol && !isdigit(*scan))
+ while (scan < loceol && !isDIGIT(*scan))
scan++;
break;
default: /* Oh dear. Called inappropriately. */
#!./perl
-# $Header: io.pipe,v 3.0 89/10/18 15:26:30 lwall Locked $
+# $Header: io.pipe,v 3.0.1.1 90/02/28 18:32:41 lwall Locked $
$| = 1;
-print "1..4\n";
+print "1..8\n";
open(PIPE, "|-") || (exec 'tr', '[A-Z]', '[a-z]');
print PIPE "OK 1\n";
if (open(PIPE, "-|")) {
while(<PIPE>) {
+ s/^not //;
print;
}
}
else {
- print STDOUT "ok 3\n";
- exec 'echo', 'ok 4';
+ print STDOUT "not ok 3\n";
+ exec 'echo', 'not ok 4';
}
+
+pipe(READER,WRITER) || die "Can't open pipe";
+
+if ($pid = fork) {
+ close WRITER;
+ while(<READER>) {
+ s/^not //;
+ y/A-Z/a-z/;
+ print;
+ }
+}
+else {
+ die "Couldn't fork" unless defined $pid;
+ close READER;
+ print WRITER "not ok 5\n";
+ open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT";
+ close WRITER;
+ exec 'echo', 'not ok 6';
+}
+
+
+pipe(READER,WRITER) || die "Can't open pipe";
+close READER;
+
+$SIG{'PIPE'} = 'broken_pipe';
+
+sub broken_pipe {
+ print "ok 7\n";
+}
+
+print WRITER "not ok 7\n";
+close WRITER;
+
+print "ok 8\n";
#!./perl
-# $Header: op.mkdir,v 3.0.1.1 89/11/11 05:00:47 lwall Locked $
+# $Header: op.mkdir,v 3.0.1.2 90/02/28 18:35:31 lwall Locked $
print "1..7\n";
print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
-print ($! =~ /such/ ? "ok 7\n" : "not ok 7\n");
+print ($! =~ /such|exist/ ? "ok 7\n" : "not ok 7\n");
#!./perl
-# $Header: op.stat,v 3.0.1.2 89/11/17 15:39:27 lwall Locked $
+# $Header: op.stat,v 3.0.1.3 90/02/28 18:36:51 lwall Locked $
print "1..56\n";
$cnt = $uid = 0;
-while (</usr/bin/*>) {
+chop($cwd = `pwd`);
+die "Can't run op.stat test 35 without pwd working" unless $cwd;
+chdir '/usr/bin' || die "Can't cd to /usr/bin";
+while (<*>) {
$cnt++;
$uid++ if -u;
last if $uid && $uid < $cnt;
}
+chdir $cwd || die "Can't cd back to $cwd";
# I suppose this is going to fail somewhere...
if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
#!./perl
-# $Header: op.subst,v 3.0 89/10/18 15:31:43 lwall Locked $
+# $Header: op.subst,v 3.0.1.1 90/02/28 18:37:30 lwall Locked $
print "1..42\n";
$_ = '\\' x 4;
if (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
s/\\/\\\\/g;
-if ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10\n";}
+if ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10 $_\n";}
$_ = '\/' x 4;
if (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
projects / p5sagit/p5-mst-13.2.git / commitdiff