See patch #11.
-/* $RCSfile: doio.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:21:19 $
+/* $RCSfile: doio.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:51:43 $
*
* Copyright (c) 1991, Larry Wall
*
* License or the Artistic License, as specified in the README file.
*
* $Log: doio.c,v $
+ * Revision 4.0.1.4 91/11/05 16:51:43 lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: perl mistook some streams for sockets because they return mode 0 too
+ * patch11: reopening STDIN, STDOUT and STDERR failed on some machines
+ * patch11: certain perl errors should set EBADF so that $! looks better
+ * patch11: truncate on a closed filehandle could dump
+ * patch11: stats of _ forgot whether prior stat was actually lstat
+ * patch11: -T returned true on NFS directory
+ *
* 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
name = myname;
forkprocess = 1; /* assume true if no fork */
- while (len && isspace(name[len-1]))
+ while (len && isSPACE(name[len-1]))
name[--len] = '\0';
if (!stio)
stio = stab_io(stab) = stio_new();
}
stio->type = *name;
if (*name == '|') {
- for (name++; isspace(*name); name++) ;
+ /*SUPPRESS 530*/
+ for (name++; isSPACE(*name); name++) ;
#ifdef TAINT
taintenv();
taintproper("Insecure dependency in piped open");
if (*name == '&') {
duplicity:
name++;
- while (isspace(*name))
+ while (isSPACE(*name))
name++;
- if (isdigit(*name))
+ if (isDIGIT(*name))
fd = atoi(name);
else {
stab = stabent(name,FALSE);
}
}
else {
- while (isspace(*name))
+ while (isSPACE(*name))
name++;
if (strEQ(name,"-")) {
fp = stdout;
if (*name == '<') {
mode[0] = 'r';
name++;
- while (isspace(*name))
+ while (isSPACE(*name))
name++;
if (*name == '&')
goto duplicity;
taintproper("Insecure dependency in piped open");
#endif
name[--len] = '\0';
- while (len && isspace(name[len-1]))
+ while (len && isSPACE(name[len-1]))
name[--len] = '\0';
- for (; isspace(*name); name++) ;
+ /*SUPPRESS 530*/
+ for (; isSPACE(*name); name++) ;
fp = mypopen(name,"r");
stio->type = '|';
}
else {
stio->type = '<';
- for (; isspace(*name); name++) ;
+ /*SUPPRESS 530*/
+ for (; isSPACE(*name); name++) ;
if (strEQ(name,"-")) {
fp = stdin;
stio->type = '-';
}
if (S_ISSOCK(statbuf.st_mode))
stio->type = 's'; /* in case a socket was passed in to us */
+#ifdef HAS_SOCKET
+ else if (
#ifdef S_IFMT
- else if (!(statbuf.st_mode & S_IFMT))
- stio->type = 's'; /* some OS's return 0 on fstat()ed socket */
+ !(statbuf.st_mode & S_IFMT)
+#else
+ !statbuf.st_mode
+#endif
+ ) {
+ if (getsockname(fileno(fp), tokenbuf, 0) >= 0 || errno != ENOTSOCK)
+ stio->type = 's'; /* some OS's return 0 on fstat()ed socket */
+ /* but some return 0 for streams too, sigh */
+ }
#endif
}
if (saveifp) { /* must use old fp? */
fflush(saveofp); /* emulate fclose() */
if (saveofp != saveifp) { /* was a socket? */
fclose(saveofp);
- Safefree(saveofp);
+ if (fd > 2)
+ Safefree(saveofp);
}
}
if (fd != fileno(fp)) {
register STAB *stab;
{
register STR *str;
+#ifndef FLEXFILENAMES
int filedev;
int fileino;
+#endif
int fileuid;
int filegid;
static int filemode = 0;
defoutstab = stabent("STDOUT",TRUE);
return stab_io(stab)->ifp;
}
+#ifndef FLEXFILENAMES
filedev = statbuf.st_dev;
fileino = statbuf.st_ino;
+#endif
filemode = statbuf.st_mode;
fileuid = statbuf.st_uid;
filegid = statbuf.st_gid;
if (!stab)
stab = argvstab;
- if (!stab)
+ if (!stab) {
+ errno = EBADF;
return FALSE;
+ }
stio = stab_io(stab);
if (!stio) { /* never opened */
if (dowarn && explicit)
phooey:
if (dowarn)
warn("tell() on unopened file");
+ errno = EBADF;
return -1L;
}
nuts:
if (dowarn)
warn("seek() on unopened file");
+ errno = EBADF;
return FALSE;
}
register char *s;
int retval;
- if (!stab || !argstr)
- return -1;
- stio = stab_io(stab);
- if (!stio)
+ if (!stab || !argstr || !(stio = stab_io(stab)) || !stio->ifp) {
+ errno = EBADF; /* well, sort of... */
return -1;
+ }
if (argstr->str_pok || !argstr->str_nok) {
if (!argstr->str_pok)
}
#endif /* F_FREESP */
-int
+int /*SUPPRESS 590*/
do_truncate(str,arg,gimme,arglast)
STR *str;
register ARG *arg;
#ifdef HAS_TRUNCATE
if ((arg[1].arg_type & A_MASK) == A_WORD) {
tmpstab = arg[1].arg_ptr.arg_stab;
- if (!stab_io(tmpstab) ||
+ if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
result = 0;
}
#else
if ((arg[1].arg_type & A_MASK) == A_WORD) {
tmpstab = arg[1].arg_ptr.arg_stab;
- if (!stab_io(tmpstab) ||
+ if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
result = 0;
}
return TRUE;
s = str->str_ptr;
send = s + str->str_cur;
- while (isspace(*s))
+ while (isSPACE(*s))
s++;
if (s >= send)
return FALSE;
if (*s == '+' || *s == '-')
s++;
- while (isdigit(*s))
+ while (isDIGIT(*s))
s++;
if (s == send)
return TRUE;
s++;
else if (s == str->str_ptr)
return FALSE;
- while (isdigit(*s))
+ while (isDIGIT(*s))
s++;
if (s == send)
return TRUE;
s++;
if (*s == '+' || *s == '-')
s++;
- while (isdigit(*s))
+ while (isDIGIT(*s))
s++;
}
- while (isspace(*s))
+ while (isSPACE(*s))
s++;
if (s >= send)
return TRUE;
if (!fp) {
if (dowarn)
warn("print to unopened file");
+ errno = EBADF;
return FALSE;
}
if (!str)
if (!fp) {
if (dowarn)
warn("print to unopened file");
+ errno = EBADF;
return FALSE;
}
st += ++sp;
{
STIO *stio;
- laststype = O_STAT;
if (arg[1].arg_type & A_DONT) {
stio = stab_io(arg[1].arg_ptr.arg_stab);
if (stio && stio->ifp) {
statstab = arg[1].arg_ptr.arg_stab;
str_set(statname,"");
+ laststype = O_STAT;
return (laststatval = fstat(fileno(stio->ifp), &statcache));
}
else {
else {
statstab = Nullstab;
str_set(statname,str_get(str));
+ laststype = O_STAT;
return (laststatval = stat(str_get(str),&statcache));
}
}
if (stio && stio->ifp) {
#ifdef STDSTDIO
fstat(fileno(stio->ifp),&statcache);
+ if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */
+ return arg->arg_type == O_FTTEXT ? &str_no : &str_yes;
if (stio->ifp->_cnt <= 0) {
i = getc(stio->ifp);
if (i != EOF)
len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
s = stio->ifp->_base;
#else
- fatal("-T and -B not implemented on filehandles\n");
+ fatal("-T and -B not implemented on filehandles");
#endif
}
else {
if (dowarn)
warn("Test on unopened file <%s>",
stab_name(arg[1].arg_ptr.arg_stab));
+ errno = EBADF;
return &str_undef;
}
}
fstat(i,&statcache);
len = read(i,tbuf,512);
(void)close(i);
- if (len <= 0) /* null file is anything */
- return &str_yes;
+ if (len <= 0) {
+ if (S_ISDIR(statcache.st_mode) && arg->arg_type == O_FTTEXT)
+ return &str_no; /* special case NFS directories */
+ return &str_yes; /* null file is anything */
+ }
s = tbuf;
}
/* see if there are shell metacharacters in it */
- for (s = cmd; *s && isalpha(*s); s++) ; /* catch VAR=val gizmo */
+ /*SUPPRESS 530*/
+ for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */
if (*s == '=')
goto doshell;
for (s = cmd; *s; s++) {
- if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+ if (*s != ' ' && !isALPHA(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) {
if (*s == '\n' && !s[1]) {
*s = '\0';
break;
Cmd = nsavestr(cmd, s-cmd);
a = Argv;
for (s = Cmd; *s;) {
- while (*s && isspace(*s)) s++;
+ while (*s && isSPACE(*s)) s++;
if (*s)
*(a++) = s;
- while (*s && !isspace(*s)) s++;
+ while (*s && !isSPACE(*s)) s++;
if (*s)
*s++ = '\0';
}
register STIO *stio;
int domain, type, protocol, fd;
- if (!stab)
+ if (!stab) {
+ errno = EBADF;
return FALSE;
+ }
stio = stab_io(stab);
if (!stio)
nuts:
if (dowarn)
warn("bind() on closed fd");
+ errno = EBADF;
return FALSE;
}
nuts:
if (dowarn)
warn("connect() on closed fd");
+ errno = EBADF;
return FALSE;
}
nuts:
if (dowarn)
warn("listen() on closed fd");
+ errno = EBADF;
return FALSE;
}
nuts:
if (dowarn)
warn("accept() on closed fd");
+ errno = EBADF;
badexit:
str_sset(str,&str_undef);
return;
nuts:
if (dowarn)
warn("shutdown() on closed fd");
+ errno = EBADF;
return FALSE;
}
optname = (int)str_gnum(st[sp+2]);
switch (optype) {
case O_GSOCKOPT:
- st[sp] = str_2mortal(str_new(257));
+ st[sp] = str_2mortal(Str_new(22,257));
st[sp]->str_cur = 256;
st[sp]->str_pok = 1;
if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
if (dowarn)
warn("[gs]etsockopt() on closed fd");
st[sp] = &str_undef;
+ errno = EBADF;
return sp;
}
if (!stio || !stio->ifp)
goto nuts;
- st[sp] = str_2mortal(str_new(257));
+ st[sp] = str_2mortal(Str_new(22,257));
st[sp]->str_cur = 256;
st[sp]->str_pok = 1;
fd = fileno(stio->ifp);
nuts:
if (dowarn)
warn("get{sock,peer}name() on closed fd");
+ errno = EBADF;
nuts2:
st[sp] = &str_undef;
return sp;
case O_READDIR:
if (gimme == G_ARRAY) {
--sp;
+ /*SUPPRESS 560*/
while (dp = readdir(stio->dirp)) {
#ifdef DIRNAMLEN
(void)astore(ary,++sp,
nope:
st[sp] = &str_undef;
+ if (!errno)
+ errno = EBADF;
return sp;
#else
if (--items > 0) {
tot = items;
s = str_get(st[++sp]);
- if (isupper(*s)) {
+ if (isUPPER(*s)) {
if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
s += 3;
if (!(val = whichsig(s)))
-/* $RCSfile: dolist.c,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:22:15 $
+/* $RCSfile: dolist.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:07:02 $
*
* Copyright (c) 1991, Larry Wall
*
* License or the Artistic License, as specified in the README file.
*
* $Log: dolist.c,v $
+ * Revision 4.0.1.3 91/11/05 17:07:02 lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: /$foo/o optimizer could access deallocated data
+ * patch11: certain optimizations of //g in array context returned too many values
+ * patch11: regexp with no parens in array context returned wacky $`, $& and $'
+ * patch11: $' not set right on some //g
+ * patch11: added some support for 64-bit integers
+ * patch11: grep of a split lost its values
+ * patch11: added sort {} LIST
+ * patch11: multiple reallocations now avoided in 1 .. 100000
+ *
* Revision 4.0.1.2 91/06/10 01:22:15 lwall
* patch10: //g only worked first time through
*
if (!spat->spat_regexp->prelen && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
+ scanconst(spat,spat->spat_regexp->precomp, spat->spat_regexp->prelen);
if (spat->spat_runtime)
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
- scanconst(spat, t, tmpstr->str_cur);
hoistmust(spat);
if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
curcmd->c_flags &= ~CF_OPTIMIZE;
t = s;
play_it_again:
if (global && spat->spat_regexp->startp[0])
- s = spat->spat_regexp->endp[0];
+ t = s = spat->spat_regexp->endp[0];
if (myhint) {
if (myhint < s || myhint > strend)
fatal("panic: hint in do_match");
spat->spat_short = Nullstr; /* opt is being useless */
}
}
- if (!spat->spat_regexp->nparens && !global)
+ if (!spat->spat_regexp->nparens && !global) {
gimme = G_SCALAR; /* accidental array context? */
+ safebase = FALSE;
+ }
if (regexec(spat->spat_regexp, s, strend, t, 0,
srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
safebase)) {
for (i = !i; i <= iters; i++) {
st[++sp] = str_mortal(&str_no);
+ /*SUPPRESS 560*/
if (s = spat->spat_regexp->startp[i]) {
len = spat->spat_regexp->endp[i] - s;
if (len > 0)
if (spat->spat_flags & SPAT_ONCE)
spat->spat_flags |= SPAT_USED;
if (global) {
+ spat->spat_regexp->subbeg = t;
+ spat->spat_regexp->subend = strend;
spat->spat_regexp->startp[0] = s;
spat->spat_regexp->endp[0] = s + spat->spat_short->str_cur;
curspat = spat;
ary = stack;
orig = s;
if (spat->spat_flags & SPAT_SKIPWHITE) {
- while (isascii(*s) && isspace(*s))
+ while (isSPACE(*s))
s++;
}
if (!limit)
limit = maxiters + 2;
if (strEQ("\\s+",spat->spat_regexp->precomp)) {
while (--limit) {
- for (m = s; m < strend && !(isascii(*m)&&isspace(*m)); m++) ;
+ /*SUPPRESS 530*/
+ for (m = s; m < strend && !isSPACE(*m); m++) ;
if (m >= strend)
break;
dstr = Str_new(30,m-s);
if (!realarray)
str_2mortal(dstr);
(void)astore(ary, ++sp, dstr);
- for (s = m + 1; s < strend && isascii(*s) && isspace(*s); s++) ;
+ /*SUPPRESS 530*/
+ for (s = m + 1; s < strend && isSPACE(*s); s++) ;
}
}
else if (strEQ("^",spat->spat_regexp->precomp)) {
while (--limit) {
+ /*SUPPRESS 530*/
for (m = s; m < strend && *m != '\n'; m++) ;
m++;
if (m >= strend)
int fold = (spat->spat_flags & SPAT_FOLD);
i = *spat->spat_short->str_ptr;
- if (fold && isupper(i))
+ if (fold && isUPPER(i))
i = tolower(i);
while (--limit) {
if (fold) {
for ( m = s;
m < strend && *m != i &&
- (!isupper(*m) || tolower(*m) != i);
- m++)
+ (!isUPPER(*m) || tolower(*m) != i);
+ m++) /*SUPPRESS 530*/
;
}
- else
+ else /*SUPPRESS 530*/
for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
short ashort;
int aint;
long along;
+#ifdef QUAD
+ quad aquad;
+#endif
unsigned short aushort;
unsigned int auint;
unsigned long aulong;
+#ifdef QUAD
+ unsigned quad auquad;
+#endif
char *aptr;
float afloat;
double adouble;
double cdouble;
if (gimme != G_ARRAY) { /* arrange to do first one only */
- for (patend = pat; !isalpha(*patend); patend++);
+ /*SUPPRESS 530*/
+ for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
if (index("aAbBhH", *patend) || *pat == '%') {
patend++;
- while (isdigit(*patend) || *patend == '*')
+ while (isDIGIT(*patend) || *patend == '*')
patend++;
}
else
len = strend - strbeg; /* long enough */
pat++;
}
- else if (isdigit(*pat)) {
+ else if (isDIGIT(*pat)) {
len = *pat++ - '0';
- while (isdigit(*pat))
+ while (isDIGIT(*pat))
len = (len * 10) + (*pat++ - '0');
}
else
if (datumtype == 'A') {
aptr = s; /* borrow register */
s = str->str_ptr + len - 1;
- while (s >= str->str_ptr && (!*s || (isascii(*s)&&isspace(*s))))
+ while (s >= str->str_ptr && (!*s || isSPACE(*s)))
s--;
*++s = '\0';
str->str_cur = s - str->str_ptr;
if (datumtype == 'b') {
aint = len;
for (len = 0; len < aint; len++) {
- if (len & 7)
+ if (len & 7) /*SUPPRESS 595*/
bits >>= 1;
else
bits = *s++;
(void)astore(stack, ++sp, str_2mortal(str));
}
break;
+#ifdef QUAD
+ case 'q':
+ while (len-- > 0) {
+ if (s + sizeof(quad) > strend)
+ aquad = 0;
+ else {
+ bcopy(s,(char*)&aquad,sizeof(quad));
+ s += sizeof(quad);
+ }
+ str = Str_new(42,0);
+ str_numset(str,(double)aquad);
+ (void)astore(stack, ++sp, str_2mortal(str));
+ }
+ break;
+ case 'Q':
+ while (len-- > 0) {
+ if (s + sizeof(unsigned quad) > strend)
+ auquad = 0;
+ else {
+ bcopy(s,(char*)&auquad,sizeof(unsigned quad));
+ s += sizeof(unsigned quad);
+ }
+ str = Str_new(43,0);
+ str_numset(str,(double)auquad);
+ (void)astore(stack, ++sp, str_2mortal(str));
+ }
+ break;
+#endif
/* float and double added gnb@melba.bby.oz.au 22/11/89 */
case 'f':
case 'F':
length = 0;
}
else
- length = ary->ary_max; /* close enough to infinity */
+ length = ary->ary_max + 1; /* close enough to infinity */
}
else {
offset = 0;
- length = ary->ary_max;
+ length = ary->ary_max + 1;
}
if (offset < 0) {
length += offset;
}
arg = arg[1].arg_ptr.arg_arg;
while (i-- > 0) {
- if (st[src])
+ if (st[src]) {
+ st[src]->str_pok &= ~SP_TEMP;
stab_val(defstab) = st[src];
+ }
else
stab_val(defstab) = str_mortal(&str_undef);
(void)eval(arg,G_SCALAR,sp);
static STAB *secondstab = Nullstab;
int
-do_sort(str,stab,gimme,arglast)
+do_sort(str,arg,gimme,arglast)
STR *str;
-STAB *stab;
+ARG *arg;
int gimme;
int *arglast;
{
STR *oldfirst;
STR *oldsecond;
ARRAY *oldstack;
+ HASH *stash;
static ARRAY *sortstack = Null(ARRAY*);
if (gimme != G_ARRAY) {
up = &st[sp];
st += sp; /* temporarily make st point to args */
for (i = 1; i <= max; i++) {
+ /*SUPPRESS 560*/
if (*up = st[i]) {
if (!(*up)->str_pok)
(void)str_2ptr(*up);
max = up - &st[sp];
sp--;
if (max > 1) {
- if (stab) {
+ STAB *stab;
+
+ if (arg[1].arg_type == (A_CMD|A_DONT)) {
+ sortcmd = arg[1].arg_ptr.arg_cmd;
+ stash = curcmd->c_stash;
+ }
+ else {
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[sp+1]),TRUE);
+
+ if (stab) {
+ if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
+ fatal("Undefined subroutine \"%s\" in sort",
+ stab_name(stab));
+ stash = stab_stash(stab);
+ }
+ else
+ sortcmd = Nullcmd;
+ }
+
+ if (sortcmd) {
int oldtmps_base = tmps_base;
- if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
- fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
if (!sortstack) {
sortstack = anew(Nullstab);
astore(sortstack, 0, Nullstr);
oldstack = stack;
stack = sortstack;
tmps_base = tmps_max;
- if (sortstash != stab_stash(stab)) {
+ if (sortstash != stash) {
firststab = stabent("a",TRUE);
secondstab = stabent("b",TRUE);
- sortstash = stab_stash(stab);
+ sortstash = stash;
}
oldfirst = stab_val(firststab);
oldsecond = stab_val(secondstab);
int retval;
if (str1->str_cur < str2->str_cur) {
+ /*SUPPRESS 560*/
if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
return retval;
else
return -1;
}
+ /*SUPPRESS 560*/
else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
return retval;
else if (str1->str_cur == str2->str_cur)
(looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
i = (int)str_gnum(st[sp+1]);
max = (int)str_gnum(st[sp+2]);
+ if (max > i)
+ (void)astore(ary, sp + max - i + 1, Nullstr);
while (i <= max) {
(void)astore(ary, ++sp, str = str_mortal(&str_no));
str_numset(str,(double)i++);
register int sp = arglast[0];
register int items = arglast[1] - sp;
register int count = (int) str_gnum(st[arglast[2]]);
- register ARRAY *ary = stack;
register int i;
int max;
str_2mortal(str_nmake((double)csv->wantarray)) );
if (csv->hasargs) {
ARRAY *ary = csv->argarray;
- STAB *tmpstab;
if (!dbargs)
dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
return sp;
}
(void)hiterinit(hash);
+ /*SUPPRESS 560*/
while (entry = hiternext(hash)) {
if (dokeys) {
tmps = hiterkey(entry,&i);
-/* $RCSfile: eval.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:07:23 $
+/* $RCSfile: eval.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:15:21 $
*
* Copyright (c) 1991, Larry Wall
*
* License or the Artistic License, as specified in the README file.
*
* $Log: eval.c,v $
+ * Revision 4.0.1.3 91/11/05 17:15:21 lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: various portability fixes
+ * patch11: added sort {} LIST
+ * patch11: added eval {}
+ * patch11: sysread() in socket was substituting recv()
+ * patch11: a last statement outside any block caused occasional core dumps
+ * patch11: missing arguments caused core dump in -D8 code
+ * patch11: eval 'stuff' now optimized to eval {stuff}
+ *
* Revision 4.0.1.2 91/06/07 11:07:23 lwall
* patch4: new copyright notice
* patch4: length($`), length($&), length($') now optimized to avoid string copy
if (fp) {
if (gimme == G_SCALAR) {
while (str_gets(str,fp,str->str_cur) != Nullch)
+ /*SUPPRESS 530*/
;
}
else {
else
str->str_cur++;
for (tmps = str->str_ptr; *tmps; tmps++)
- if (!isalpha(*tmps) && !isdigit(*tmps) &&
+ if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
index("$&*(){}[]'\";\\|?<>~`",*tmps))
break;
if (*tmps && stat(str->str_ptr,&statbuf) < 0)
case O_DIVIDE:
if ((value = str_gnum(st[2])) == 0.0)
fatal("Illegal division by zero");
-#ifdef cray
+#ifdef SLOPPYDIVIDE
/* insure that 20./5. == 4. */
{
double x;
value = -str_gnum(st[1]);
goto donumset;
case O_NOT:
+#ifdef NOTNOT
+ { char xxx = str_true(st[1]); value = (double) !xxx; }
+#else
value = (double) !str_true(st[1]);
+#endif
goto donumset;
case O_COMPLEMENT:
if (!sawvec || st[1]->str_nok) {
case O_SUBSTR:
anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/
tmps = str_get(st[1]); /* force conversion to string */
+ /*SUPPRESS 560*/
if (argtype = (str == st[1]))
str = arg->arg_ptr.arg_str;
if (anum < 0)
}
break;
case O_PACK:
+ /*SUPPRESS 701*/
(void)do_pack(str,arglast);
break;
case O_GREP:
st = stack->ary_array + arglast[0]; /* maybe realloced */
goto array_return;
case O_SORT:
- if ((arg[1].arg_type & A_MASK) == A_WORD)
- stab = arg[1].arg_ptr.arg_stab;
- else
- stab = stabent(str_get(st[1]),TRUE);
- sp = do_sort(str,stab,
+ sp = do_sort(str,arg,
gimme,arglast);
goto array_return;
case O_REVERSE:
goto badsock;
#endif
STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */
+ if (optype == O_SYSREAD) {
+ anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
+ }
+ else
#ifdef HAS_SOCKET
if (stab_io(stab)->type == 's') {
argtype = sizeof buf;
}
else
#endif
- if (optype == O_SYSREAD) {
- anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
- }
- else
anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
if (anum < 0)
goto say_undef;
case O_REDO:
case O_NEXT:
case O_LAST:
+ tmps = Nullch;
if (maxarg > 0) {
tmps = str_get(arg[1].arg_ptr.arg_str);
dopop:
if (anum < 0)
goto say_undef;
if (!anum) {
+ /*SUPPRESS 560*/
if (tmpstab = stabent("$",allstabs))
str_numset(STAB_STR(tmpstab),(double)getpid());
- hclear(pidstatus); /* no kids, so don't wait for 'em */
+ hclear(pidstatus, FALSE); /* no kids, so don't wait for 'em */
}
value = (double)anum;
goto donumset;
tmps = str_get(stab_val(defstab));
else
tmps = str_get(st[1]);
- while (*tmps && isascii(*tmps) && (isspace(*tmps) || *tmps == '0'))
+ while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
tmps++;
if (*tmps == 'x')
value = (double)scanhex(++tmps, 99, &argtype);
goto donumset;
/* These common exits are hidden here in the middle of the switches for the
-/* benefit of those machines with limited branch addressing. Sigh. */
+ benefit of those machines with limited branch addressing. Sigh. */
array_return:
#ifdef DEBUGGING
deb("%s RETURNS ()\n",opname[optype]);
break;
case 1:
- deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
+ deb("%s RETURNS (\"%s\")\n",opname[optype],
+ st[1] ? str_get(st[1]) : "");
break;
default:
- tmps = str_get(st[1]);
+ tmps = st[1] ? str_get(st[1]) : "";
deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
- anum,tmps,anum==2?"":"...,",str_get(st[anum]));
+ anum,tmps,anum==2?"":"...,",
+ st[anum] ? str_get(st[anum]) : "");
break;
}
}
value = (double)(ary->ary_fill + 1);
goto donumset;
+ case O_TRY:
+ sp = do_try(arg[1].arg_ptr.arg_cmd,
+ gimme,arglast);
+ goto array_return;
+
+ case O_EVALONCE:
+ sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
+ gimme,arglast);
+ if (eval_root) {
+ str_free(arg[1].arg_ptr.arg_str);
+ arg[1].arg_ptr.arg_cmd = eval_root;
+ arg[1].arg_type = (A_CMD|A_DONT);
+ arg[0].arg_type = O_TRY;
+ }
+ goto array_return;
+
case O_REQUIRE:
case O_DOFILE:
case O_EVAL:
tainted |= tmpstr->str_tainted;
taintproper("Insecure dependency in eval");
#endif
- sp = do_eval(tmpstr, optype, curcmd->c_stash,
+ sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
gimme,arglast);
goto array_return;
stab = stabent(tmps = str_get(st[1]),FALSE);
if (stab && stab_io(stab) && stab_io(stab)->ifp)
anum = fileno(stab_io(stab)->ifp);
- else if (isdigit(*tmps))
+ else if (isDIGIT(*tmps))
anum = atoi(tmps);
else
goto say_undef;
--- /dev/null
+# exceptions.pl
+# tchrist@convex.com
+#
+# Here's a little code I use for exception handling. It's really just
+# glorfied eval/die. The way to use use it is when you might otherwise
+# exit, use &throw to raise an exception. The first enclosing &catch
+# handler looks at the exception and decides whether it can catch this kind
+# (catch takes a list of regexps to catch), and if so, it returns the one it
+# caught. If it *can't* catch it, then it will reraise the exception
+# for someone else to possibly see, or to die otherwise.
+#
+# I use oddly named variables in order to make darn sure I don't conflict
+# with my caller. I also hide in my own package, and eval the code in his.
+#
+# The EXCEPTION: prefix is so you can tell whether it's a user-raised
+# exception or a perl-raised one (eval error).
+#
+# --tom
+#
+# examples:
+# if (&catch('/$user_input/', 'regexp', 'syntax error') {
+# warn "oops try again";
+# redo;
+# }
+#
+# if ($error = &catch('&subroutine()')) { # catches anything
+#
+# &throw('bad input') if /^$/;
+
+sub catch {
+ package exception;
+ local($__code__, @__exceptions__) = @_;
+ local($__package__) = caller;
+ local($__exception__);
+
+ eval "package $__package__; $__code__";
+ if ($__exception__ = &'thrown) {
+ for (@__exceptions__) {
+ return $__exception__ if /$__exception__/;
+ }
+ &'throw($__exception__);
+ }
+}
+
+sub throw {
+ local($exception) = @_;
+ die "EXCEPTION: $exception\n";
+}
+
+sub thrown {
+ $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
+}
+
+1;
--- /dev/null
+# By John Bazik
+#
+# Usage: $cwd = &fastcwd;
+#
+# This is a faster version of getcwd. It's also more dangerous because
+# you might chdir out of a directory that you can't chdir back into.
+
+sub fastcwd {
+ local($odev, $oino, $cdev, $cino, $tdev, $tino);
+ local(@path, $path);
+ local(*DIR);
+
+ ($cdev, $cino) = stat('.');
+ for (;;) {
+ ($odev, $oino) = ($cdev, $cino);
+ chdir('..');
+ ($cdev, $cino) = stat('.');
+ last if $odev == $cdev && $oino == $cino;
+ opendir(DIR, '.');
+ for (;;) {
+ $_ = readdir(DIR);
+ next if $_ eq '.';
+ next if $_ eq '..';
+
+ last unless $_;
+ ($tdev, $tino) = lstat($_);
+ last unless $tdev != $odev || $tino != $oino;
+ }
+ closedir(DIR);
+ unshift(@path, $_);
+ }
+ chdir($path = '/' . join('/', @path));
+ $path;
+}
+1;
-#define PATCHLEVEL 13
+#define PATCHLEVEL 14
#!./perl
-# $Header: eval.t,v 4.0 91/03/20 01:52:20 lwall Locked $
+# $RCSfile: eval.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:43:19 $
-print "1..10\n";
+print "1..16\n";
eval 'print "ok 1\n";';
close try;
do 'Op.eval'; print $@;
+
+# Test the singlequoted eval optimizer
+
+$i = 11;
+for (1..3) {
+ eval 'print "ok ", $i++, "\n"';
+}
+
+eval {
+ print "ok 14\n";
+ die "ok 16\n";
+ 1;
+} || print "ok 15\n$@";
+
+
}
elsif ($_ eq 'group') {
$gname = shift;
- $out .= &tab . "\$gid == \$gid('$gname')";
+ $out .= &tab . "\$gid == \$gid{'$gname'}";
$initgroup++;
}
elsif ($_ eq 'nouser') {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
if (-f _) {
- open(IN, $_) || do {
+ open(IN, "./$_\0") || do {
warn "Couldn't open $name: $!\n";
return;
};
}
}
if (-f _) {
- open(IN, $_) || do {
+ open(IN, "./$_\0") || do {
warn "Couldn't open $name: $!\n";
return;
};
projects / p5sagit/p5-mst-13.2.git / commitdiff