This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 3.0 patch #3 Patch #2 continued
authorLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Fri, 10 Nov 1989 16:20:25 +0000 (16:20 +0000)
committerLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Fri, 10 Nov 1989 16:20:25 +0000 (16:20 +0000)
20 files changed:
cmd.c
config.h.SH
consarg.c
doarg.c
doio.c
dolist.c
eval.c
evalargs.xc
hash.c
lib/getopts.pl
makedepend.SH
malloc.c
patchlevel.h
t/TEST
t/io.argv
t/op.magic
t/op.mkdir
t/op.split
t/op.stat
x2p/a2p.h

diff --git a/cmd.c b/cmd.c
index 2864650..7fc7427 100644 (file)
--- a/cmd.c
+++ b/cmd.c
@@ -1,4 +1,4 @@
-/* $Header: cmd.c,v 3.0.1.1 89/10/26 23:04:21 lwall Locked $
+/* $Header: cmd.c,v 3.0.1.2 89/11/11 04:08:56 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       cmd.c,v $
+ * Revision 3.0.1.2  89/11/11  04:08:56  lwall
+ * patch2: non-BSD machines required two ^D's for <>
+ * patch2: grow_dlevel() not inside #ifdef DEBUGGING
+ * 
  * Revision 3.0.1.1  89/10/26  23:04:21  lwall
  * patch1: heuristically disabled optimization could cause core dump
  * 
@@ -475,6 +479,7 @@ until_loop:
            fp = stab_io(last_in_stab)->ifp;
            retstr = stab_val(defstab);
            newsp = -2;
+         keepgoing:
            if (fp && str_gets(retstr, fp, 0)) {
                if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
                    match = FALSE;
@@ -482,8 +487,17 @@ until_loop:
                    match = TRUE;
                stab_io(last_in_stab)->lines++;
            }
-           else if (stab_io(last_in_stab)->flags & IOF_ARGV)
-               goto doeval;    /* doesn't necessarily count as EOF yet */
+           else if (stab_io(last_in_stab)->flags & IOF_ARGV) {
+               if (!fp)
+                   goto doeval;        /* first time through */
+               fp = nextargv(last_in_stab);
+               if (fp)
+                   goto keepgoing;
+               (void)do_close(last_in_stab,FALSE);
+               stab_io(last_in_stab)->flags |= IOF_START;
+               retstr = &str_undef;
+               match = FALSE;
+           }
            else {
                retstr = &str_undef;
                match = FALSE;
@@ -1060,6 +1074,7 @@ int base;
     }
 }
 
+#ifdef DEBUGGING
 void
 grow_dlevel()
 {
@@ -1067,3 +1082,4 @@ grow_dlevel()
     Renew(debname, dlmax, char);
     Renew(debdelim, dlmax, char);
 }
+#endif
index 7d069a2..c3c8630 100644 (file)
@@ -91,6 +91,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
  */
 #$d_crypt      CRYPT           /**/
 
+/* CSH:
+ *     This symbol, if defined, indicates that the C-shell exists.
+ *     If defined, contains the full pathname of csh.
+ */
+#$d_csh CSH "$csh"             /**/
+
 /* DOSUID:
  *     This symbol, if defined, indicates that the C program should
  *     check the script that it is executing for setuid/setgid bits, and
@@ -376,8 +382,13 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
 /* I_SYSTIME:
  *     This symbol is defined if this system has the file <sys/time.h>.
  */
+/* I_TIMETOO:
+ *     This symbol is defined if <sys/time.h> exists but doesn't include
+ *     <time.h>.
+ */
 #$d_tminsys    TMINSYS         /**/
 #$i_systime    I_SYSTIME       /**/
+#$i_timetoo    I_TIMETOO       /**/
 
 /* VARARGS:
  *     This symbol, if defined, indicates to the C program that it should
@@ -412,6 +423,11 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
 #$d_vprintf    VPRINTF         /**/
 #$d_charvspr   CHARVSPRINTF    /**/
 
+/* WAIT4:
+ *     This symbol, if defined, indicates that wait4() exists.
+ */
+#$d_wait4      WAIT4   /**/
+
 /* GIDTYPE:
  *     This symbol has a value like gid_t, int, ushort, or whatever type is
  *     used to declare group ids in the kernel.
@@ -475,9 +491,9 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
 #$i_pwd        I_PWD           /**/
 #$d_pwquota    PWQUOTA         /**/
 #$d_pwage      PWAGE           /**/
