perl 4.0 patch 14: patch #11, continued
authorLarry Wall <lwall@netlabs.com>
Tue, 5 Nov 1991 06:28:36 +0000 (06:28 +0000)
committerLarry Wall <lwall@netlabs.com>
Tue, 5 Nov 1991 06:28:36 +0000 (06:28 +0000)
See patch #11.

doio.c
dolist.c
eval.c
lib/exceptions.pl [new file with mode: 0644]
lib/fastcwd.pl [new file with mode: 0644]
patchlevel.h
t/op/eval.t
x2p/find2perl.SH

diff --git a/doio.c b/doio.c
index 2f1ea17..0c5a1c9 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $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
  *
@@ -6,6 +6,15 @@
  *    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
@@ -93,7 +102,7 @@ int len;
 
     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();
@@ -135,7 +144,8 @@ int len;
     }
     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");
@@ -158,9 +168,9 @@ int len;
        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);
@@ -183,7 +193,7 @@ int len;
            }
        }
        else {
-           while (isspace(*name))
+           while (isSPACE(*name))
                name++;
            if (strEQ(name,"-")) {
                fp = stdout;
@@ -198,7 +208,7 @@ int len;
        if (*name == '<') {
            mode[0] = 'r';
            name++;
-           while (isspace(*name))
+           while (isSPACE(*name))
                name++;
            if (*name == '&')
                goto duplicity;
@@ -215,15 +225,17 @@ int len;
            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 = '-';
@@ -243,9 +255,18 @@ int len;
        }
        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? */
@@ -254,7 +275,8 @@ int len;
            fflush(saveofp);            /* emulate fclose() */
            if (saveofp != saveifp) {   /* was a socket? */
                fclose(saveofp);
-               Safefree(saveofp);
+               if (fd > 2)
+                   Safefree(saveofp);
            }
        }
        if (fd != fileno(fp)) {
@@ -294,8 +316,10 @@ nextargv(stab)
 register STAB *stab;
 {
     register STR *str;
+#ifndef FLEXFILENAMES
     int filedev;
     int fileino;
+#endif
     int fileuid;
     int filegid;
     static int filemode = 0;
@@ -328,8 +352,10 @@ register STAB *stab;
                    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;
@@ -503,8 +529,10 @@ bool explicit;
 
     if (!stab)
        stab = argvstab;
-    if (!stab)
+    if (!stab) {
+       errno = EBADF;
        return FALSE;
+    }
     stio = stab_io(stab);
     if (!stio) {               /* never opened */
        if (dowarn && explicit)
@@ -601,6 +629,7 @@ STAB *stab;
 phooey:
     if (dowarn)
        warn("tell() on unopened file");
+    errno = EBADF;
     return -1L;
 }
 
@@ -627,6 +656,7 @@ int whence;
 nuts:
     if (dowarn)
        warn("seek() on unopened file");
+    errno = EBADF;
     return FALSE;
 }
 
@@ -641,11 +671,10 @@ STR *argstr;
     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)
@@ -847,7 +876,7 @@ off_t length;               /* length to set file to */
 }
 #endif /* F_FREESP */
 
-int
+int                                    /*SUPPRESS 590*/
 do_truncate(str,arg,gimme,arglast)
 STR *str;
 register ARG *arg;
@@ -864,7 +893,7 @@ int *arglast;
 #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;
     }
@@ -873,7 +902,7 @@ int *arglast;
 #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;
     }
@@ -913,13 +942,13 @@ STR *str;
        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;
@@ -927,7 +956,7 @@ STR *str;
        s++;
     else if (s == str->str_ptr)
        return FALSE;
-    while (isdigit(*s))
+    while (isDIGIT(*s))
        s++;
     if (s == send)
        return TRUE;
@@ -935,10 +964,10 @@ STR *str;
        s++;
        if (*s == '+' || *s == '-')
            s++;
-       while (isdigit(*s))
+       while (isDIGIT(*s))
            s++;
     }
-    while (isspace(*s))
+    while (isSPACE(*s))
        s++;
     if (s >= send)
        return TRUE;
@@ -955,6 +984,7 @@ FILE *fp;
     if (!fp) {
        if (dowarn)
            warn("print to unopened file");
+       errno = EBADF;
        return FALSE;
     }
     if (!str)
@@ -995,6 +1025,7 @@ int *arglast;
     if (!fp) {
        if (dowarn)
            warn("print to unopened file");
+       errno = EBADF;
        return FALSE;
     }
     st += ++sp;
