perl 4.0 patch 26: patch #20, continued
authorLarry Wall <lwall@netlabs.com>
Mon, 8 Jun 1992 04:52:08 +0000 (04:52 +0000)
committerLarry Wall <lwall@netlabs.com>
Mon, 8 Jun 1992 04:52:08 +0000 (04:52 +0000)
See patch #20.

18 files changed:
atarist/test/gdbm [new file with mode: 0644]
atarist/test/gdbm.t [new file with mode: 0644]
atarist/usub/makefile.st [new file with mode: 0644]
doio.c
form.c
h2ph.SH
handy.h
hash.c
hints/hp9000_700.sh [new file with mode: 0644]
hints/hp9000_800.sh
hints/hpux.sh
hints/isc_3_2_2.sh
hints/mc6000.sh [new file with mode: 0644]
installperl
makedir.SH
os2/glob.c
patchlevel.h
t/op/goto.t

diff --git a/atarist/test/gdbm b/atarist/test/gdbm
new file mode 100644 (file)
index 0000000..207eea3
--- /dev/null
@@ -0,0 +1,28 @@
+die "cant create dbmtest" unless dbmopen(%keys, "dbmtest", 0666);
+
+print "Writing...\n";
+
+foreach (0..100) {
+    $keys{"$_"} = $_;
+}
+
+print "Done\n";
+
+dbmclose (%keys);
+
+die "cant read dbmtest" unless dbmopen(%rkeys, "dbmtest", undef);
+
+$i = 0;
+print "Reading...\n";
+while (($key, $val) = each %rkeys)
+{
+  if ($keys{$key} != $val)
+  {
+     print 'Incorrect val ', $key, ' = ', $val, ' expecting ', $keys{$key}, "\n";
+     $i = $i + 1;
+  }
+}
+print "Done\n";
+dbmclose (%keys);
+print $i, " Error(s)\n";
+unlink "dbmtest";
diff --git a/atarist/test/gdbm.t b/atarist/test/gdbm.t
new file mode 100644 (file)
index 0000000..8e4a3a1
--- /dev/null
@@ -0,0 +1,101 @@
+#!./perl
+
+#
+# based on t/op/dbm.t modified for gdbm and atariST stat() semantics
+#
+print "1..12\n";
+
+unlink <Op.dbm>;
+umask(0);
+print (dbmopen(h,'Op.dbm',0640) ? "ok 1\n" : "not ok 1\n");
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('Op.dbm');
+print (($mode & 0770) == 0640 ? "ok 2\n" : "not ok 2\n");
+while (($key,$value) = each(h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+dbmclose(h);
+print (dbmopen(h,'Op.dbm',0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+       $key =~ y/a-z/A-Z/;
+       $i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('Op.dbm');
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbm';
diff --git a/atarist/usub/makefile.st b/atarist/usub/makefile.st
new file mode 100644 (file)
index 0000000..ede484f
--- /dev/null
@@ -0,0 +1,17 @@
+CC = cgcc
+SRC = ..
+GLOBINCS = 
+LOCINCS = 
+LIBS = -lcurses  -lgdbm -lpml -lgnu
+
+cperl.ttp: $(SRC)/uperl.a usersub.o curses.o
+       $(CC) $(SRC)/uperl.a usersub.o curses.o $(LIBS) -o cperl.ttp
+
+usersub.o: usersub.c
+       $(CC) -c -I$(SRC) $(GLOBINCS) -O usersub.c
+
+curses.o: curses.c
+       $(CC) -c -I$(SRC) $(GLOBINCS) -O curses.c
+
+curses.c: acurses.mus
+       perl mus acurses.mus >curses.c
diff --git a/doio.c b/doio.c
index 0c5a1c9..aa85abe 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $RCSfile: doio.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:51:43 $
+/* $RCSfile: doio.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 13:00:21 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,16 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       doio.c,v $
+ * Revision 4.0.1.5  92/06/08  13:00:21  lwall
+ * patch20: some machines don't define ENOTSOCK in errno.h
+ * patch20: new warnings for failed use of stat operators on filenames with \n
+ * patch20: wait failed when STDOUT or STDERR reopened to a pipe
+ * patch20: end of file latch not reset on reopen of STDIN
+ * patch20: seek(HANDLE, 0, 1) went to eof because of ancient Ultrix workaround
+ * patch20: fixed memory leak on system() for vfork() machines
+ * patch20: get*by* routines now return something useful in a scalar context
+ * patch20: h_errno now accessible via $?
+ * 
  * 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
@@ -41,6 +51,9 @@
 #ifdef HAS_SOCKET
 #include <sys/socket.h>
 #include <netdb.h>
+#ifndef ENOTSOCK
+#include <net/errno.h>
+#endif
 #endif
 
 #ifdef HAS_SELECT
@@ -83,6 +96,8 @@
 int laststatval = -1;
 int laststype = O_STAT;
 
+static char* warn_nl = "Unsuccessful %s on filename containing newline";
+
 bool
 do_open(stab,name,len)
 STAB *stab;
@@ -100,6 +115,7 @@ int len;
     FILE *saveofp = Nullfp;
     char savetype = ' ';
 
+    mode[0] = mode[1] = mode[2] = '\0';
     name = myname;
     forkprocess = 1;           /* assume true if no fork */
     while (len && isSPACE(name[len-1]))
@@ -130,7 +146,7 @@ int len;
            result = fclose(stio->ifp);
        if (result == EOF && fd > maxsysfd)
            fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
-             stab_name(stab));
+             stab_ename(stab));
        stio->ofp = stio->ifp = Nullfp;
     }
     if (*name == '+' && len > 1 && name[len-1] != '|') {       /* scary */
@@ -244,9 +260,13 @@ int len;
                fp = fopen(name,"r");
        }
     }