-#$d_pwage      PWCHANGE        /**/
-#$d_pwage      PWCLASS         /**/
-#$d_pwage      PWEXPIRE        /**/
+#$d_pwchange   PWCHANGE        /**/
+#$d_pwclass    PWCLASS         /**/
+#$d_pwexpire   PWEXPIRE        /**/
 
 /* I_SYSDIR:
  *     This symbol, if defined, indicates to the C program that it should
index 5a2c84f..b24322e 100644 (file)
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $Header: consarg.c,v 3.0 89/10/18 15:10:30 lwall Locked $
+/* $Header: consarg.c,v 3.0.1.1 89/11/11 04:14:30 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       consarg.c,v $
+ * Revision 3.0.1.1  89/11/11  04:14:30  lwall
+ * patch2: '-' x 26 made warnings about undefined value
+ * patch2: eval with no args caused strangeness
+ * patch2: local(@foo) didn't work, but local(@foo,$bar) did
+ * 
  * Revision 3.0  89/10/18  15:10:30  lwall
  * 3.0 baseline
  * 
@@ -304,6 +309,7 @@ register ARG *arg;
            break;
        case O_REPEAT:
            i = (int)str_gnum(s2);
+           str_nset(str,"",0);
            while (i-- > 0)
                str_scat(str,s1);
            break;
@@ -652,6 +658,8 @@ register ARG *arg;
                    arg[2].arg_flags |= AF_ARYOK;
                }
            }
+           else if (arg->arg_type == O_ASSIGN)
+               arg[1].arg_flags |= AF_ARYOK;
        }
        else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
            arg1->arg_type = O_LHELEM;
@@ -667,6 +675,8 @@ register ARG *arg;
                    arg[2].arg_flags |= AF_ARYOK;
                }
            }
+           else if (arg->arg_type == O_ASSIGN)
+               arg[1].arg_flags |= AF_ARYOK;
        }
        else if (arg1->arg_type == O_ASLICE) {
            arg1->arg_type = O_LASLICE;
@@ -900,6 +910,8 @@ fixeval(arg)
 ARG *arg;
 {
     Renew(arg, 3, ARG);
+    if (arg->arg_len == 0)
+       arg[1].arg_type = A_NULL;
     arg->arg_len = 2;
     arg[2].arg_ptr.arg_hash = curstash;
     arg[2].arg_type = A_NULL;
diff --git a/doarg.c b/doarg.c
index 7ff4d4d..6a45dd6 100644 (file)
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $Header: doarg.c,v 3.0 89/10/18 15:10:41 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.1 89/11/11 04:17:20 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       doarg.c,v $
+ * Revision 3.0.1.1  89/11/11  04:17:20  lwall
+ * patch2: printf %c, %D, %X and %O didn't work right
+ * patch2: printf of unsigned vs signed needed separate casts on some machines
+ * 
  * Revision 3.0  89/10/18  15:10:41  lwall
  * 3.0 baseline
  * 
@@ -505,16 +509,25 @@ register STR **sarg;
            case 'l':
                dolong = TRUE;
                break;
-           case 'D': case 'X': case 'O':
-               dolong = TRUE;
-               /* FALL THROUGH */
            case 'c':
-               *buf = (int)str_gnum(*(sarg++));
-               str_ncat(str,buf,1);    /* force even if null */
-               *buf = '\0';
-               s = t+1;
+               ch = *(++t);
+               *t = '\0';
+               xlen = (int)str_gnum(*(sarg++));
+               if (strEQ(t-2,"%c")) {  /* some printfs fail on null chars */
+                   *buf = xlen;
+                   str_ncat(str,s,t - s - 2);
+                   str_ncat(str,buf,1);  /* so handle simple case */
+                   *buf = '\0';
+               }
+               else
+                   (void)sprintf(buf,s,xlen);
+               s = t;
+               *(t--) = ch;
                break;
-           case 'd': case 'x': case 'o': case 'u':
+           case 'D':
+               dolong = TRUE;
+               /* FALL THROUGH */
+           case 'd':
                ch = *(++t);
                *t = '\0';
                if (dolong)
@@ -524,6 +537,19 @@ register STR **sarg;
                s = t;
                *(t--) = ch;
                break;