@@ -1028,12 +1059,12 @@ STR *str;
 {
     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 {
@@ -1050,6 +1081,7 @@ STR *str;
     else {
        statstab = Nullstab;
        str_set(statname,str_get(str));
+       laststype = O_STAT;
        return (laststatval = stat(str_get(str),&statcache));
     }
 }
@@ -1107,6 +1139,8 @@ STR *str;
        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)
@@ -1117,13 +1151,14 @@ STR *str;
            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;
        }
     }
@@ -1137,8 +1172,11 @@ STR *str;
        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;
     }
 
@@ -1253,11 +1291,12 @@ char *cmd;
 
     /* 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;
@@ -1271,10 +1310,10 @@ char *cmd;
     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';
     }
@@ -1301,8 +1340,10 @@ int *arglast;
     register STIO *stio;
     int domain, type, protocol, fd;
 
-    if (!stab)
+    if (!stab) {
+       errno = EBADF;
        return FALSE;
+    }
 
     stio = stab_io(stab);
     if (!stio)
@@ -1358,6 +1399,7 @@ int *arglast;
 nuts:
     if (dowarn)
        warn("bind() on closed fd");
+    errno = EBADF;
     return FALSE;
 
 }
@@ -1388,6 +1430,7 @@ int *arglast;
 nuts:
     if (dowarn)
        warn("connect() on closed fd");
+    errno = EBADF;
     return FALSE;
 
 }
@@ -1415,6 +1458,7 @@ int *arglast;
 nuts:
     if (dowarn)
        warn("listen() on closed fd");
+    errno = EBADF;
     return FALSE;
 }
 
@@ -1463,6 +1507,7 @@ STAB *gstab;
 nuts:
     if (dowarn)
        warn("accept() on closed fd");
+    errno = EBADF;
 badexit:
     str_sset(str,&str_undef);
     return;
@@ -1491,6 +1536,7 @@ int *arglast;
 nuts:
     if (dowarn)
        warn("shutdown() on closed fd");
+    errno = EBADF;
     return FALSE;
 
 }
@@ -1520,7 +1566,7 @@ int *arglast;
     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)
@@ -1540,6 +1586,7 @@ nuts:
     if (dowarn)
        warn("[gs]etsockopt() on closed fd");
     st[sp] = &str_undef;
+    errno = EBADF;
     return sp;
 
 }
@@ -1562,7 +1609,7 @@ int *arglast;
     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);
@@ -1582,6 +1629,7 @@ int *arglast;
 nuts:
     if (dowarn)
        warn("get{sock,peer}name() on closed fd");
+    errno = EBADF;
 nuts2:
     st[sp] = &str_undef;
     return sp;
@@ -2208,6 +2256,7 @@ int *arglast;
     case O_READDIR:
        if (gimme == G_ARRAY) {
            --sp;
+           /*SUPPRESS 560*/
            while (dp = readdir(stio->dirp)) {
 #ifdef DIRNAMLEN
                (void)astore(ary,++sp,
@@ -2258,6 +2307,8 @@ int *arglast;
 
 nope:
     st[sp] = &str_undef;
+    if (!errno)
+       errno = EBADF;
     return sp;
 
 #else
@@ -2323,7 +2374,7 @@ int *arglast;
        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)))
index 7527874..345c5ac 100644 (file)
--- a/dolist.c
+++ b/dolist.c
@@ -1,4 +1,4 @@
-/* $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
  *
@@ -6,6 +6,17 @@
  *    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
  * 
@@ -94,10 +105,10 @@ int *arglast;
        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;
@@ -145,7 +156,7 @@ int *arglast;
        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");
@@ -192,8 +203,10 @@ int *arglast;
                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)) {
@@ -233,6 +246,7 @@ int *arglast;
 
        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)
@@ -256,6 +270,8 @@ yup:
     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;
@@ -363,14 +379,15 @@ int *arglast;
        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);
@@ -378,11 +395,13 @@ int *arglast;
            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)
@@ -401,17 +420,17 @@ int *arglast;
            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;
@@ -548,9 +567,15 @@ int *arglast;
     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;
@@ -559,10 +584,11 @@ int *arglast;
     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
@@ -578,9 +604,9 @@ int *arglast;
            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
@@ -624,7 +650,7 @@ int *arglast;
            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;
@@ -644,7 +670,7 @@ int *arglast;
            if (datumtype == 'b') {
                aint = len;
                for (len = 0; len < aint; len++) {
-                   if (len & 7)
+                   if (len & 7)                /*SUPPRESS 595*/
                        bits >>= 1;
                    else
                        bits = *s++;
@@ -912,6 +938,34 @@ int *arglast;
                (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':
@@ -1158,11 +1212,11 @@ int *arglast;
                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;
@@ -1335,8 +1389,10 @@ int *arglast;
     }
     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);