-    Safefree(myname);
-    if (!fp)
+    if (!fp) {
+       if (dowarn && stio->type == '<' && index(name, '\n'))
+           warn(warn_nl, "open");
+       Safefree(myname);
        goto say_false;
+    }
+    Safefree(myname);
     if (stio->type &&
       stio->type != '|' && stio->type != '-') {
        if (fstat(fileno(fp),&statbuf) < 0) {
@@ -263,7 +283,9 @@ int len;
            !statbuf.st_mode
 #endif
        ) {
-           if (getsockname(fileno(fp), tokenbuf, 0) >= 0 || errno != ENOTSOCK)
+           int buflen = sizeof tokenbuf;
+           if (getsockname(fileno(fp), tokenbuf, &buflen) >= 0
+               || errno != ENOTSOCK)
                stio->type = 's'; /* some OS's return 0 on fstat()ed socket */
                                /* but some return 0 for streams too, sigh */
        }
@@ -280,10 +302,20 @@ int len;
            }
        }
        if (fd != fileno(fp)) {
+           int pid;
+           STR *str;
+
            dup2(fileno(fp), fd);
+           str = afetch(fdpid,fileno(fp),TRUE);
+           pid = str->str_u.str_useful;
+           str->str_u.str_useful = 0;
+           str = afetch(fdpid,fd,TRUE);
+           str->str_u.str_useful = pid;
            fclose(fp);
+
        }
        fp = saveifp;
+       clearerr(fp);
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fd = fileno(fp);
@@ -384,7 +416,7 @@ register STAB *stab;
                    }
 #endif
 #ifdef HAS_RENAME
-#ifndef MSDOS
+#ifndef DOSISH
                    if (rename(oldname,str->str_ptr) < 0) {
                        warn("Can't rename %s to %s: %s, skipping file",
                          oldname, str->str_ptr, strerror(errno) );
@@ -411,7 +443,7 @@ register STAB *stab;
 #endif
                }
                else {
-#ifndef MSDOS
+#ifndef DOSISH
                    if (UNLINK(oldname) < 0) {
                        warn("Can't rename %s to %s: %s, skipping file",
                          oldname, str->str_ptr, strerror(errno) );
@@ -536,7 +568,7 @@ bool explicit;
     stio = stab_io(stab);
     if (!stio) {               /* never opened */
        if (dowarn && explicit)
-           warn("Close on unopened file <%s>",stab_name(stab));
+           warn("Close on unopened file <%s>",stab_ename(stab));
        return FALSE;
     }
     if (stio->ifp) {
@@ -621,8 +653,10 @@ STAB *stab;
     if (!stio || !stio->ifp)
        goto phooey;
 
+#ifdef ULTRIX_STDIO_BOTCH
     if (feof(stio->ifp))
        (void)fseek (stio->ifp, 0L, 2);         /* ultrix 1.2 workaround */
+#endif
 
     return ftell(stio->ifp);
 
@@ -648,8 +682,10 @@ int whence;
     if (!stio || !stio->ifp)
        goto nuts;
 
+#ifdef ULTRIX_STDIO_BOTCH
     if (feof(stio->ifp))
        (void)fseek (stio->ifp, 0L, 2);         /* ultrix 1.2 workaround */
+#endif
 
     return fseek(stio->ifp, pos, whence) >= 0;
 
@@ -700,7 +736,7 @@ STR *argstr;
     }
     else {
        retval = (int)str_gnum(argstr);
-#ifdef MSDOS
+#ifdef DOSISH
        s = (char*)(long)retval;                /* ouch */
 #else
        s = (char*)retval;              /* ouch */
@@ -711,7 +747,7 @@ STR *argstr;
     if (optype == O_IOCTL)
        retval = ioctl(fileno(stio->ifp), func, s);
     else
-#ifdef MSDOS
+#ifdef DOSISH
        fatal("fcntl is not implemented");
 #else
 #ifdef HAS_FCNTL
@@ -768,8 +804,11 @@ int *arglast;
        else
 #endif
            laststatval = stat(str_get(statname),&statcache);
-       if (laststatval < 0)
+       if (laststatval < 0) {
+           if (dowarn && index(str_get(statname), '\n'))
+               warn(warn_nl, "stat");
            max = 0;
+       }
     }
 
     if (gimme != G_ARRAY) {
@@ -1000,7 +1039,7 @@ FILE *fp;
        if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0'
          && str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) {
            STR *tmpstr = str_mortal(&str_undef);
-           stab_fullname(tmpstr,((STAB*)str));/* a stab value, be nice */
+           stab_efullname(tmpstr,((STAB*)str));/* a stab value, be nice */
            str = tmpstr;
            tmps = str->str_ptr;
            putc('*',fp);
@@ -1072,7 +1111,7 @@ STR *str;
                return laststatval;
            if (dowarn)
                warn("Stat on unopened file <%s>",
-                 stab_name(arg[1].arg_ptr.arg_stab));
+                 stab_ename(arg[1].arg_ptr.arg_stab));
            statstab = Nullstab;
            str_set(statname,"");
            return (laststatval = -1);
@@ -1082,7 +1121,10 @@ STR *str;
        statstab = Nullstab;
        str_set(statname,str_get(str));
        laststype = O_STAT;
-       return (laststatval = stat(str_get(str),&statcache));
+       laststatval = stat(str_get(str),&statcache);
+       if (laststatval < 0 && dowarn && index(str_get(str), '\n'))
+           warn(warn_nl, "stat");
+       return laststatval;
     }
 }
 