+           case 'X': case 'O':
+               dolong = TRUE;
+               /* FALL THROUGH */
+           case 'x': case 'o': case 'u':
+               ch = *(++t);
+               *t = '\0';
+               if (dolong)
+                   (void)sprintf(buf,s,(unsigned long)str_gnum(*(sarg++)));
+               else
+                   (void)sprintf(buf,s,(unsigned int)str_gnum(*(sarg++)));
+               s = t;
+               *(t--) = ch;
+               break;
            case 'E': case 'e': case 'f': case 'G': case 'g':
                ch = *(++t);
                *t = '\0';
diff --git a/doio.c b/doio.c
index a50d18f..a2960ad 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $Header: doio.c,v 3.0.1.1 89/10/26 23:10:05 lwall Locked $
+/* $Header: doio.c,v 3.0.1.2 89/11/11 04:25:51 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,16 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       doio.c,v $
+ * Revision 3.0.1.2  89/11/11  04:25:51  lwall
+ * patch2: orthogonalized the file modes some so we can have <& +<& etc.
+ * patch2: do_open() now detects sockets passed to process from parent
+ * patch2: fd's above 2 are now closed on exec
+ * patch2: csh code can now use csh from other than /bin
+ * patch2: getsockopt, get{sock,peer}name didn't define result properly
+ * patch2: warn("shutdown") was replicated
+ * patch2: gethostbyname was misdeclared
+ * patch2: telldir() is sometimes a macro
+ * 
  * Revision 3.0.1.1  89/10/26  23:10:05  lwall
  * patch1: Configure now checks for BSD shadow passwords
  * 
@@ -89,61 +99,65 @@ register char *name;
        fp = mypopen(name,"w");
        writing = 1;
     }
-    else if (*name == '>' && name[1] == '>') {
-#ifdef TAINT
-       taintproper("Insecure dependency in open");
-#endif
-       mode[0] = stio->type = 'a';
-       for (name += 2; isspace(*name); name++) ;
-       fp = fopen(name, mode);
-       writing = 1;
-    }
-    else if (*name == '>' && name[1] == '&') {
-#ifdef TAINT
-       taintproper("Insecure dependency in open");
-#endif
-       for (name += 2; isspace(*name); name++) ;
-       if (isdigit(*name))
-           fd = atoi(name);
-       else {
-           stab = stabent(name,FALSE);
-           if (stab_io(stab) && stab_io(stab)->ifp) {
-               fd = fileno(stab_io(stab)->ifp);
-               stio->type = stab_io(stab)->type;
-           }
-           else
-               fd = -1;
-       }
-       fp = fdopen(dup(fd),stio->type == 'a' ? "a" :
-         (stio->type == '<' ? "r" : "w") );
-       writing = 1;
-    }
     else if (*name == '>') {
 #ifdef TAINT
        taintproper("Insecure dependency in open");
 #endif
-       for (name++; isspace(*name); name++) ;
-       if (strEQ(name,"-")) {
-           fp = stdout;
-           stio->type = '-';
+       name++;
+       if (*name == '>') {
+           mode[0] = stio->type = 'a';
+           name++;
        }
-       else  {
+       else
            mode[0] = 'w';
-           fp = fopen(name,mode);
-       }
        writing = 1;
+       if (*name == '&') {
+         duplicity:
+           name++;
+           while (isspace(*name))
+               name++;
+           if (isdigit(*name))
+               fd = atoi(name);
+           else {
+               stab = stabent(name,FALSE);
+               if (!stab || !stab_io(stab))
+                   return FALSE;
+               if (stab_io(stab) && stab_io(stab)->ifp) {
+                   fd = fileno(stab_io(stab)->ifp);
+                   if (stab_io(stab)->type == 's')
+                       stio->type = 's';
+               }
+               else
+                   fd = -1;
+           }
+           fp = fdopen(dup(fd),mode);
+       }
+       else {
+           while (isspace(*name))
+               name++;
+           if (strEQ(name,"-")) {
+               fp = stdout;
+               stio->type = '-';
+           }
+           else  {
+               fp = fopen(name,mode);
+           }
+       }
     }
     else {
        if (*name == '<') {
-           for (name++; isspace(*name); name++) ;
+           mode[0] = 'r';
+           name++;
+           while (isspace(*name))
+               name++;
+           if (*name == '&')
+               goto duplicity;
            if (strEQ(name,"-")) {
                fp = stdin;
                stio->type = '-';
            }
-           else  {
-               mode[0] = 'r';
+           else
                fp = fopen(name,mode);
-           }
        }
        else if (name[len-1] == '|') {
 #ifdef TAINT
@@ -177,21 +191,39 @@ register char *name;
            (void)fclose(fp);
            return FALSE;
        }
-       if ((statbuf.st_mode & S_IFMT) != S_IFREG &&
+       result = (statbuf.st_mode & S_IFMT);
+       if (result != S_IFREG &&
 #ifdef S_IFSOCK
-           (statbuf.st_mode & S_IFMT) != S_IFSOCK &&
+           result != S_IFSOCK &&
 #endif
 #ifdef S_IFFIFO
-           (statbuf.st_mode & S_IFMT) != S_IFFIFO &&
+           result != S_IFFIFO &&
+#endif
+#ifdef S_IFIFO
+           result != S_IFIFO &&
 #endif
-           (statbuf.st_mode & S_IFMT) != S_IFCHR) {
+           result != 0 &&              /* socket? */
+           result != S_IFCHR) {
            (void)fclose(fp);
            return FALSE;
        }