@@ -1407,9 +1463,9 @@ static STAB *firststab = Nullstab;
 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;
 {
@@ -1423,6 +1479,7 @@ int *arglast;
     STR *oldfirst;
     STR *oldsecond;
     ARRAY *oldstack;
+    HASH *stash;
     static ARRAY *sortstack = Null(ARRAY*);
 
     if (gimme != G_ARRAY) {
@@ -1434,6 +1491,7 @@ int *arglast;
     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);
@@ -1446,11 +1504,31 @@ int *arglast;
     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);
@@ -1460,10 +1538,10 @@ int *arglast;
            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);
@@ -1505,11 +1583,13 @@ STR **strp2;
     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)
@@ -1537,6 +1617,8 @@ int *arglast;
       (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++);
@@ -1567,7 +1649,6 @@ int *arglast;
     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;
 
@@ -1639,7 +1720,6 @@ int *arglast;
       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)));
@@ -1750,6 +1830,7 @@ int *arglast;
        return sp;
     }
     (void)hiterinit(hash);
+    /*SUPPRESS 560*/
     while (entry = hiternext(hash)) {
        if (dokeys) {
            tmps = hiterkey(entry,&i);
diff --git a/eval.c b/eval.c
index 1b3c514..c8782e2 100644 (file)
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $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
  *
@@ -6,6 +6,16 @@
  *    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
@@ -326,6 +336,7 @@ register int sp;
            if (fp) {
                if (gimme == G_SCALAR) {
                    while (str_gets(str,fp,str->str_cur) != Nullch)
+                       /*SUPPRESS 530*/
                        ;
                }
                else {
@@ -490,7 +501,7 @@ register int sp;
                    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)
@@ -694,7 +705,7 @@ register int sp;
     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;
@@ -884,7 +895,11 @@ register int sp;
        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) {
@@ -1179,6 +1194,7 @@ register int sp;
     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)
@@ -1204,6 +1220,7 @@ register int sp;
        }
        break;
     case O_PACK:
+       /*SUPPRESS 701*/
        (void)do_pack(str,arglast);
        break;
     case O_GREP:
@@ -1253,11 +1270,7 @@ register int sp;
        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:
@@ -1451,6 +1464,10 @@ register int sp;
            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;
@@ -1459,10 +1476,6 @@ register int sp;
        }
        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;
@@ -1541,6 +1554,7 @@ register int sp;
     case O_REDO:
     case O_NEXT:
     case O_LAST:
+       tmps = Nullch;
        if (maxarg > 0) {
            tmps = str_get(arg[1].arg_ptr.arg_str);
          dopop:
@@ -1887,9 +1901,10 @@ register int sp;
        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;
@@ -2005,7 +2020,7 @@ register int sp;
            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);
@@ -2014,7 +2029,7 @@ register int sp;
        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
@@ -2027,12 +2042,14 @@ array_return:
                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;
            }
        }
@@ -2410,6 +2427,22 @@ donumset:
        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:
@@ -2422,7 +2455,7 @@ donumset:
        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;
 
@@ -2598,7 +2631,7 @@ donumset:
            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;
diff --git a/lib/exceptions.pl b/lib/exceptions.pl
new file mode 100644 (file)
index 0000000..02c4498
--- /dev/null
@@ -0,0 +1,54 @@
+# 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;
diff --git a/lib/fastcwd.pl b/lib/fastcwd.pl
new file mode 100644 (file)
index 0000000..6b452e8
--- /dev/null
@@ -0,0 +1,35 @@
+# 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;
index 910cae8..f95be0e 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 13
+#define PATCHLEVEL 14
index 464162c..7bca608 100644 (file)
@@ -1,8 +1,8 @@
 #!./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";';
 
@@ -40,3 +40,18 @@ print try 'print "ok 10\n"; unlink "Op.eval";',"\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$@";
+
+
index 9161f7b..032db6b 100644 (file)
@@ -96,7 +96,7 @@ while (@ARGV) {
     }
     elsif ($_ eq 'group') {
        $gname = shift;
-       $out .= &tab . "\$gid == \$gid('$gname')";
+       $out .= &tab . "\$gid == \$gid{'$gname'}";
        $initgroup++;
     }
     elsif ($_ eq 'nouser') {
@@ -381,7 +381,7 @@ sub cpio {
        ($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;
            };
@@ -471,7 +471,7 @@ sub tar {
        }
     }
     if (-f _) {
-       open(IN, $_) || do {
+       open(IN, "./$_\0") || do {
            warn "Couldn't open $name: $!\n";
            return;
        };