@@ -1104,10 +1146,13 @@ STR *str;
     statstab = Nullstab;
     str_set(statname,str_get(str));
 #ifdef HAS_LSTAT
-    return (laststatval = lstat(str_get(str),&statcache));
+    laststatval = lstat(str_get(str),&statcache);
 #else
-    return (laststatval = stat(str_get(str),&statcache));
+    laststatval = stat(str_get(str),&statcache);
 #endif
+    if (laststatval < 0 && dowarn && index(str_get(str), '\n'))
+       warn(warn_nl, "lstat");
+    return laststatval;
 }
 
 STR *
@@ -1137,7 +1182,7 @@ STR *str;
            stio = stab_io(statstab);
        }
        if (stio && stio->ifp) {
-#ifdef STDSTDIO
+#if defined(STDSTDIO) || defined(atarist) /* this will work with atariST */
            fstat(fileno(stio->ifp),&statcache);
            if (S_ISDIR(statcache.st_mode))     /* handle NFS glitch */
                return arg->arg_type == O_FTTEXT ? &str_no : &str_yes;
@@ -1157,7 +1202,7 @@ STR *str;
        else {
            if (dowarn)
                warn("Test on unopened file <%s>",
-                 stab_name(arg[1].arg_ptr.arg_stab));
+                 stab_ename(arg[1].arg_ptr.arg_stab));
            errno = EBADF;
            return &str_undef;
        }
@@ -1167,8 +1212,11 @@ STR *str;
        str_set(statname,str_get(str));
       really_filename:
        i = open(str_get(str),0);
-       if (i < 0)
+       if (i < 0) {
+           if (dowarn && index(str_get(str), '\n'))
+               warn(warn_nl, "open");
            return &str_undef;
+       }
        fstat(i,&statcache);
        len = read(i,tbuf,512);
        (void)close(i);
@@ -1201,6 +1249,9 @@ STR *str;
        return &str_yes;
 }
 
+static char **Argv = Null(char **);
+static char *Cmd = Nullch;
+
 bool
 do_aexec(really,arglast)
 STR *really;
@@ -1210,12 +1261,11 @@ int *arglast;
     register int sp = arglast[1];
     register int items = arglast[2] - sp;
     register char **a;
-    char **argv;
     char *tmps;
 
     if (items) {
-       New(401,argv, items+1, char*);
-       a = argv;
+       New(401,Argv, items+1, char*);
+       a = Argv;
        for (st += ++sp; items > 0; items--,st++) {
            if (*st)
                *a++ = str_get(*st);
@@ -1224,21 +1274,18 @@ int *arglast;
        }
        *a = Nullch;
 #ifdef TAINT
-       if (*argv[0] != '/')    /* will execvp use PATH? */
+       if (*Argv[0] != '/')    /* will execvp use PATH? */
            taintenv();         /* testing IFS here is overkill, probably */
 #endif
        if (really && *(tmps = str_get(really)))
-           execvp(tmps,argv);
+           execvp(tmps,Argv);
        else
-           execvp(argv[0],argv);
-       Safefree(argv);
+           execvp(Argv[0],Argv);
     }
+    do_execfree();
     return FALSE;
 }
 