+#ifdef S_IFSOCK
+       if (result == S_IFSOCK || result == 0)
+           stio->type = 's';   /* in case a socket was passed in to us */
+#endif
     }
+#if defined(FCNTL) && defined(F_SETFD)
+    fd = fileno(fp);
+    if (fd >= 3)
+       fcntl(fd,F_SETFD,1);
+#endif
     stio->ifp = fp;
-    if (writing)
-       stio->ofp = fp;
+    if (writing) {
+       if (stio->type != 's')
+           stio->ofp = fp;
+       else
+           stio->ofp = fdopen(fileno(fp),"w");
+    }
     return TRUE;
 }
 
@@ -823,9 +855,10 @@ char *cmd;
 
     /* save an extra exec if possible */
 
-    if (csh > 0 && strnEQ(cmd,"/bin/csh -c",11)) {
+#ifdef CSH
+    if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
        strcpy(flags,"-c");
-       s = cmd+11;
+       s = cmd+cshlen+3;
        if (*s == 'f') {
            s++;
            strcat(flags,"f");
@@ -841,12 +874,13 @@ char *cmd;
                *--s = '\0';
            if (s[-1] == '\'') {
                *--s = '\0';
-               execl("/bin/csh","csh", flags,ncmd,(char*)0);
+               execl(cshname,"csh", flags,ncmd,(char*)0);
                *s = '\'';
                return FALSE;
            }
        }
     }
+#endif /* CSH */
 
     /* see if there are shell metacharacters in it */
 
