perl 3.0 patch #43 patch #42, continued
authorLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Fri, 11 Jan 1991 05:46:37 +0000 (05:46 +0000)
committerLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Fri, 11 Jan 1991 05:46:37 +0000 (05:46 +0000)
See patch #42.

13 files changed:
doio.c
dolist.c
eval.c
evalargs.xc
form.c
installperl [new file with mode: 0644]
lib/flush.pl
malloc.c
patchlevel.h
perl.h
perl.y
t/op.dbm
t/op.mkdir

diff --git a/doio.c b/doio.c
index 7895213..34d4f70 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $Header: doio.c,v 3.0.1.13 90/11/10 01:17:37 lwall Locked $
+/* $Header: doio.c,v 3.0.1.14 91/01/11 17:51:04 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,13 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       doio.c,v $
+ * Revision 3.0.1.14  91/01/11  17:51:04  lwall
+ * patch42: ANSIfied the stat mode checking
+ * patch42: the -i switch is now much more robust and informative
+ * patch42: close on a pipe didn't return failure correctly
+ * patch42: stat on temp values could wipe them out prematurely, i.e. grep(-d,<*>)
+ * patch42: -l didn't work right with _
+ * 
  * Revision 3.0.1.13  90/11/10  01:17:37  lwall
  * patch38: -e _ was wrong if last stat failed
  * patch38: more msdos/os2 upgrades
@@ -270,10 +277,11 @@ int len;
            (void)fclose(fp);
            return FALSE;
        }
-       result = (statbuf.st_mode & S_IFMT);
-#ifdef S_IFSOCK
-       if (result == S_IFSOCK || result == 0)
+       if (S_ISSOCK(statbuf.st_mode))
            stio->type = 's';   /* in case a socket was passed in to us */
+#ifdef S_IFMT
+       else if (!(statbuf.st_mode & S_IFMT))
+           stio->type = 's';   /* some OS's return 0 on fstat()ed socket */
 #endif
     }
 #if defined(FCNTL) && defined(F_SETFD)
@@ -296,7 +304,11 @@ register STAB *stab;
 {
     register STR *str;
     char *oldname;
-    int filemode,fileuid,filegid;
+    int filedev;
+    int fileino;
+    int filemode;
+    int fileuid;
+    int filegid;
 
     while (alen(stab_xarray(stab)) >= 0) {
        str = ashift(stab_xarray(stab));
@@ -308,18 +320,49 @@ register STAB *stab;
 #ifdef TAINT
                taintproper("Insecure dependency in inplace open");
 #endif
+               if (strEQ(oldname,"-")) {
+                   str_free(str);
+                   defoutstab = stabent("STDOUT",TRUE);
+                   return stab_io(stab)->ifp;
+               }
+               filedev = statbuf.st_dev;
+               fileino = statbuf.st_ino;
                filemode = statbuf.st_mode;
                fileuid = statbuf.st_uid;
                filegid = statbuf.st_gid;
+               if (!S_ISREG(filemode)) {
+                   warn("Can't do inplace edit: %s is not a regular file",
+                     oldname );
+                   do_close(stab,FALSE);
+                   str_free(str);
+                   continue;
+               }
                if (*inplace) {
 #ifdef SUFFIX
                    add_suffix(str,inplace);
 #else
                    str_cat(str,inplace);
 #endif
+#ifndef FLEXFILENAMES
+                   if (stat(str->str_ptr,&statbuf) >= 0
+                     && statbuf.st_dev == filedev
+                     && statbuf.st_ino == fileino ) {
+                       warn("Can't do inplace edit: %s > 14 characters",
+                         str->str_ptr );
+                       do_close(stab,FALSE);
+                       str_free(str);
+                       continue;
+                   }
+#endif
 #ifdef RENAME
 #ifndef MSDOS
-                   (void)rename(oldname,str->str_ptr);
+                   if (rename(oldname,str->str_ptr) < 0) {
+                       warn("Can't rename %s to %s: %s, skipping file",
+                         oldname, str->str_ptr, strerror(errno) );
+                       do_close(stab,FALSE);
+                       str_free(str);
+                       continue;
+                   }
 #else
                    do_close(stab,FALSE);
                    (void)unlink(str->str_ptr);
@@ -328,7 +371,13 @@ register STAB *stab;
 #endif /* MSDOS */
 #else
                    (void)UNLINK(str->str_ptr);
-                   (void)link(oldname,str->str_ptr);
+                   if (link(oldname,str->str_ptr) < 0) {
+                       warn("Can't rename %s to %s: %s, skipping file",
+                         oldname, str->str_ptr, strerror(errno) );
+                       do_close(stab,FALSE);
+                       str_free(str);
+                       continue;
+                   }
                    (void)UNLINK(oldname);
 #endif
                }
@@ -344,7 +393,8 @@ register STAB *stab;
                str_cat(str,oldname);
                errno = 0;              /* in case sprintf set errno */
                if (!do_open(argvoutstab,str->str_ptr,str->str_cur))
-                   fatal("Can't do inplace edit");
+                   warn("Can't do inplace edit on %s: %s",
+                     oldname, strerror(errno) );
                defoutstab = argvoutstab;
 #ifdef FCHMOD
                (void)fchmod(fileno(stab_io(argvoutstab)->ifp),filemode);
@@ -363,7 +413,7 @@ register STAB *stab;
            return stab_io(stab)->ifp;
        }
        else
-           fprintf(stderr,"Can't open %s\n",str_get(str));
+           fprintf(stderr,"Can't open %s: %s\n",str_get(str), strerror(errno));
        str_free(str);
     }
     if (inplace) {
@@ -440,7 +490,7 @@ bool explicit;
     if (stio->ifp) {
        if (stio->type == '|') {
            status = mypclose(stio->ifp);
-           retval = (status >= 0);
+           retval = (status == 0);
            statusvalue = (unsigned short)status & 0xffff;
        }
        else if (stio->type == '-')
@@ -651,7 +701,7 @@ int *arglast;
            max = 0;
     }
     else {
-       str_sset(statname,ary->ary_array[sp]);
+       str_set(statname,str_get(ary->ary_array[sp]));
        statstab = Nullstab;
 #ifdef LSTAT
        if (arg->arg_type == O_LSTAT)
@@ -968,11 +1018,28 @@ STR *str;
     }
     else {
        statstab = Nullstab;
-       str_sset(statname,str);
+       str_set(statname,str_get(str));
        return (laststatval = stat(str_get(str),&statcache));
     }
 }
 