-static char **Argv = Null(char **);
-static char *Cmd = Nullch;
-
 void
 do_execfree()
 {
@@ -1551,8 +1598,8 @@ int *arglast;
     register int sp = arglast[1];
     register STIO *stio;
     int fd;
-    int lvl;
-    int optname;
+    unsigned int lvl;
+    unsigned int optname;
 
     if (!stab)
        goto nuts;
@@ -1562,14 +1609,15 @@ int *arglast;
        goto nuts;
 
     fd = fileno(stio->ifp);
-    lvl = (int)str_gnum(st[sp+1]);
-    optname = (int)str_gnum(st[sp+2]);
+    lvl = (unsigned int)str_gnum(st[sp+1]);
+    optname = (unsigned int)str_gnum(st[sp+2]);
     switch (optype) {
     case O_GSOCKOPT:
        st[sp] = str_2mortal(Str_new(22,257));
        st[sp]->str_cur = 256;
        st[sp]->str_pok = 1;
-       if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
+       if (getsockopt(fd, lvl, optname, st[sp]->str_ptr,
+                       (int*)&st[sp]->str_cur) < 0)
            goto nuts;
        break;
     case O_SSOCKOPT:
@@ -1615,11 +1663,11 @@ int *arglast;
     fd = fileno(stio->ifp);
     switch (optype) {
     case O_GETSOCKNAME:
-       if (getsockname(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
+       if (getsockname(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0)
            goto nuts2;
        break;
     case O_GETPEERNAME:
-       if (getpeername(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
+       if (getpeername(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0)
            goto nuts2;
        break;
     }
@@ -1654,11 +1702,6 @@ int *arglast;
     struct hostent *hent;
     unsigned long len;
 
-    if (gimme != G_ARRAY) {
-       astore(ary, ++sp, str_mortal(&str_undef));
-       return sp;
-    }
-
     if (which == O_GHBYNAME) {
        char *name = str_get(ary->ary_array[sp+1]);
 
@@ -1677,6 +1720,28 @@ int *arglast;
 #else
        fatal("gethostent not implemented");
 #endif
+
+#ifdef HOST_NOT_FOUND
+    if (!hent)
+       statusvalue = (unsigned short)h_errno & 0xffff;
+#endif
+
+    if (gimme != G_ARRAY) {
+       astore(ary, ++sp, str = str_mortal(&str_undef));
+       if (hent) {
+           if (which == O_GHBYNAME) {
+#ifdef h_addr
+               str_nset(str, *hent->h_addr, hent->h_length);
+#else
+               str_nset(str, hent->h_addr, hent->h_length);
+#endif
+           }
+           else
+               str_set(str, hent->h_name);
+       }
+       return sp;
+    }
+
     if (hent) {
 #ifndef lint
        (void)astore(ary, ++sp, str = str_mortal(&str_no));
@@ -1726,11 +1791,6 @@ int *arglast;
     struct netent *getnetent();
     struct netent *nent;
 
-    if (gimme != G_ARRAY) {
-       astore(ary, ++sp, str_mortal(&str_undef));
-       return sp;
-    }
-
     if (which == O_GNBYNAME) {
        char *name = str_get(ary->ary_array[sp+1]);
 
@@ -1745,6 +1805,17 @@ int *arglast;
     else
        nent = getnetent();
 
+    if (gimme != G_ARRAY) {
+       astore(ary, ++sp, str = str_mortal(&str_undef));
+       if (nent) {
+           if (which == O_GNBYNAME)
+               str_numset(str, (double)nent->n_net);
+           else
+               str_set(str, nent->n_name);
+       }
+       return sp;
+    }
+
     if (nent) {
 #ifndef lint
        (void)astore(ary, ++sp, str = str_mortal(&str_no));
@@ -1784,11 +1855,6 @@ int *arglast;
     struct protoent *getprotoent();
     struct protoent *pent;
 
-    if (gimme != G_ARRAY) {
-       astore(ary, ++sp, str_mortal(&str_undef));
-       return sp;
-    }
-
     if (which == O_GPBYNAME) {
        char *name = str_get(ary->ary_array[sp+1]);
 
@@ -1802,6 +1868,17 @@ int *arglast;
     else
        pent = getprotoent();
 
+    if (gimme != G_ARRAY) {
+       astore(ary, ++sp, str = str_mortal(&str_undef));
+       if (pent) {
+           if (which == O_GPBYNAME)
+               str_numset(str, (double)pent->p_proto);
+           else
+               str_set(str, pent->p_name);
+       }
+       return sp;
+    }
+
     if (pent) {
 #ifndef lint
        (void)astore(ary, ++sp, str = str_mortal(&str_no));
@@ -1839,11 +1916,6 @@ int *arglast;
     struct servent *getservent();
     struct servent *sent;
 
-    if (gimme != G_ARRAY) {
-       astore(ary, ++sp, str_mortal(&str_undef));
-       return sp;
-    }
-
     if (which == O_GSBYNAME) {
        char *name = str_get(ary->ary_array[sp+1]);
        char *proto = str_get(ary->ary_array[sp+2]);
@@ -1861,6 +1933,23 @@ int *arglast;
     }
     else
        sent = getservent();
+
+    if (gimme != G_ARRAY) {
+       astore(ary, ++sp, str = str_mortal(&str_undef));
+       if (sent) {
+           if (which == O_GSBYNAME) {
+#ifdef HAS_NTOHS
+               str_numset(str, (double)ntohs(sent->s_port));
+#else
+               str_numset(str, (double)(sent->s_port));
+#endif
+           }
+           else
+               str_set(str, sent->s_name);
+       }
+       return sp;
+    }
+
     if (sent) {
 #ifndef lint
        (void)astore(ary, ++sp, str = str_mortal(&str_no));
@@ -2007,6 +2096,7 @@ int *arglast;
                for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
                    s[(k % masksize) + offset] = fd_sets[i][j+offset];
            }
+           Safefree(fd_sets[i]);
        }
     }
 #endif
@@ -2098,11 +2188,6 @@ int *arglast;
     struct passwd *getpwent();
     struct passwd *pwent;
 
-    if (gimme != G_ARRAY) {
-       astore(ary, ++sp, str_mortal(&str_undef));
-       return sp;
-    }
-
     if (which == O_GPWNAM) {
        char *name = str_get(ary->ary_array[sp+1]);
 
@@ -2116,6 +2201,17 @@ int *arglast;
     else
        pwent = getpwent();
 
+    if (gimme != G_ARRAY) {
+       astore(ary, ++sp, str = str_mortal(&str_undef));
+       if (pwent) {
+           if (which == O_GPWNAM)
+               str_numset(str, (double)pwent->pw_uid);
+           else
+               str_set(str, pwent->pw_name);
+       }
+       return sp;
+    }
+
     if (pwent) {
        (void)astore(ary, ++sp, str = str_mortal(&str_no));
        str_set(str, pwent->pw_name);
@@ -2179,11 +2275,6 @@ int *arglast;
     struct group *getgrent();
     struct group *grent;
 
-    if (gimme != G_ARRAY) {
-       astore(ary, ++sp, str_mortal(&str_undef));
-       return sp;
-    }
-
     if (which == O_GGRNAM) {
        char *name = str_get(ary->ary_array[sp+1]);
 
@@ -2197,6 +2288,17 @@ int *arglast;
     else
        grent = getgrent();
 
+    if (gimme != G_ARRAY) {
+       astore(ary, ++sp, str = str_mortal(&str_undef));
+       if (grent) {
+           if (which == O_GGRNAM)
+               str_numset(str, (double)grent->gr_gid);
+           else
+               str_set(str, grent->gr_name);
+       }
+       return sp;
+    }
+
     if (grent) {
        (void)astore(ary, ++sp, str = str_mortal(&str_no));
        str_set(str, grent->gr_name);
@@ -2231,9 +2333,6 @@ int *arglast;
     register int sp = arglast[1];
     register STIO *stio;
     long along;
-#ifndef telldir
-    long telldir();
-#endif
 #ifndef apollo
     struct DIRENT *readdir();
 #endif
@@ -2278,30 +2377,36 @@ int *arglast;
 #endif
        }
        break;
-#if MACH
-    case O_TELLDIR:
-    case O_SEEKDIR:
-        goto nope;
-#else
-    case O_TELLDIR:
-       st[sp] = str_mortal(&str_undef);
-       str_numset(st[sp], (double)telldir(stio->dirp));
-       break;
+#if defined(HAS_TELLDIR) || defined(telldir)
+    case O_TELLDIR: {
+#ifndef telldir
+           long telldir();
+#endif
+           st[sp] = str_mortal(&str_undef);
+           str_numset(st[sp], (double)telldir(stio->dirp));
+           break;
+       }
+#endif
+#if defined(HAS_SEEKDIR) || defined(seekdir)
     case O_SEEKDIR:
        st[sp] = str_mortal(&str_undef);
        along = (long)str_gnum(st[sp+1]);
        (void)seekdir(stio->dirp,along);
        break;
 #endif
+#if defined(HAS_REWINDDIR) || defined(rewinddir)
     case O_REWINDDIR:
        st[sp] = str_mortal(&str_undef);
        (void)rewinddir(stio->dirp);
        break;
+#endif
     case O_CLOSEDIR:
        st[sp] = str_mortal(&str_undef);
        (void)closedir(stio->dirp);
        stio->dirp = 0;
        break;
+    default:
+       goto phooey;
     }
     return sp;
 
@@ -2311,11 +2416,12 @@ nope:
        errno = EBADF;
     return sp;
 
-#else
-    fatal("Unimplemented directory operation");
 #endif
+phooey:
+    fatal("Unimplemented directory operation");
 }
 
+int
 apply(type,arglast)
 int type;
 int *arglast;
@@ -2469,7 +2575,7 @@ int bit;
 int effective;
 register struct stat *statbufp;
 {
-#ifdef MSDOS
+#ifdef DOSISH
     /* [Comments and code from Len Reed]
      * MS-DOS "user" is similar to UNIX's "superuser," but can't write
      * to write-protected files.  The execute permission bit is set
@@ -2488,6 +2594,9 @@ register struct stat *statbufp;
      *         Sun's PC-NFS.]
      */
 
+     /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
+      * too so it will actually look into the files for magic numbers
+      */
      return (bit & statbufp->st_mode) ? TRUE : FALSE;
 
 #else /* ! MSDOS */
@@ -2658,7 +2767,7 @@ int *arglast;
     {
 #ifdef HAS_MSG
     case O_MSGCTL:
-       ret = msgctl(id, cmd, a);
+       ret = msgctl(id, cmd, (struct msqid_ds *)a);
        break;
 #endif
 #ifdef HAS_SEM
@@ -2668,7 +2777,7 @@ int *arglast;
 #endif
 #ifdef HAS_SHM
     case O_SHMCTL:
-       ret = shmctl(id, cmd, a);
+       ret = shmctl(id, cmd, (struct shmid_ds *)a);
        break;
 #endif
     }
@@ -2699,7 +2808,7 @@ int *arglast;
        return -1;
     }
     errno = 0;
-    return msgsnd(id, mbuf, msize, flags);
+    return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
 #else
     fatal("msgsnd not implemented");
 #endif
@@ -2728,7 +2837,7 @@ int *arglast;
        mbuf = str_get(mstr);
     }
     errno = 0;
-    ret = msgrcv(id, mbuf, msize, mtype, flags);
+    ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
     if (ret >= 0) {
        mstr->str_cur = sizeof(long)+ret;
        mstr->str_ptr[sizeof(long)+ret] = '\0';
@@ -2802,7 +2911,7 @@ int *arglast;
            STR_GROW(mstr, msize+1);
            mbuf = str_get(mstr);
        }
-       bcopy(shm + mpos, mbuf, msize);
+       Copy(shm + mpos, mbuf, msize, char);
        mstr->str_cur = msize;
        mstr->str_ptr[msize] = '\0';
     }
@@ -2811,9 +2920,9 @@ int *arglast;
 
        if ((n = mstr->str_cur) > msize)
            n = msize;
-       bcopy(mbuf, shm + mpos, n);
+       Copy(mbuf, shm + mpos, n, char);
        if (n < msize)
-           bzero(shm + mpos + n, msize - n);
+           memzero(shm + mpos + n, msize - n);
     }
     return shmdt(shm);
 #else
diff --git a/form.c b/form.c
index 701aa05..0eb0976 100644 (file)
--- a/form.c
+++ b/form.c
@@ -1,4 +1,4 @@
-/* $RCSfile: form.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:18:43 $
+/* $RCSfile: form.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 13:21:42 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       form.c,v $
+ * Revision 4.0.1.3  92/06/08  13:21:42  lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: form feed for formats is now specifiable via $^L
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * 
  * Revision 4.0.1.2  91/11/05  17:18:43  lwall
  * patch11: formats didn't fill their fields as well as they could
  * patch11: ^ fields chopped hyphens on line break
@@ -25,6 +30,8 @@
 
 /* Forms stuff */
 
+static int countlines();
+
 void
 form_parseargs(fcmd)
 register FCMD *fcmd;
@@ -80,6 +87,7 @@ if (newsize >= curlen) { \
     curlen = orec->o_len - 2; \
 }
 
+void
 format(orec,fcmd,sp)
 register struct outrec *orec;
 register FCMD *fcmd;
@@ -219,7 +227,7 @@ int sp;
                *d++ = ' ';
            }
            size = s - t;
-           (void)bcopy(t,d,size);
+           Copy(t,d,size,char);
            d += size;
            *s = tmpchar;
            if (fcmd->f_flags & FC_CHOP)
@@ -264,7 +272,7 @@ int sp;
                *d++ = ' ';
            }
            size = s - t;
-           (void)bcopy(t,d,size);
+           Copy(t,d,size,char);
            d += size;
            *s = tmpchar;
            if (fcmd->f_next && fcmd->f_next->f_pre[0] == '\n')
@@ -286,7 +294,7 @@ int sp;
            size = str_len(str);
            CHKLEN(size+1);
            orec->o_lines += countlines(s,size) - 1;
-           (void)bcopy(s,d,size);
+           Copy(s,d,size,char);
            d += size;
            if (size && s[size-1] != '\n') {
                *d++ = '\n';
@@ -325,6 +333,7 @@ int sp;
     *d++ = '\0';
 }
 
+static int
 countlines(s,size)
 register char *s;
 register int size;
@@ -338,6 +347,7 @@ register int size;
     return count;
 }
 
+void
 do_write(orec,stab,sp)
 struct outrec *orec;
 STAB *stab;
@@ -374,7 +384,7 @@ int sp;
            stio->top_stab = topstab;
        }
        if (stio->lines_left >= 0 && stio->page > 0)
-           (void)putc('\f',ofp);
+           fwrite(formfeed->str_ptr, formfeed->str_cur, 1, ofp);
        stio->lines_left = stio->page_len;
        stio->page++;
        format(&toprec,stab_form(stio->top_stab),sp);
diff --git a/h2ph.SH b/h2ph.SH
index 90fd41f..f6925db 100644 (file)
--- a/h2ph.SH
+++ b/h2ph.SH
@@ -19,6 +19,7 @@ echo "Extracting h2ph (with variable substitutions)"
 : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
 : Protect any dollar signs and backticks that you do not want interpreted
 : by putting a backslash in front.  You may delete these comments.
+rm -f h2ph
 $spitshell >h2ph <<!GROK!THIS!
 #!$bin/perl
 'di';
diff --git a/handy.h b/handy.h
index 62cef86..999473a 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -1,4 +1,4 @@
-/* $RCSfile: handy.h,v $$Revision: 4.0.1.3 $$Date: 91/11/05 22:54:26 $
+/* $RCSfile: handy.h,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:23:17 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       handy.h,v $
+ * Revision 4.0.1.4  92/06/08  13:23:17  lwall
+ * patch20: isascii() may now be supplied by a library routine
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * 
  * Revision 4.0.1.3  91/11/05  22:54:26  lwall
  * patch11: erratum
  * 
@@ -58,7 +62,7 @@
 #define strnNE(s1,s2,l) (strncmp(s1,s2,l))
 #define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
 
-#if defined(CTYPE256) || !defined(isascii)
+#if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII))
 #define isALNUM(c) (isalpha(c) || isdigit(c) || c == '_')
 #define isALPHA(c) isalpha(c)
 #define isSPACE(c) isspace(c)
@@ -74,8 +78,6 @@
 #define isLOWER(c) (isascii(c) && islower(c))
 #endif
 
-#define MEM_SIZE unsigned int
-
 /* Line numbers are unsigned, 16 bits. */
 typedef unsigned short line_t;
 #ifdef lint
@@ -95,14 +97,14 @@ void safefree();
 #define New(x,v,n,t)  (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
 #define Newc(x,v,n,t,c)  (v = (c*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
 #define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t)))), \
-    bzero((char*)(v), (n) * sizeof(t))
+    memzero((char*)(v), (n) * sizeof(t))
 #define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
 #define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
 #else
 #define New(x,v,n,t)  (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t))))
 #define Newc(x,v,n,t,c)  (v = (c*)safemalloc(((unsigned long)(n) * sizeof(t))))
 #define Newz(x,v,n,t) (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t)))), \
-    bzero((char*)(v), (n) * sizeof(t))
+    memzero((char*)(v), (n) * sizeof(t))
 #define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
 #define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
 #endif /* MSDOS */
@@ -115,7 +117,7 @@ void safexfree();
 #define New(x,v,n,t)  (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
 #define Newc(x,v,n,t,c)  (v = (c*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
 #define Newz(x,v,n,t) (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t)))), \
-    bzero((char*)(v), (n) * sizeof(t))
+    memzero((char*)(v), (n) * sizeof(t))
 #define Renew(v,n,t) (v = (t*)safexrealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
 #define Renewc(v,n,t,c) (v = (c*)safexrealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
 #define Safefree(d) safexfree((char*)d)
@@ -124,14 +126,22 @@ void safexfree();
 long xcount[MAXXCOUNT];
 long lastxcount[MAXXCOUNT];
 #endif /* LEAKTEST */
-#define Copy(s,d,n,t) (void)bcopy((char*)(s),(char*)(d), (n) * sizeof(t))
-#define Zero(d,n,t) (void)bzero((char*)(d), (n) * sizeof(t))
+#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
 #else /* lint */
 #define New(x,v,n,s) (v = Null(s *))
 #define Newc(x,v,n,s,c) (v = Null(s *))
 #define Newz(x,v,n,s) (v = Null(s *))
 #define Renew(v,n,s) (v = Null(s *))
+#define Move(s,d,n,t)
 #define Copy(s,d,n,t)
 #define Zero(d,n,t)
 #define Safefree(d) d = d
 #endif /* lint */
+
+#ifdef STRUCTCOPY
+#define StructCopy(s,d,t) *((t*)(d)) = *((t*)(s))
+#else
+#define StructCopy(s,d,t) Copy(s,d,1,t)
+#endif
diff --git a/hash.c b/hash.c
index 72c17f1..3cae533 100644 (file)
--- a/hash.c
+++ b/hash.c
@@ -1,4 +1,4 @@
-/* $RCSfile: hash.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:24:13 $
+/* $RCSfile: hash.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 13:26:29 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       hash.c,v $
+ * Revision 4.0.1.3  92/06/08  13:26:29  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: delete could cause %array to give too low a count of buckets filled
+ * patch20: hash tables now split only if the memory is available to do so
+ * 
  * Revision 4.0.1.2  91/11/05  17:24:13  lwall
  * patch11: saberized perl
  * 
@@ -20,6 +25,8 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+static void hsplit();
+
 static char coeff[] = {
                61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
                61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
@@ -247,10 +254,10 @@ unsigned int klen;
        if (bcmp(entry->hent_key,key,klen))     /* is this it? */
            continue;
        *oentry = entry->hent_next;
+       if (i && !*oentry)
+           tb->tbl_fill--;
        str = str_mortal(entry->hent_val);
        hentfree(entry);
-       if (i)
-           tb->tbl_fill--;
 #ifdef SOME_DBM
       do_dbm_delete:
        if (tb->tbl_dbm) {
@@ -273,6 +280,7 @@ unsigned int klen;
 #endif
 }
 
+static void
 hsplit(tb)
 HASH *tb;
 {
@@ -285,7 +293,13 @@ HASH *tb;
     register HENT **oentry;
 
     a = tb->tbl_array;
+    nomemok = TRUE;
     Renew(a, newsize, HENT*);
+    nomemok = FALSE;
+    if (!a) {
+       tb->tbl_dosplit = tb->tbl_max + 1;      /* never split again */
+       return;
+    }
     Zero(&a[oldsize], oldsize, HENT*);         /* zero 2nd half*/
     tb->tbl_max = --newsize;
     tb->tbl_dosplit = tb->tbl_max * FILLPCT / 100;
@@ -369,7 +383,7 @@ int dodbm;
     tb->tbl_fill = 0;
 #ifndef lint
     if (tb->tbl_array)
-       (void)bzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*));
+       (void)memzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*));
 #endif
 }
 
diff --git a/hints/hp9000_700.sh b/hints/hp9000_700.sh
new file mode 100644 (file)
index 0000000..5b15a89
--- /dev/null
@@ -0,0 +1,5 @@
+libswanted='ndbm m'
+ccflags="$ccflags -DJMPCLOBBER"
+optimize='+O1'
+d_mymalloc=define
+alignbytes=8
index b5f22ff..e1ab9d7 100644 (file)
@@ -1,2 +1,3 @@
 libswanted=`echo $libswanted | sed -e 's/malloc //' -e 's/BSD //`
-optimize='+O1'
+eval_cflags='optimize=+O1'
+teval_cflags=$eval_cflags
index cab5871..904f9de 100644 (file)
@@ -5,3 +5,4 @@ case `(uname -r) 2>/dev/null` in
 *3.1*) d_syscall=$undef ;;
 *2.1*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;;
 esac
+d_index=define
index 1582595..ff59108 100644 (file)
@@ -1,4 +1,4 @@
-set `echo $libswanted | sed -e 's/ x / /' -e 's/ PW / /' -e s/ malloc / /`
+set `echo $libswanted | sed -e 's/ x / /' -e 's/ PW / /' -e 's/ malloc / /'`
 libswanted="inet malloc $*"
 doio_cflags='ccflags="$ccflags -DENOTSOCK=103"'
 tdoio_cflags='ccflags="$ccflags -DENOTSOCK=103"'
diff --git a/hints/mc6000.sh b/hints/mc6000.sh
new file mode 100644 (file)
index 0000000..78c87c8
--- /dev/null
@@ -0,0 +1,5 @@
+# defaults for the masscomp (concurrent) 6000 series running RTU 5.0
+cppstdin=/lib/cpp
+cmd_cflags='optimize=""'
+tcmd_cflags='optimize=""'
+d_mymalloc=define
index 643317a..7f9d36e 100644 (file)
@@ -1,5 +1,7 @@
 #!./perl
 
+$mainperldir = "/usr/bin";
+
 while (@ARGV) {
     $nonono = 1 if $ARGV[0] eq '-n';
     $versiononly = 1 if $ARGV[0] eq '-v';
@@ -11,10 +13,6 @@ umask 022;
 @scripts = ('cppstdin', 'h2ph', 'c2ph', 'pstruct', 'x2p/s2p', 'x2p/find2perl');
 @manpages = ('perl.man', 'h2ph.man', 'x2p/a2p.man', 'x2p/s2p.man');
 
-$version = sprintf("%5.3f", $]);
-$release = substr($version,0,3);
-$patchlevel = substr($version,3,2);
-
 # Read in the config file.
 
 open(CONFIG, "config.sh") || die "You haven't run Configure yet!\n";
@@ -26,6 +24,19 @@ while (<CONFIG>) {
     }
     $accum .= $_;
 }