@@ -1102,6 +1136,7 @@ int *arglast;
     case O_GSOCKOPT:
        st[sp] = str_2static(str_new(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)
            goto nuts;
        break;
@@ -1117,7 +1152,7 @@ int *arglast;
 
 nuts:
     if (dowarn)
-       warn("shutdown() on closed fd");
+       warn("[gs]etsockopt() on closed fd");
     st[sp] = &str_undef;
     return sp;
 
@@ -1143,6 +1178,7 @@ int *arglast;
 
     st[sp] = str_2static(str_new(257));
     st[sp]->str_cur = 256;
+    st[sp]->str_pok = 1;
     fd = fileno(stio->ifp);
     switch (optype) {
     case O_GETSOCKNAME:
@@ -1159,7 +1195,7 @@ int *arglast;
 
 nuts:
     if (dowarn)
-       warn("shutdown() on closed fd");
+       warn("get{sock,peer}name() on closed fd");
     st[sp] = &str_undef;
     return sp;
 
@@ -1175,7 +1211,7 @@ int *arglast;
     register int sp = arglast[0];
     register char **elem;
     register STR *str;
-    struct hostent *gethostbynam();
+    struct hostent *gethostbyname();
     struct hostent *gethostbyaddr();
 #ifdef GETHOSTENT
     struct hostent *gethostent();
@@ -1687,7 +1723,9 @@ int *arglast;
     register int sp = arglast[1];
     register STIO *stio;
     long along;
+#ifndef telldir
     long telldir();
+#endif
     struct DIRENT *readdir();
     register struct DIRENT *dp;
 
index 0c3b6a6..05e61a3 100644 (file)
--- a/dolist.c
+++ b/dolist.c
@@ -1,4 +1,4 @@
-/* $Header: dolist.c,v 3.0.1.1 89/10/26 23:11:51 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.2 89/11/11 04:28:17 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       dolist.c,v $
+ * Revision 3.0.1.2  89/11/11  04:28:17  lwall
+ * patch2: non-existent slice values are now undefined rather than null
+ * 
  * Revision 3.0.1.1  89/10/26  23:11:51  lwall
  * patch1: split in a subroutine wrongly freed referenced arguments
  * patch1: reverse didn't work
@@ -668,7 +671,7 @@ int *arglast;
                        lval);
                }
                else
-                   st[sp-1] = Nullstr;
+                   st[sp-1] = &str_undef;
            }
        }
        else {
@@ -681,7 +684,7 @@ int *arglast;
                        str_magic(st[sp-1],stab,magic,tmps,len);
                }
                else
-                   st[sp-1] = Nullstr;
+                   st[sp-1] = &str_undef;
            }
        }
        sp--;
@@ -691,7 +694,7 @@ int *arglast;
            if (st[max])
                st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval);
            else
-               st[sp] = Nullstr;
+               st[sp] = &str_undef;
        }
        else {
            if (st[max]) {
@@ -702,7 +705,7 @@ int *arglast;
                    str_magic(st[sp],stab,magic,tmps,len);
            }
            else
-               st[sp] = Nullstr;
+               st[sp] = &str_undef;
        }
     }
     return sp;
diff --git a/eval.c b/eval.c
index 32da854..5fa73be 100644 (file)
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $Header: eval.c,v 3.0 89/10/18 15:17:04 lwall Locked $
+/* $Header: eval.c,v 3.0.1.1 89/11/11 04:31:51 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       eval.c,v $
+ * Revision 3.0.1.1  89/11/11  04:31:51  lwall
+ * patch2: mkdir and rmdir needed to quote argument when passed to shell
+ * patch2: mkdir and rmdir now return better error codes
+ * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
+ * 
  * Revision 3.0  89/10/18  15:17:04  lwall
  * 3.0 baseline
  * 
@@ -169,7 +174,6 @@ register int sp;
        if (arg[1].arg_flags & AF_ARYOK) {
            if (arg->arg_len == 1) {
                arg->arg_type = O_LOCAL;
-               arg->arg_flags |= AF_LOCAL;
                goto local;
            }
            else {
@@ -1449,29 +1453,59 @@ register int sp;
 #endif
 #ifdef MKDIR
        value = (double)(mkdir(tmps,anum) >= 0);
+       goto donumset;
 #else
-       (void)sprintf(buf,"mkdir %s 2>&1",tmps);
+       (void)strcpy(buf,"mkdir ");
+#endif
+#if !defined(MKDIR) || !defined(RMDIR)
       one_liner:
+       for (tmps2 = buf+6; *tmps; ) {
+           *tmps2++ = '\\';
+           *tmps2++ = *tmps++;
+       }
+       (void)strcpy(tmps2," 2>&1");
        rsfp = mypopen(buf,"r");
        if (rsfp) {
            *buf = '\0';
            tmps2 = fgets(buf,sizeof buf,rsfp);
            (void)mypclose(rsfp);
            if (tmps2 != Nullch) {
-               for (errno = 1; errno <= sys_nerr; errno++) {
+               for (errno = 1; errno < sys_nerr; errno++) {
                    if (instr(buf,sys_errlist[errno]))  /* you don't see this */
                        goto say_zero;
                }
                errno = 0;
+#ifndef EACCES
+#define EACCES EPERM
+#endif
+               if (instr(buf,"cannot make"))
+                   errno = EEXIST;
+               else if (instr(buf,"non-exist"))
+                   errno = ENOENT;
+               else if (instr(buf,"not empty"))
+                   errno = EBUSY;
+               else if (instr(buf,"cannot access"))
+                   errno = EACCES;
+               else
+                   errno = EPERM;
                goto say_zero;
            }
-           else
-               value = 1.0;
+           else {      /* some mkdirs return no failure indication */
+               tmps = str_get(st[1]);
+               anum = (stat(tmps,&statbuf) >= 0);
+               if (optype == O_RMDIR)
+                   anum = !anum;
+               if (anum)
+                   errno = 0;
+               else
+                   errno = EACCES;     /* a guess */
+               value = (double)anum;
+           }
+           goto donumset;
        }
        else
            goto say_zero;
 #endif
-       goto donumset;
     case O_RMDIR:
        if (maxarg < 1)
            tmps = str_get(stab_val(defstab));
@@ -1484,7 +1518,7 @@ register int sp;
        value = (double)(rmdir(tmps) >= 0);
        goto donumset;
 #else