+int
+mylstat(arg,str)
+ARG *arg;
+STR *str;
+{
+    if (arg[1].arg_type & A_DONT)
+       fatal("You must supply explicit filename with -l");
+
+    statstab = Nullstab;
+    str_set(statname,str_get(str));
+#ifdef LSTAT
+    return (laststatval = lstat(str_get(str),&statcache));
+#else
+    return (laststatval = stat(str_get(str),&statcache));
+#endif
+}
+
 STR *
 do_fttext(arg,str)
 register ARG *arg;
@@ -1024,7 +1091,7 @@ STR *str;
     }
     else {
        statstab = Nullstab;
-       str_sset(statname,str);
+       str_set(statname,str_get(str));
       really_filename:
        i = open(str_get(str),0);
        if (i < 0)
@@ -2243,11 +2310,10 @@ int *arglast;
            }
            else {      /* don't let root wipe out directories without -U */
 #ifdef LSTAT
-               if (lstat(s,&statbuf) < 0 ||
+               if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
 #else
-               if (stat(s,&statbuf) < 0 ||
+               if (stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
 #endif
-                 (statbuf.st_mode & S_IFMT) == S_IFDIR )
                    tot--;
                else {
                    if (UNLINK(s))
@@ -2298,9 +2364,8 @@ int effective;
 register struct stat *statbufp;
 {
     if ((effective ? euid : uid) == 0) {       /* root is special */
-       if (bit == S_IEXEC) {
-           if (statbufp->st_mode & 0111 ||
-             (statbufp->st_mode & S_IFMT) == S_IFDIR )
+       if (bit == S_IXUSR) {
+           if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
                return TRUE;
        }
        else
index c2822e3..1e9b3e7 100644 (file)
--- a/dolist.c
+++ b/dolist.c
@@ -1,4 +1,4 @@
-/* $Header: dolist.c,v 3.0.1.11 90/11/10 01:29:49 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.12 91/01/11 17:54:58 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:       dolist.c,v $
+ * Revision 3.0.1.12  91/01/11  17:54:58  lwall
+ * patch42: added binary and hex pack/unpack options
+ * patch42: sort subroutines didn't allow copying $a or $b to other variables.
+ * patch42: caller() coredumped when called outside the debugger.
+ * 
  * Revision 3.0.1.11  90/11/10  01:29:49  lwall
  * patch38: temp string values are now copied less often
  * patch38: sort parameters are now in the right package
@@ -549,6 +554,8 @@ int *arglast;
     register char *patend = pat + st[sp]->str_cur;
     int datumtype;
     register int len;
+    register int bits;
+    static char hexchar[] = "0123456789abcdef";
 
     /* These must not be in registers: */
     short ashort;
@@ -566,7 +573,7 @@ int *arglast;
 
     if (gimme != G_ARRAY) {            /* arrange to do first one only */
        for (patend = pat; !isalpha(*patend); patend++);
-       if (*patend == 'a' || *patend == 'A' || *pat == '%') {
+       if (index("aAbBhH", *patend) || *pat == '%') {
            patend++;
            while (isdigit(*patend) || *patend == '*')
                patend++;
@@ -580,8 +587,10 @@ int *arglast;
        datumtype = *pat++;
        if (pat >= patend)
            len = 1;
-       else if (*pat == '*')
+       else if (*pat == '*') {
            len = strend - strbeg;      /* long enough */
+           pat++;
+       }
        else if (isdigit(*pat)) {
            len = *pat++ - '0';
            while (isdigit(*pat))
@@ -636,6 +645,72 @@ int *arglast;
            }
            (void)astore(stack, ++sp, str_2static(str));
            break;
+       case 'B':
+       case 'b':
+           if (pat[-1] == '*' || len > (strend - s) * 8)
+               len = (strend - s) * 8;
+           str = Str_new(35, len + 1);
+           str->str_cur = len;
+           str->str_pok = 1;
+           aptr = pat;                 /* borrow register */
+           pat = str->str_ptr;
+           if (datumtype == 'b') {
+               aint = len;
+               for (len = 0; len < aint; len++) {
+                   if (len & 7)
+                       bits >>= 1;
+                   else
+                       bits = *s++;
+                   *pat++ = '0' + (bits & 1);
+               }
+           }
+           else {
+               aint = len;
+               for (len = 0; len < aint; len++) {
+                   if (len & 7)
+                       bits <<= 1;
+                   else
+                       bits = *s++;
+                   *pat++ = '0' + ((bits & 128) != 0);
+               }
+           }
+           *pat = '\0';
+           pat = aptr;                 /* unborrow register */
+           (void)astore(stack, ++sp, str_2static(str));
+           break;
+       case 'H':
+       case 'h':
+           if (pat[-1] == '*' || len > (strend - s) * 2)
+               len = (strend - s) * 2;
+           str = Str_new(35, len);
+           str->str_cur = len;
+           str->str_pok = 1;
+           aptr = pat;                 /* borrow register */
+           pat = str->str_ptr;
+           if (datumtype == 'h') {
+               aint = len;
+               for (len = 0; len < aint; len++) {
+                   if (len & 1)
+                       bits >>= 4;
+                   else
+                       bits = *s++;
+                   *pat++ = hexchar[bits & 15];
+               }
+           }
+           else {
+               aint = len;
+               for (len = 0; len < aint; len++) {
+                   if (len & 1)
+                       bits <<= 4;
+                   else
+                       bits = *s++;
+                   *pat++ = hexchar[(bits >> 4) & 15];
+               }
+           }
+           *pat = '\0';
+           pat = aptr;                 /* unborrow register */
+           (void)astore(stack, ++sp, str_2static(str));
+           break;
        case 'c':
            if (len > strend - s)
                len = strend - s;
@@ -1260,8 +1335,10 @@ int *arglast;
     register int i = sp - arglast[1];
     int oldsave = savestack->ary_fill;
     SPAT *oldspat = curspat;
+    int oldtmps_base = tmps_base;
 
     savesptr(&stab_val(defstab));
+    tmps_base = tmps_max;
     if ((arg[1].arg_type & A_MASK) != A_EXPR) {
        arg[1].arg_type &= A_MASK;
        dehoist(arg,1);
@@ -1281,6 +1358,7 @@ int *arglast;
        curspat = oldspat;
     }
     restorelist(oldsave);
+    tmps_base = oldtmps_base;
     if (gimme != G_ARRAY) {
        str_numset(str,(double)(dst - arglast[1]));
        STABSET(str);
@@ -1370,6 +1448,8 @@ int *arglast;
        if (*up = st[i]) {
            if (!(*up)->str_pok)
                (void)str_2ptr(*up);
+           else
+               (*up)->str_pok &= ~SP_TEMP;
            up++;
        }
     }
@@ -1510,7 +1590,7 @@ int *arglast;
     for (;;) {
        if (!csv)
            return sp;
-       if (csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
+       if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
            count++;
        if (!count--)
            break;
diff --git a/eval.c b/eval.c
index a2de82f..ae0edbf 100644 (file)
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $Header: eval.c,v 3.0.1.10 90/11/10 01:33:22 lwall Locked $
+/* $Header: eval.c,v 3.0.1.11 91/01/11 17:58: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:       eval.c,v $
+ * Revision 3.0.1.11  91/01/11  17:58:30  lwall
+ * patch42: ANSIfied the stat mode checking
+ * patch42: perl -D14 crashed on ..
+ * patch42: waitpid() emulation was useless because of #ifdef WAITPID
+ * 
  * Revision 3.0.1.10  90/11/10  01:33:22  lwall
  * patch38: random cleanup
  * patch38: couldn't return from sort routine
@@ -1408,9 +1413,11 @@ register int sp;
                stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
                ary = stab_array(stab);
                afill(ary,maxarg - 1);
+               anum = maxarg;
                st += arglast[0]+1;
                while (maxarg-- > 0)
                    ary->ary_array[maxarg] = str_smake(st[maxarg]);
+               st -= arglast[0]+1;
                goto array_return;
            }
            arg->arg_type = optype = O_RANGE;
@@ -1488,7 +1495,7 @@ register int sp;
        break;
 #endif
     case O_WAITPID:
-#ifdef WAITPID
+#ifdef WAIT
 #ifndef lint
        anum = (int)str_gnum(st[1]);
        optype = (int)str_gnum(st[2]);
@@ -1703,8 +1710,7 @@ register int sp;
        if (same_dirent(tmps2, tmps))   /* can always rename to same name */
            anum = 1;
        else {
-           if (euid || stat(tmps2,&statbuf) < 0 ||
-             (statbuf.st_mode & S_IFMT) != S_IFDIR )
+           if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
                (void)UNLINK(tmps2);
            if (!(anum = link(tmps,tmps2)))
                anum = UNLINK(tmps);
@@ -1955,27 +1961,27 @@ register int sp;
 
     case O_FTRREAD:
        argtype = 0;
-       anum = S_IREAD;
+       anum = S_IRUSR;
        goto check_perm;
     case O_FTRWRITE:
        argtype = 0;
-       anum = S_IWRITE;
+       anum = S_IWUSR;
        goto check_perm;
     case O_FTREXEC:
        argtype = 0;
-       anum = S_IEXEC;
+       anum = S_IXUSR;
        goto check_perm;
     case O_FTEREAD:
        argtype = 1;
-       anum = S_IREAD;
+       anum = S_IRUSR;
        goto check_perm;
     case O_FTEWRITE:
        argtype = 1;
-       anum = S_IWRITE;
+       anum = S_IWUSR;
        goto check_perm;
     case O_FTEEXEC:
        argtype = 1;
-       anum = S_IEXEC;
+       anum = S_IXUSR;
       check_perm:
        if (mystat(arg,st[1]) < 0)
            goto say_undef;
@@ -2023,49 +2029,46 @@ register int sp;
        goto donumset;
 
     case O_FTSOCK:
-#ifdef S_IFSOCK
-       anum = S_IFSOCK;
-       goto check_file_type;
-#else
+       if (mystat(arg,st[1]) < 0)
+           goto say_undef;
+       if (S_ISSOCK(statcache.st_mode))
+           goto say_yes;
        goto say_no;
-#endif
     case O_FTCHR:
-       anum = S_IFCHR;
-       goto check_file_type;
+       if (mystat(arg,st[1]) < 0)
+           goto say_undef;
+       if (S_ISCHR(statcache.st_mode))
+           goto say_yes;
+       goto say_no;
     case O_FTBLK:
-#ifdef S_IFBLK
-       anum = S_IFBLK;
-       goto check_file_type;
-#else
+       if (mystat(arg,st[1]) < 0)
+           goto say_undef;
+       if (S_ISBLK(statcache.st_mode))
+           goto say_yes;
        goto say_no;
-#endif
     case O_FTFILE:
-       anum = S_IFREG;
-       goto check_file_type;
+       if (mystat(arg,st[1]) < 0)
+           goto say_undef;
+       if (S_ISREG(statcache.st_mode))
+           goto say_yes;
+       goto say_no;
     case O_FTDIR:
-       anum = S_IFDIR;
-      check_file_type:
        if (mystat(arg,st[1]) < 0)
            goto say_undef;
-       if ((statcache.st_mode & S_IFMT) == anum )
+       if (S_ISDIR(statcache.st_mode))
            goto say_yes;
        goto say_no;
     case O_FTPIPE:
-#ifdef S_IFIFO
-       anum = S_IFIFO;
-       goto check_file_type;
-#else
+       if (mystat(arg,st[1]) < 0)
+           goto say_undef;
+       if (S_ISFIFO(statcache.st_mode))
+           goto say_yes;
        goto say_no;
-#endif
     case O_FTLINK:
-       if (arg[1].arg_type & A_DONT)
-           fatal("You must supply explicit filename with -l");
-#ifdef LSTAT
-       if (lstat(str_get(st[1]),&statcache) < 0)
+       if (mylstat(arg,st[1]) < 0)
            goto say_undef;
-       if ((statcache.st_mode & S_IFMT) == S_IFLNK )
+       if (S_ISLNK(statcache.st_mode))
            goto say_yes;
-#endif
        goto say_no;
     case O_SYMLINK:
 #ifdef SYMLINK
index d6aad79..2c98a02 100644 (file)
@@ -2,9 +2,12 @@
  * kit sizes from getting too big.
  */
 
-/* $Header: evalargs.xc,v 3.0.1.8 90/11/10 01:35:49 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.9 91/01/11 18:00:18 lwall Locked $
  *
  * $Log:       evalargs.xc,v $
+ * Revision 3.0.1.9  91/01/11  18:00:18  lwall
+ * patch42: <> input to individual array elements was suboptimal
+ * 
  * Revision 3.0.1.8  90/11/10  01:35:49  lwall
  * patch38: array slurps are now faster and take less memory
  * 
            }
            if (!fp && dowarn)
                warn("Read on closed filehandle <%s>",stab_name(last_in_stab));
+           when = str->str_len;        /* remember if already alloced */
+           if (!when)
+               Str_Grow(str,80);       /* try short-buffering it */
          keepgoing:
            if (!fp)
                st[sp] = &str_undef;
                    str = Str_new(58,80);
                    goto keepgoing;
                }
+               else if (!when && str->str_len - str->str_cur > 80) {
+                   /* try to reclaim a bit of scalar space on 1st alloc */
+                   if (str->str_cur < 60)
+                       str->str_len = 80;
+                   else
+                       str->str_len = str->str_cur+40; /* allow some slop */
+                   Renew(str->str_ptr, str->str_len, char);
+               }
            }
            record_separator = old_record_separator;
 #ifdef DEBUGGING
diff --git a/form.c b/form.c
index 2b0553f..2b91d43 100644 (file)
--- a/form.c
+++ b/form.c
@@ -1,4 +1,4 @@
-/* $Header: form.c,v 3.0.1.3 90/10/15 17:26:24 lwall Locked $
+/* $Header: form.c,v 3.0.1.4 91/01/11 18:04:07 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:       form.c,v $
+ * Revision 3.0.1.4  91/01/11  18:04:07  lwall
+ * patch42: the @* format counted lines wrong
+ * patch42: the @* format didn't handle lines with nulls or without newline
+ * 
  * Revision 3.0.1.3  90/10/15  17:26:24  lwall
  * patch29: added @###.## fields to format
  * 
@@ -278,10 +282,14 @@ int sp;
            str = stack->ary_array[sp+1];
            s = str_get(str);
            size = str_len(str);
-           CHKLEN(size);
-           orec->o_lines += countlines(s);
+           CHKLEN(size+1);
+           orec->o_lines += countlines(s,size) - 1;
            (void)bcopy(s,d,size);
            d += size;
+           if (size && s[size-1] != '\n') {
+               *d++ = '\n';
+               orec->o_lines++;
+           }
            linebeg = fcmd->f_next;
            break;
        case F_DECIMAL: {
@@ -289,6 +297,8 @@ int sp;
 
            (void)eval(fcmd->f_expr,G_SCALAR,sp);
            str = stack->ary_array[sp+1];
+           size = fcmd->f_size;
+           CHKLEN(size);
            /* If the field is marked with ^ and the value is undefined,
               blank it out. */
            if ((fcmd->f_flags & FC_CHOP) && !str->str_pok && !str->str_nok) {
@@ -299,8 +309,6 @@ int sp;
                break;
            }
            value = str_gnum(str);
-           size = fcmd->f_size;
-           CHKLEN(size);
            if (fcmd->f_flags & FC_DP) {
                sprintf(d, "%#*.*f", size, fcmd->f_decimals, value);
            } else {
@@ -315,12 +323,13 @@ int sp;
     *d++ = '\0';
 }
 
-countlines(s)
+countlines(s,size)
 register char *s;
+register int size;
 {
     register int count = 0;
 
-    while (*s) {
+    while (size--) {
        if (*s++ == '\n')
            count++;
     }
diff --git a/installperl b/installperl
new file mode 100644 (file)
index 0000000..12c314d
--- /dev/null
@@ -0,0 +1,162 @@
+#!./perl
+
+while (@ARGV) {
+    $nonono = 1 if $ARGV[0] eq '-n';
+    $versiononly = 1 if $ARGV[0] eq '-v';
+    shift;
+}
+
+@scripts = 'h2ph';
+@manpages = ('perl.man', 'h2ph.man');
+
+# Read in the config file.
+
+open(CONFIG, "config.sh") || die "You haven't run Configure yet!\n";
+while (<CONFIG>) {
+    if (s/^(\w+=)/\$$1/) {
+       $accum =~ s/'undef'/undef/g;
+       eval $accum;
+       $accum = '';
+    }
+    $accum .= $_;
+}
+
+# Do some quick sanity checks.
+
+if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
+
+   $bin                || die "No bin directory in config.sh\n";
+-d $bin                || die "$bin is not a directory\n";
+-w $bin                || die "$bin is not writable by you\n";
+
+-x 'perl'      || die "perl isn't executable!\n";
+-x 'taintperl' || die "taintperl isn't executable!\n";
+-x 'suidperl'  || die "suidperl isn't executable!\n" if $d_dosuid;
+
+-x 't/TEST'    || die "You've never run 'make test'!\n";
+
+# First we install the version-numbered executables.
+
+$ver = sprintf("%5.3f", $]);
+
+&unlink("$bin/perl$ver");
+&cmd("cp perl $bin/perl$ver");
+
+&unlink("$bin/tperl$ver");
+&cmd("cp taintperl $bin/tperl$ver");
+&chmod(0755, "$bin/tperl$ver");                # force non-suid for security
+
+&unlink("$bin/sperl$ver");
+if ($d_dosuid) {
+    &cmd("cp suidperl $bin/sperl$ver");
+    &chmod(04711, "$bin/sperl$ver");
+}
+
+exit 0 if $versiononly;
+
+# Make links to ordinary names if bin directory isn't current directory.
+
+($bdev,$bino) = stat($bin);
+($ddev,$dino) = stat('.');
+
+if ($bdev != $ddev || $bino != $dino) {
+    &unlink("$bin/perl", "$bin/taintperl", "$bin/suidperl");
+    &link("$bin/perl$ver", "$bin/perl");
+    &link("$bin/tperl$ver", "$bin/taintperl");
+    &link("$bin/sperl$ver", "$bin/suidperl") if $d_dosuid;
+}
+
+# Make some enemies in the name of standardization.   :-)
+
+($udev,$uino) = stat("/usr/bin");
+
+if (($udev != $ddev || $uino != $dino) && !$nonono) {
+    unlink "/usr/bin/perl";
+    eval 'symlink("$bin/perl", "/usr/bin/perl")' ||
+    eval 'link("$bin/perl", "/usr/bin/perl")' ||
+    &cmd("cp $bin/perl /usr/bin");
+}
+
+# Install scripts.
+
+&makedir($scriptdir);
+
+for (@scripts) {
+    &chmod(0755, $_);
+    &cmd("cp $_ $scriptdir");
+}
+
+# Install library files.
+
+&makedir($privlib);
+
+($pdev,$pino) = stat($privlib);
+
+if ($pdev != $ddev || $pino != $dino) {
+    &cmd("cd lib && cp *.pl $privlib");
+}
+
+# Install man pages.
+
+&makedir($mansrc);
+
+($mdev,$mino) = stat($mansrc);
+if ($mdev != $ddev || $mino != $dino) {
+    for (@manpages) {
+       ($new = $_) =~ s/man$/$manext/;
+       &cmd("cp $_ $mansrc/$new");
+    }
+}
+
+print STDERR "  Installation complete\n";
+
+exit 0;
+
+###############################################################################
+
+sub unlink {
+    local(@names) = @_;
+
+    foreach $name (@names) {
+       next unless -e $name;
+       print STDERR "  unlink $name\n";
+       unlink($name) || warn "Couldn't unlink $name: $!\n" unless $nonono;
+    }
+}
+
+sub cmd {
+    local($cmd) = @_;
+    print STDERR "  $cmd\n";
+    unless ($nonono) {
+       system $cmd;
+       warn "Command failed!!!\n" if $?;
+    }
+}
+
+sub link {
+    local($from,$to) = @_;
+
+    print STDERR "  ln $from $to\n";
+    link($from,$to) || warn "Couldn't link $from to $to: $!\n" unless $nonono;
+}
+
+sub chmod {
+    local($mode,$name) = @_;
+
+    printf STDERR "  chmod %o %s\n", $mode, $name;
+    chmod($mode,$name) || warn "Couldn't chmod $mode $name: $!\n"
+       unless $nonono;
+}
+
+sub makedir {
+    local($dir) = @_;
+    unless (-d $dir) {
+       local($shortdir) = $dir;
+
+       $shortdir =~ s#(.*)/.*#$1#;
+       &makedir($shortdir);
+
+       print STDERR "  mkdir $dir\n";
+       mkdir($dir, 0777) || warn "Couldn't create $dir: $!\n" unless $nonono;
+    }
+}
index 1d22819..55002b9 100644 (file)
@@ -20,3 +20,4 @@ sub printflush {
     select($old);
 }
 
+1;
index 6ad48b9..3ed5536 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1,6 +1,9 @@
-/* $Header: malloc.c,v 3.0.1.4 90/11/13 15:23:45 lwall Locked $
+/* $Header: malloc.c,v 3.0.1.5 91/01/11 18:09:52 lwall Locked $
  *
  * $Log:       malloc.c,v $
+ * Revision 3.0.1.5  91/01/11  18:09:52  lwall
+ * patch42: Configure now checks alignment requirements
+ * 
  * Revision 3.0.1.4  90/11/13  15:23:45  lwall
  * patch41: added hp malloc union overhead strut (that sounds very blue collar)
  * 
@@ -59,8 +62,8 @@ static findbucket(), morecore();
  */
 union  overhead {
        union   overhead *ov_next;      /* when free */
-#if defined(mips) || defined(sparc) || defined(luna88k) || defined(hp9000s800)
-       double  strut;                  /* alignment problems */
+#if ALIGNBYTES > 4
+       double  strut;                  /* alignment problems */
 #endif
        struct {
                u_char  ovu_magic;      /* magic number */
index f037018..64b1306 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 42
+#define PATCHLEVEL 43
diff --git a/perl.h b/perl.h
index c911e2b..ca773cb 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $Header: perl.h,v 3.0.1.10 90/11/10 01:44:13 lwall Locked $
+/* $Header: perl.h,v 3.0.1.11 91/01/11 18:10:57 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:       perl.h,v $
+ * Revision 3.0.1.11  91/01/11  18:10:57  lwall
+ * patch42: ANSIfied the stat mode checking
+ * 
  * Revision 3.0.1.10  90/11/10  01:44:13  lwall
  * patch38: more msdos/os2 upgrades
  * 
@@ -288,6 +291,98 @@ EXT int dbmlen;
 #   endif
 #endif
 
+/*
+ * The following gobbledygook brought to you on behalf of __STDC__.
+ * (I could just use #ifndef __STDC__, but this is more bulletproof
+ * in the face of half-implementations.)
+ */
+
+#ifndef S_IFMT
+#   ifdef _S_IFMT
+#      define S_IFMT _S_IFMT
+#   else
+#      define S_IFMT 0170000
+#   endif
+#endif
+
+#ifndef S_ISDIR
+#   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
+#endif
+
+#ifndef S_ISCHR
+#   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
+#endif
+
+#ifndef S_ISBLK
+#   define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
+#endif
+
+#ifndef S_ISREG
+#   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef S_ISFIFO
+#   define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
+#endif
+
+#ifndef S_ISLNK
+#   ifdef _S_ISLNK
+#      define S_ISLNK(m) _S_ISLNK(m)
+#   else
+#      ifdef _S_IFLNK
+#          define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
+#      else
+#          ifdef S_IFLNK
+#              define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
+#          else
+#              define S_ISLNK(m) (0)
+#          endif
+#      endif
+#   endif
+#endif
+
+#ifndef S_ISSOCK
+#   ifdef _S_ISSOCK
+#      define S_ISSOCK(m) _S_ISSOCK(m)
+#   else
+#      ifdef _S_IFSOCK
+#          define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
+#      else
+#          ifdef S_IFSOCK
+#              define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
+#          else
+#              define S_ISSOCK(m) (0)
+#          endif
+#      endif
+#   endif
+#endif
+
+#ifndef S_IRUSR
+#   ifdef S_IREAD
+#      define S_IRUSR S_IREAD
+#      define S_IWUSR S_IWRITE
+#      define S_IXUSR S_IEXEC
+#   else
+#      define S_IRUSR 0400
+#      define S_IWUSR 0200
+#      define S_IXUSR 0100
+#   endif
+#   define S_IRGRP (S_IRUSR>>3)
+#   define S_IWGRP (S_IWUSR>>3)
+#   define S_IXGRP (S_IXUSR>>3)
+#   define S_IROTH (S_IRUSR>>6)
+#   define S_IWOTH (S_IWUSR>>6)
+#   define S_IXOTH (S_IXUSR>>6)
+#endif
+
+#ifndef S_ISUID
+#   define S_ISUID 04000
+#endif
+
+#ifndef S_ISGID
+#   define S_ISGID 02000
+#endif
+
 typedef unsigned int STRLEN;
 
 typedef struct arg ARG;
diff --git a/perl.y b/perl.y
index c8394be..5c5b4a4 100644 (file)
--- a/perl.y
+++ b/perl.y
@@ -1,4 +1,4 @@
-/* $Header: perl.y,v 3.0.1.9 90/10/15 18:01:45 lwall Locked $
+/* $Header: perl.y,v 3.0.1.10 91/01/11 18:14:28 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:       perl.y,v $
+ * Revision 3.0.1.10  91/01/11  18:14:28  lwall
+ * patch42: package didn't create symbol tables that could be reset
+ * patch42: split with no arguments could wipe out next operator
+ * 
  * Revision 3.0.1.9  90/10/15  18:01:45  lwall
  * patch29: added SysV IPC
  * patch29: package behavior is now more consistent
@@ -349,7 +353,9 @@ package :   PACKAGE WORD ';'
                          saveitem(curstname);
                          str_set(curstname,$2);
                          sprintf(tmpbuf,"'_%s",$2);
-                         tmpstab = hadd(stabent(tmpbuf,TRUE));
+                         tmpstab = stabent(tmpbuf,TRUE);
+                         if (!stab_xhash(tmpstab))
+                             stab_xhash(tmpstab) = hnew(0);
                          curstash = stab_xhash(tmpstab);
                          if (!curstash->tbl_name)
                              curstash->tbl_name = savestr($2);
@@ -664,8 +670,15 @@ term       :       '-' term %prec UMINUS
                              aadd(stabent(subline ? "_" : "ARGV", TRUE))),
                            Nullarg, Nullarg); }
        |       SPLIT   %prec '('
-{static char p[]="/\\s+/";char*o=bufend;bufend=p+5;(void)scanpat(p);bufend=o;
-                           $$ = make_split(defstab,yylval.arg,Nullarg); }
+                       {   static char p[]="/\\s+/";
+                           char *oldend = bufend;
+                           int oldarg = yylval.arg;
+                           
+                           bufend=p+5;
+                           (void)scanpat(p);
+                           bufend=oldend;
+                           $$ = make_split(defstab,yylval.arg,Nullarg);
+                           yylval.arg = oldarg; }
        |       SPLIT '(' sexpr csexpr csexpr ')'
                        { $$ = mod_match(O_MATCH, $4,
                          make_split(defstab,$3,$5));}
index 1f80715..15a6f75 100644 (file)
--- a/t/op.dbm
+++ b/t/op.dbm
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.dbm,v 3.0.1.1 90/03/27 16:25:57 lwall Locked $
+# $Header: op.dbm,v 3.0.1.2 91/01/11 18:29:12 lwall Locked $
 
 if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h') {
     print "1..0\n";
@@ -9,7 +9,7 @@ if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h') {
 
 print "1..10\n";
 
-unlink 'Op.dbmx.dir', 'Op.dbmx.pag';
+unlink <Op.dbmx.*>;
 umask(0);
 print (dbmopen(h,'Op.dbmx',0640) ? "ok 1\n" : "not ok 1\n");
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
index 01dc6ca..dba5a88 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.mkdir,v 3.0.1.3 90/03/12 17:03:57 lwall Locked $
+# $Header: op.mkdir,v 3.0.1.4 91/01/11 18:30:00 lwall Locked $
 
 print "1..7\n";
 
@@ -8,7 +8,7 @@ print "1..7\n";
 
 print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
 print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
-print ($! =~ /exists/ ? "ok 3\n" : "not ok 3\n");
+print ($! =~ /exist/ ? "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");