+close CONFIG;
+
+open(PERL_C, "perl.c");
+while (<PERL_C>) {
+    last if /Revision:/;
+}
+close PERL_C;
+s/.*Revision: //;
+$major = $_ + 0;
+
+$ver = sprintf("%5.3f", $major + $PATCHLEVEL / 1000);
+$release = substr($ver,0,3);
+$patchlevel = substr($ver,3,2);
 
 # Do some quick sanity checks.
 
@@ -45,8 +56,6 @@ if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
 
 # First we install the version-numbered executables.
 
-$ver = sprintf("%5.3f", $]);
-
 &unlink("$installbin/perl$ver");
 &cmd("cp perl $installbin/perl$ver");
 
@@ -80,17 +89,18 @@ if ($bdev != $ddev || $bino != $dino) {
 if ($bdev != $ddev || $bino != $dino) {
     &unlink("$installbin/a2p");
     &cmd("cp x2p/a2p $installbin/a2p");
+    &chmod(0755, "$installbin/a2p");
 }
 
 # Make some enemies in the name of standardization.   :-)
 
-($udev,$uino) = stat("/usr/bin");
+($udev,$uino) = stat($mainperldir);
 
-if (-w _ && ($udev != $ddev || $uino != $dino) && !$nonono) {
-    &unlink("/usr/bin/perl");
-    eval 'symlink("$installbin/perl", "/usr/bin/perl")' ||
-    eval 'link("$installbin/perl", "/usr/bin/perl")' ||
-    &cmd("cp $installbin/perl /usr/bin");
+if (-w _ && ($udev != $bdev || $uino != $bino) && !$nonono) {
+    &unlink("$mainperldir/perl");
+    eval 'link("$installbin/perl", "$mainperldir/perl")' ||
+    eval 'symlink("$installbin/perl", "$mainperldir/perl")' ||
+    &cmd("cp $installbin/perl $mainperldir");
 }
 
 # Install scripts.
@@ -114,8 +124,8 @@ if ($mansrc ne '') {
            $new =~ s#.*/##;
            print STDERR "  Installing $mansrc/$new\n";
            next if $nonono;
-           open(MI,$_);
-           open(MO,">$mansrc/$new");
+           open(MI,$_) || warn "Can't open $_: $!\n";
+           open(MO,">$mansrc/$new") || warn "Can't install $mansrc/$new: $!\n";
            print MO ".ds RP Release $release Patchlevel $patchlevel\n";
            while (<MI>) {
                print MO;
index 63214ef..e55d2b7 100644 (file)
@@ -13,11 +13,15 @@ case "$0" in
 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
 esac
 echo "Extracting makedir (with variable substitutions)"
+rm -f makedir
 $spitshell >makedir <<!GROK!THIS!
 $startsh
-# $Header: makedir.SH,v 4.0 91/03/20 01:27:13 lwall Locked $
+# $RCSfile: makedir.SH,v $$Revision: 4.0.1.1 $$Date: 92/06/08 14:24:55 $
 # 
 # $Log:        makedir.SH,v $
+# Revision 4.0.1.1  92/06/08  14:24:55  lwall
+# patch20: SH files didn't work well with symbolic links
+# 
 # Revision 4.0  91/03/20  01:27:13  lwall
 # 4.0 baseline.
 # 
index b87251a..75b0084 100644 (file)
@@ -1,18 +1,21 @@
 /*
  * Globbing for OS/2.  Relies on the expansion done by the library
- * startup code. (dds)
+ * startup code.
  */
 
-#include <stdio.h>
-#include <string.h>
+#define PERLGLOB
+#include "director.c"
 
-main(int argc, char *argv[])
+int main(int argc, char **argv)
 {
-  register i;
+  SHORT i;
+  USHORT r;
+  CHAR *f;
 
   for (i = 1; i < argc; i++)
   {
-    fputs(IsFileSystemFAT(argv[i]) ? strlwr(argv[i]) : argv[i], stdout);
-    putchar(0);
+    f = IsFileSystemFAT(argv[i]) ? strlwr(argv[i]) : argv[i];
+    DosWrite(1, f, strlen(f) + 1, &r);
   }
+  return argc - 1;
 }
index 10c8c21..9705476 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 25
+#define PATCHLEVEL 26
index b76d44d..29bf797 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: goto.t,v 4.0 91/03/20 01:52:52 lwall Locked $
+# $RCSfile: goto.t,v $$Revision: 4.0.1.1 $$Date: 92/06/08 15:43:25 $
 
 print "1..3\n";
 
@@ -30,5 +30,4 @@ print "#2\t:$foo: == 4\n";
 if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
 
 $x = `./perl -e 'goto foo;' 2>&1`;
-print "#3\t/label/ in :$x";
 if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}