-       (void)sprintf(buf,"rmdir %s 2>&1",tmps);
+       (void)strcpy(buf,"rmdir ");
        goto one_liner;         /* see above in MKDIR */
 #endif
     case O_GETPPID:
@@ -1968,6 +2002,8 @@ register int sp;
        fatal("Unsupported socket function");
 #endif /* SOCKET */
     case O_FILENO:
+       if (maxarg < 1)
+           goto say_undef;
        if ((arg[1].arg_type & A_MASK) == A_WORD)
            stab = arg[1].arg_ptr.arg_stab;
        else
@@ -2014,6 +2050,8 @@ register int sp;
     case O_SEEKDIR:
     case O_REWINDDIR:
     case O_CLOSEDIR:
+       if (maxarg < 1)
+           goto say_undef;
        if ((arg[1].arg_type & A_MASK) == A_WORD)
            stab = arg[1].arg_ptr.arg_stab;
        else
index d2b7c64..54b7b7b 100644 (file)
@@ -2,9 +2,12 @@
  * kit sizes from getting too big.
  */
 
-/* $Header: evalargs.xc,v 3.0.1.1 89/10/26 23:12:55 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.2 89/11/11 04:33:05 lwall Locked $
  *
  * $Log:       evalargs.xc,v $
+ * Revision 3.0.1.2  89/11/11  04:33:05  lwall
+ * patch2: Configure now locates csh
+ * 
  * Revision 3.0.1.1  89/10/26  23:12:55  lwall
  * patch1: glob didn't free a temporary string
  * 
            argflags |= AF_POST;        /* enable newline chopping */
            last_in_stab = argptr.arg_stab;
            old_record_separator = record_separator;
-           if (csh > 0)
-               record_separator = 0;
-           else
-               record_separator = '\n';
+#ifdef CSH
+           record_separator = 0;
+#else
+           record_separator = '\n';
+#endif
            goto do_read;
        case A_READ:
            last_in_stab = argptr.arg_stab;
                            }
                        }
                        fp = nextargv(last_in_stab);
-                       if (!fp)  /* Note: fp != stab_io(last_in_stab)->ifp */
+                       if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
                            (void)do_close(last_in_stab,FALSE); /* now it does*/
+                           stab_io(last_in_stab)->flags |= IOF_START;
+                       }
                    }
                    else if (argtype == A_GLOB) {
                        (void) interp(str,stab_val(last_in_stab),sp);
                        st = stack->ary_array;
                        tmpstr = Str_new(55,0);
-                       if (csh > 0) {
-                           str_set(tmpstr,"/bin/csh -cf 'set nonomatch; glob ");
-                           str_scat(tmpstr,str);
-                           str_cat(tmpstr,"'|");
-                       }
-                       else {
-                           str_set(tmpstr, "echo ");
-                           str_scat(tmpstr,str);
-                           str_cat(tmpstr,
-                             "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
-                       }
+#ifdef CSH
+                       str_nset(tmpstr,cshname,cshlen);
+                       str_cat(tmpstr," -cf 'set nonomatch; glob ");
+                       str_scat(tmpstr,str);
+                       str_cat(tmpstr,"'|");
+#else
+                       str_set(tmpstr, "echo ");
+                       str_scat(tmpstr,str);
+                       str_cat(tmpstr,
+                         "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
+#endif
                        (void)do_open(last_in_stab,tmpstr->str_ptr);
                        fp = stab_io(last_in_stab)->ifp;
                        str_free(tmpstr);
diff --git a/hash.c b/hash.c
index 6031fa8..fb8e36f 100644 (file)
--- a/hash.c
+++ b/hash.c
@@ -1,4 +1,4 @@
-/* $Header: hash.c,v 3.0 89/10/18 15:18:32 lwall Locked $
+/* $Header: hash.c,v 3.0.1.1 89/11/11 04:34:18 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       hash.c,v $
+ * Revision 3.0.1.1  89/11/11  04:34:18  lwall
+ * patch2: CX/UX needed to set the key each time in associative iterators
+ * 
  * Revision 3.0  89/10/18  15:18:32  lwall
  * 3.0 baseline
  * 
@@ -377,6 +380,8 @@ register HASH *tb;
        if (entry) {
 #ifdef NDBM
 #ifdef _CX_UX
+           key.dptr = entry->hent_key;
+           key.dsize = entry->hent_klen;
            key = dbm_nextkey(tb->tbl_dbm, key);
 #else
            key = dbm_nextkey(tb->tbl_dbm);
index 9269885..7effafa 100644 (file)
@@ -14,16 +14,16 @@ sub Getopts {
        $pos = index($argumentative,$first);
        if($pos >= $[) {
            if($args[$pos+1] eq ':') {
-               shift;
+               shift(@ARGV);
                if($rest eq '') {
-                   $rest = shift;
+                   $rest = shift(@ARGV);
                }
                eval "\$opt_$first = \$rest;";
            }
            else {
                eval "\$opt_$first = 1";
                if($rest eq '') {
-                   shift;
+                   shift(@ARGV);
                }
                else {
                    $ARGV[0] = "-$rest";
@@ -36,7 +36,7 @@ sub Getopts {
                $ARGV[0] = "-$rest";
            }
            else {
-               shift;
+               shift(@ARGV);
            }
        }
     }
index 5cb95c5..000bf71 100644 (file)
@@ -15,9 +15,12 @@ esac
 echo "Extracting makedepend (with variable substitutions)"
 $spitshell >makedepend <<!GROK!THIS!
 $startsh
-# $Header: makedepend.SH,v 3.0 89/10/18 15:20:19 lwall Locked $
+# $Header: makedepend.SH,v 3.0.1.1 89/11/11 04:35:32 lwall Locked $
 #
 # $Log:        makedepend.SH,v $
+# Revision 3.0.1.1  89/11/11  04:35:32  lwall
+# patch2: makedepend now uses cppflags determined by Configure
+# 
 # Revision 3.0  89/10/18  15:20:19  lwall
 # 3.0 baseline
 # 
@@ -25,7 +28,7 @@ $startsh
 export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
 
 cat='$cat'
-ccflags='$ccflags $sockethdr'
+cppflags='$cppflags'
 cp='$cp'
 cpp='$cppstdin'
 echo='$echo'
@@ -42,19 +45,6 @@ uniq='$uniq'
 
 $spitshell >>makedepend <<'!NO!SUBS!'
 
-: the following weeds options from ccflags that are of no interest to cpp
-case "$ccflags" in
-'');;
-*)  set X $ccflags
-    ccflags=''
-    for flag do
-       case $flag in
-       -D*|-I*) ccflags="$ccflags $flag";;
-       esac
-    done
-    ;;
-esac
-
 $cat /dev/null >.deptmp
 $rm -f *.c.c c/*.c.c
 if test -f Makefile; then
@@ -96,7 +86,7 @@ for file in `$cat .clist`; do
        -e 's|\\$||' \
        -e p \
        -e '}'
-    $cpp -I/usr/local/include -I. $ccflags $file.c | \
+    $cpp -I/usr/local/include -I. $cppflags $file.c | \
     $sed \
        -e '/^# *[0-9]/!d' \
        -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
index 4318a2c..ee926f6 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1,6 +1,9 @@
-/* $Header: malloc.c,v 3.0.1.1 89/10/26 23:15:05 lwall Locked $
+/* $Header: malloc.c,v 3.0.1.2 89/11/11 04:36:37 lwall Locked $
  *
  * $Log:       malloc.c,v $
+ * Revision 3.0.1.2  89/11/11  04:36:37  lwall
+ * patch2: malloc pointer corruption check made more portable
+ * 
  * Revision 3.0.1.1  89/10/26  23:15:05  lwall
  * patch1: some declarations were missing from malloc.c
  * patch1: sparc machines had alignment problems in malloc.c
@@ -137,13 +140,15 @@ malloc(nbytes)
        if ((p = (union overhead *)nextf[bucket]) == NULL)
                return (NULL);
        /* remove from linked list */
-       if (*((int*)p) > 0x10000000)
+#ifdef RCHECK
+       if (*((int*)p) & (sizeof(union overhead) - 1))
 #ifndef I286
            fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
 #else
            fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
 #endif
-       nextf[bucket] = nextf[bucket]->ov_next;
+#endif
+       nextf[bucket] = p->ov_next;
        p->ov_magic = MAGIC;
        p->ov_index= bucket;
 #ifdef MSTATS
index e3d7670..558d48c 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 2
+#define PATCHLEVEL 3
diff --git a/t/TEST b/t/TEST
index e9ed3e9..a554c34 100644 (file)
--- a/t/TEST
+++ b/t/TEST
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: TEST,v 3.0 89/10/18 15:24:06 lwall Locked $
+# $Header: TEST,v 3.0.1.1 89/11/11 04:58:01 lwall Locked $
 
 # This is written in a peculiar style, since we're trying to avoid
 # most of the constructs we'll be testing for.
@@ -30,6 +30,9 @@ while ($test = shift) {
     if ($test =~ /\.orig$/) {
        next;
     }
+    if ($test =~ /\.rej$/) {
+       next;
+    }
     if ($test =~ /~$/) {
        next;
     }
index 2284e9f..a66d26f 100644 (file)
--- a/t/io.argv
+++ b/t/io.argv
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: io.argv,v 3.0 89/10/18 15:26:10 lwall Locked $
+# $Header: io.argv,v 3.0.1.1 89/11/11 04:59:05 lwall Locked $
 
 print "1..5\n";
 
@@ -18,7 +18,7 @@ if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
 
 $x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
 
-if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3\n";}
+if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";}
 
 @ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp');
 while (<>) {
index 9468a35..4b5dba8 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.magic,v 3.0 89/10/18 15:29:54 lwall Locked $
+# $Header: op.magic,v 3.0.1.1 89/11/11 05:00:07 lwall Locked $
 
 $| = 1;                # command buffering
 
@@ -9,8 +9,9 @@ print "1..5\n";
 eval '$ENV{"foo"} = "hi there";';      # check that ENV is inited inside eval
 if (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";}
 
+unlink 'ajslkdfpqjsjfk';
 $! = 0;
-open(foo,'ajslkdfpqjsjfkslkjdflksd');
+open(foo,'ajslkdfpqjsjfk');
 if ($! == 2) {print "ok 2\n";} else {print "not ok 2\n";}
 
 # the next tests are embedded inside system simply because sh spits out
index 93e2ccd..99e04b0 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.mkdir,v 3.0 89/10/18 15:30:05 lwall Locked $
+# $Header: op.mkdir,v 3.0.1.1 89/11/11 05:00:47 lwall Locked $
 
 print "1..7\n";
 
@@ -8,8 +8,8 @@ print "1..7\n";
 
 print (mkdir('blurfl',0666) ? "ok 1\n" : "not ok 1\n");
 print (mkdir('blurfl',0666) ? "not ok 2\n" : "ok 2\n");
-print ($! == 17 ? "ok 3\n" : "not ok 3\n");
+print ($! =~ /exists/ ? "ok 3\n" : "not ok 3\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 ($! == 2 ? "ok 7\n" : "not ok 7\n");
+print ($! =~ /such/ ? "ok 7\n" : "not ok 7\n");
index 2018ac9..c42b98b 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.split,v 3.0 89/10/18 15:31:24 lwall Locked $
+# $Header: op.split,v 3.0.1.1 89/11/11 05:01:44 lwall Locked $
 
 print "1..12\n";
 
@@ -48,7 +48,7 @@ print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
 
 # Does assignment to a list imply split to one more field than that?
 $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`;
-print $foo eq '' || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n";
+print $foo =~ /DEBUGGING/ || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n";
 
 # Can we say how many fields to split to when assigning to a list?
 ($a,$b) = split(' ','1 2 3 4 5 6', 2);
index 72c18a9..92f907c 100644 (file)
--- a/t/op.stat
+++ b/t/op.stat
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.stat,v 3.0 89/10/18 15:31:33 lwall Locked $
+# $Header: op.stat,v 3.0.1.1 89/11/11 05:02:46 lwall Locked $
 
 print "1..56\n";
 
@@ -75,7 +75,7 @@ if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
 if (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";}
 if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
 
-if (! -e '/dev/printer' || -S '/dev/printer')
+if (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer')
     {print "ok 31\n";}
 else
     {print "not ok 31\n";}
index 5654e8e..b322516 100644 (file)
--- a/x2p/a2p.h
+++ b/x2p/a2p.h
@@ -1,4 +1,4 @@
-/* $Header: a2p.h,v 3.0 89/10/18 15:34:14 lwall Locked $
+/* $Header: a2p.h,v 3.0.1.1 89/11/11 05:07:00 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       a2p.h,v $
+ * Revision 3.0.1.1  89/11/11  05:07:00  lwall
+ * patch2: Configure may now set -DDEBUGGING
+ * 
  * Revision 3.0  89/10/18  15:34:14  lwall
  * 3.0 baseline
  * 
@@ -216,8 +219,6 @@ union {
     char *cval;
 } ops[OPSMAX];         /* hope they have 200k to spare */
 
-#define DEBUGGING
-
 #include <stdio.h>
 #include <ctype.h>