perl 4.0 patch 19: (combined patch)
Larry Wall [Mon, 11 Nov 1991 03:50:16 +0000 (03:50 +0000)]
Ok, here's the cleanup patch I suggested you wait for.  Have at it...

Subject: added little-endian pack/unpack options

This is the only enhancement in this patch, but it seemed unlikely
to bust anything else, and added functionality that it was very
difficult to do any other way.  Compliments of David W. Sanderson.

Subject: op/regexp.t failed from missing arg to bcmp()
Subject: study was busted by 4.018
Subject: sort $subname was busted by changes in 4.018
Subject: default arg for shift was wrong after first subroutine definition

Things that broke in 4.018.  Shame on me.

Subject: do {$foo ne "bar";} returned wrong value

A bug of long standing.  How come nobody saw this one?  Or if you
did, why didn't you report it before now?  Or if you did, why did
I ignore you?  :-)

Subject: some machines need -lsocket before -lnsl
Subject: some earlier patches weren't propagated to alternate 286 code
Subject: compile in the x2p directory couldn't find cppstdin
Subject: more hints for aix, isc, hp, sco, uts
Subject: installperl no longer updates unchanged library files
Subject: uts wrongly defines S_ISDIR() et al
Subject: too many preprocessors can't expand a macro right in #if

The usual pastiche of portability kludges.

Subject: deleted some unused functions from usersub.c

And fixed the spelling of John Macdonald's name, and included his
suggested workaround for a certain vendor's stdio bug...

Subject: added readdir test
Subject: made op/groups.t more reliable
Subject: added test for sort $subname to op/sort.t
Subject: added some hacks to op/stat.t for weird filesystem architectures

Improvements (hopefully) to the regression tests.

23 files changed:
Configure
MANIFEST
cmd.c
doSH
doarg.c
dolist.c
hints/aix_rs.sh
hints/hp9000_800.sh
hints/isc_3_2_2.sh [new file with mode: 0644]
hints/sco_3.sh
hints/uts.sh
installperl
patchlevel.h
perl.c
perl.h
perl.man
t/op/groups.t
t/op/readdir.t [new file with mode: 0644]
t/op/sort.t
t/op/stat.t
toke.c
usersub.c
util.c

index aba4247..a777a14 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -8,7 +8,7 @@
 # and edit it to reflect your system.  Some packages may include samples
 # of config.h for certain machines, so you might look for one of those.)
 #
-# $RCSfile: Configure,v $$Revision: 4.0.1.5 $$Date: 91/11/05 23:11:32 $
+# $RCSfile: Configure,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:26:51 $
 #
 # Yes, you may rip this off to use in other distribution packages.
 # (Note: this Configure script was generated automatically.  Rather than
@@ -354,7 +354,7 @@ serve_unix_tcp=""
 d_ndir=ndir
 voidwant=1
 voidwant=7
-libswanted="c_s net_s net nsl_s nsl socket nm ndir ndbm dbm PW malloc sun m bsd BSD x posix ucb"
+libswanted="c_s net_s net socket nsl_s nsl nm ndir ndbm dbm PW malloc sun m bsd BSD x posix ucb"
 inclwanted='/usr/include /usr/netinclude /usr/include/sun /usr/include/bsd /usr/include/lan /usr/ucbinclude'
 
 : Now test for existence of everything in MANIFEST
@@ -596,7 +596,9 @@ bison
 cpp
 csh
 egrep
+line
 nroff
+perl
 test
 uname
 yacc
@@ -2292,7 +2294,7 @@ eval $inlibc
 : index or strcpy
 echo " "
 case "$d_index" in
-n) dflt=n;;
+undef) dflt=n;;
 *)  if $test -f /unix; then
        dflt=n
     else
@@ -2377,6 +2379,66 @@ fi
 set d_msg
 eval $setvar
 
+: determine which malloc to compile in
+echo " "
+case "$d_mymalloc" in
+'')
+    case "$usemymalloc" in
+    '')
+       if bsd || v7; then
+           dflt='y'
+       else
+           dflt='n'
+       fi
+       ;;
+    n*) dflt=n;;
+    *)  dflt=y;;
+    esac
+    ;;
+define)  dflt="y"
+    ;;
+*)  dflt="n"
+    ;;
+esac
+rp="Do you wish to attempt to use the malloc that comes with $package? [$dflt]"
+$echo $n "$rp $c"
+. myread
+case "$ans" in
+'') ans=$dflt;;
+esac
+case "$ans" in
+y*) mallocsrc='malloc.c'; mallocobj='malloc.o'
+    libs=`echo $libs | sed 's/-lmalloc//'`
+    val="$define"
+    case "$mallocptrtype" in
+    '')
+       cat >usemymalloc.c <<'END'
+#ifdef __STDC__
+#include <stdlib.h>
+#else
+#include <malloc.h>
+#endif
+void *malloc();
+END
+       if $cc $ccflags -c usemymalloc.c >/dev/null 2>&1; then
+           mallocptrtype=void
+       else
+           mallocptrtype=char
+       fi
+       ;;
+    esac
+    echo " "
+    echo "Your system wants malloc to return $mallocptrtype*, it would seem."
+    ;;
+*)  mallocsrc='';
+    mallocobj='';
+    mallocptrtype=void
+    val="$define"
+    ;;
+esac
+set d_mymalloc
+eval $setvar
+
 : see if ndbm is available
 echo " "
 xxx=`./loc ndbm.h x $usrinclude /usr/local/include $inclwanted`
@@ -3053,66 +3115,6 @@ $echo $n "$rp $c"
 . myread
 intsize="$ans"
 
-: determine which malloc to compile in
-echo " "
-case "$d_mymalloc" in
-'')
-    case "$usemymalloc" in
-    '')
-       if bsd || v7; then
-           dflt='y'
-       else
-           dflt='n'
-       fi
-       ;;
-    n*) dflt=n;;
-    *)  dflt=y;;
-    esac
-    ;;
-define)  dflt="y"
-    ;;
-*)  dflt="n"
-    ;;
-esac
-rp="Do you wish to attempt to use the malloc that comes with $package? [$dflt]"
-$echo $n "$rp $c"
-. myread
-case "$ans" in
-'') ans=$dflt;;
-esac
-case "$ans" in
-y*) mallocsrc='malloc.c'; mallocobj='malloc.o'
-    libs=`echo $libs | sed 's/-lmalloc//'`
-    val="$define"
-    case "$mallocptrtype" in
-    '')
-       cat >usemymalloc.c <<'END'
-#ifdef __STDC__
-#include <stdlib.h>
-#else
-#include <malloc.h>
-#endif
-void *malloc();
-END
-       if $cc $ccflags -c usemymalloc.c >/dev/null 2>&1; then
-           mallocptrtype=void
-       else
-           mallocptrtype=char
-       fi
-       ;;
-    esac
-    echo " "
-    echo "Your system wants malloc to return $mallocptrtype*, it would seem."
-    ;;
-*)  mallocsrc='';
-    mallocobj='';
-    mallocptrtype=void
-    val="$define"
-    ;;
-esac
-set d_mymalloc
-eval $setvar
-
 : determine where private executables go
 case "$privlib" in
 '')
index ca59619..0adfbf5 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -109,6 +109,7 @@ hints/hp9000_400.sh
 hints/hp9000_800.sh    
 hints/hpux.sh
 hints/i386.sh
+hints/isc_3_2_2.sh
 hints/mips.sh
 hints/mpc.sh   
 hints/ncr_tower.sh
@@ -287,6 +288,7 @@ t/op/push.t         See if push and pop work
 t/op/range.t           See if .. works
 t/op/re_tests          Input file for op.regexp
 t/op/read.t            See if read() works
+t/op/readdir.t         See if readdir() works
 t/op/regexp.t          See if regular expressions work
 t/op/repeat.t          See if x operator works
 t/op/s.t               See if substitutions work
diff --git a/cmd.c b/cmd.c
index 2509509..0e51f22 100644 (file)
--- a/cmd.c
+++ b/cmd.c
@@ -1,4 +1,4 @@
-/* $RCSfile: cmd.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:07:43 $
+/* $RCSfile: cmd.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:29:33 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       cmd.c,v $
+ * Revision 4.0.1.4  91/11/11  16:29:33  lwall
+ * patch19: do {$foo ne "bar";} returned wrong value
+ * patch19: some earlier patches weren't propagated to alternate 286 code
+ * 
  * Revision 4.0.1.3  91/11/05  16:07:43  lwall
  * patch11: random cleanup
  * patch11: "foo\0" eq "foo" was sometimes optimized to true
@@ -367,26 +371,31 @@ until_loop:
                    if (cmd->c_spat)
                        lastspat = cmd->c_spat;
                    match = !(cmdflags & CF_FIRSTNEG);
-                   retstr = &str_yes;
+                   retstr = match ? &str_yes : &str_no;
                    goto flipmaybe;
                }
            }
            else if (cmdflags & CF_NESURE) {
                match = cmdflags & CF_FIRSTNEG;
-               retstr = &str_no;
+               retstr = match ? &str_yes : &str_no;
                goto flipmaybe;
            }
 #else
            {
                char *zap1, *zap2, zap1c, zap2c;
                int  zaplen;
+               int lenok;
 
                zap1 = cmd->c_short->str_ptr;
                zap2 = str_get(retstr);
                zap1c = *zap1;
                zap2c = *zap2;
                zaplen = cmd->c_slen;
-               if ((zap1c == zap2c) && (bcmp(zap1, zap2, zaplen) == 0)) {
+               if (match)
+                   lenok = (retstr->str_cur == cmd->c_slen - 1);
+               else
+                   lenok = (retstr->str_cur >= cmd->c_slen);
+               if ((zap1c == zap2c) && lenok && (bcmp(zap1, zap2, zaplen) == 0)) {
                    if (cmdflags & CF_EQSURE) {
                        if (sawampersand &&
                          (cmdflags & CF_OPTIMIZE) != CFT_STROP) {
@@ -403,13 +412,13 @@ until_loop:
                        if (cmd->c_spat)
                            lastspat = cmd->c_spat;
                        match = !(cmdflags & CF_FIRSTNEG);
-                       retstr = &str_yes;
+                       retstr = match ? &str_yes : &str_no;
                        goto flipmaybe;
                    }
                }
                else if (cmdflags & CF_NESURE) {
                    match = cmdflags & CF_FIRSTNEG;
-                   retstr = &str_no;
+                   retstr = match ? &str_yes : &str_no;
                    goto flipmaybe;
                }
            }
@@ -451,7 +460,7 @@ until_loop:
                    }
                    lastspat = cmd->c_spat;
                    match = !(cmdflags & CF_FIRSTNEG);
-                   retstr = &str_yes;
+                   retstr = match ? &str_yes : &str_no;
                    goto flipmaybe;
                }
                else
@@ -461,7 +470,7 @@ until_loop:
                if (cmdflags & CF_NESURE) {
                    ++cmd->c_short->str_u.str_useful;
                    match = cmdflags & CF_FIRSTNEG;
-                   retstr = &str_no;
+                   retstr = match ? &str_yes : &str_no;
                    goto flipmaybe;
                }
            }
diff --git a/doSH b/doSH
index ec3a1fc..43fd322 100644 (file)
--- a/doSH
+++ b/doSH
@@ -4,6 +4,7 @@
 . ./config.sh
 
 rm -f x2p/config.sh
+cp cppstdin x2p
 
 echo " "
 echo "Doing variable substitutions on .SH files..."
diff --git a/doarg.c b/doarg.c
index 9785d46..c40bf68 100644 (file)
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $RCSfile: doarg.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:35:06 $
+/* $RCSfile: doarg.c,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:31:58 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       doarg.c,v $
+ * Revision 4.0.1.5  91/11/11  16:31:58  lwall
+ * patch19: added little-endian pack/unpack options
+ * 
  * Revision 4.0.1.4  91/11/05  16:35:06  lwall
  * patch11: /$foo/o optimizer could access deallocated data
  * patch11: minimum match length calculation in regexp is now cumulative
@@ -661,6 +664,16 @@ int *arglast;
                str_ncat(str,(char*)&ashort,sizeof(short));
            }
            break;
+       case 'v':
+           while (len-- > 0) {
+               fromstr = NEXTFROM;
+               ashort = (short)str_gnum(fromstr);
+#ifdef HAS_HTOVS
+               ashort = htovs(ashort);
+#endif
+               str_ncat(str,(char*)&ashort,sizeof(short));
+           }
+           break;
        case 'S':
        case 's':
            while (len-- > 0) {
@@ -693,6 +706,16 @@ int *arglast;
                str_ncat(str,(char*)&aulong,sizeof(unsigned long));
            }
            break;
+       case 'V':
+           while (len-- > 0) {
+               fromstr = NEXTFROM;
+               aulong = U_L(str_gnum(fromstr));
+#ifdef HAS_HTOVL
+               aulong = htovl(aulong);
+#endif
+               str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+           }
+           break;
        case 'L':
            while (len-- > 0) {
                fromstr = NEXTFROM;
index 345c5ac..a452e8e 100644 (file)
--- a/dolist.c
+++ b/dolist.c
@@ -1,4 +1,4 @@
-/* $RCSfile: dolist.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:07:02 $
+/* $RCSfile: dolist.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:33:19 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       dolist.c,v $
+ * Revision 4.0.1.4  91/11/11  16:33:19  lwall
+ * patch19: added little-endian pack/unpack options
+ * patch19: sort $subname was busted by changes in 4.018
+ * 
  * Revision 4.0.1.3  91/11/05  17:07:02  lwall
  * patch11: prepared for ctype implementations that don't define isascii()
  * patch11: /$foo/o optimizer could access deallocated data
@@ -786,6 +790,7 @@ int *arglast;
                }
            }
            break;
+       case 'v':
        case 'n':
        case 'S':
            along = (strend - s) / sizeof(unsigned short);
@@ -799,6 +804,10 @@ int *arglast;
                    if (datumtype == 'n')
                        aushort = ntohs(aushort);
 #endif
+#ifdef HAS_VTOHS
+                   if (datumtype == 'v')
+                       aushort = vtohs(aushort);
+#endif
                    culong += aushort;
                }
            }
@@ -811,6 +820,10 @@ int *arglast;
                    if (datumtype == 'n')
                        aushort = ntohs(aushort);
 #endif
+#ifdef HAS_VTOHS
+                   if (datumtype == 'v')
+                       aushort = vtohs(aushort);
+#endif
                    str_numset(str,(double)aushort);
                    (void)astore(stack, ++sp, str_2mortal(str));
                }
@@ -888,6 +901,7 @@ int *arglast;
                }
            }
            break;
+       case 'V':
        case 'N':
        case 'L':
            along = (strend - s) / sizeof(unsigned long);
@@ -901,6 +915,10 @@ int *arglast;
                    if (datumtype == 'N')
                        aulong = ntohl(aulong);
 #endif
+#ifdef HAS_VTOHL
+                   if (datumtype == 'V')
+                       aulong = vtohl(aulong);
+#endif
                    if (checksum > 32)
                        cdouble += (double)aulong;
                    else
@@ -916,6 +934,10 @@ int *arglast;
                    if (datumtype == 'N')
                        aulong = ntohl(aulong);
 #endif
+#ifdef HAS_VTOHL
+                   if (datumtype == 'V')
+                       aulong = vtohl(aulong);
+#endif
                    str_numset(str,(double)aulong);
                    (void)astore(stack, ++sp, str_2mortal(str));
                }
@@ -1480,6 +1502,7 @@ int *arglast;
     STR *oldsecond;
     ARRAY *oldstack;
     HASH *stash;
+    STR *sortsubvar;
     static ARRAY *sortstack = Null(ARRAY*);
 
     if (gimme != G_ARRAY) {
@@ -1489,6 +1512,7 @@ int *arglast;
        return sp;
     }
     up = &st[sp];
+    sortsubvar = *up;
     st += sp;          /* temporarily make st point to args */
     for (i = 1; i <= max; i++) {
        /*SUPPRESS 560*/
@@ -1514,7 +1538,7 @@ int *arglast;
            if ((arg[1].arg_type & A_MASK) == A_WORD)
                stab = arg[1].arg_ptr.arg_stab;
            else
-               stab = stabent(str_get(st[sp+1]),TRUE);
+               stab = stabent(str_get(sortsubvar),TRUE);
 
            if (stab) {
                if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
index 17b22a1..9b845a7 100644 (file)
@@ -1,5 +1,7 @@
-eval_cflags='optimize="-g"'
-toke_cflags='optimize="-g"'
-teval_cflags='optimize="-g"'
-ttoke_cflags='optimize="-g"';
+eval_cflags='optimize=""'
+toke_cflags='optimize=""'
+teval_cflags='optimize=""'
+ttoke_cflags='optimize=""'
 ccflags="$ccflags -D_NO_PROTO"
+cppstdin='/lib/cpp -D_AIX -D_IBMR2'
+cppminus=''
index c2c41d3..b5f22ff 100644 (file)
@@ -1 +1,2 @@
-libswanted=`echo $libswanted | sed 's/malloc //'`
+libswanted=`echo $libswanted | sed -e 's/malloc //' -e 's/BSD //`
+optimize='+O1'
diff --git a/hints/isc_3_2_2.sh b/hints/isc_3_2_2.sh
new file mode 100644 (file)
index 0000000..1582595
--- /dev/null
@@ -0,0 +1,7 @@
+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"'
+echo "<net/errno.h> defines error numbers for network calls, but"
+echo "the definitions for ENAMETOOLONG and ENOTEMPTY conflict with"
+echo "those in <sys/errno.h>.  Instead just define ENOTSOCK here."
index a151fe0..1bb8fb1 100644 (file)
@@ -1,4 +1,7 @@
 yacc='/usr/bin/yacc -Sm11000'
 libswanted=`echo $libswanted | sed 's/ x / /'`
-i_varargs=undef
 ccflags="$ccflags -U M_XENIX"
+cppstdin='/lib/cpp -Di386 -DM_I386 -Dunix -DM_UNIX -DM_INTERNAT -DLAI_TCP'
+cppminus=''
+i_varargs=undef
+d_rename='undef'
index c31733c..c4d94c4 100644 (file)
@@ -1,2 +1,2 @@
-ccflags="$ccflags -DCRIPPLED_CC -g"
-d_lstat=$undef
+ccflags="$ccflags -DCRIPPLED_CC"
+d_lstat=$define
index e05e75c..643317a 100644 (file)
@@ -136,8 +136,11 @@ if (chdir "lib") {
 
     if ($pdev != $ldev || $pino != $lino) {
        foreach $file (<*.pl>) {
-           &unlink("$installprivlib/$file");
-           &cmd("cp $file $installprivlib");
+           system "cmp", "-s", $file, "$privlib/$file";
+           if ($?) {
+               &unlink("$installprivlib/$file");
+               &cmd("cp $file $installprivlib");
+           }
        }
     }
     chdir ".." || die "Can't cd back to source directory: $!\n";
index 1af605e..111b8fe 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 18
+#define PATCHLEVEL 19
diff --git a/perl.c b/perl.c
index 67b88eb..f93095d 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.5 $$Date: 91/11/05 18:03:32 $\nPatch level: ###\n";
+char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.6 $$Date: 91/11/11 16:38:45 $\nPatch level: ###\n";
 /*
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@ char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.5 $$Date: 91/11/05 18:03:32
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       perl.c,v $
+ * Revision 4.0.1.6  91/11/11  16:38:45  lwall
+ * patch19: default arg for shift was wrong after first subroutine definition
+ * patch19: op/regexp.t failed from missing arg to bcmp()
+ * 
  * Revision 4.0.1.5  91/11/05  18:03:32  lwall
  * patch11: random cleanup
  * patch11: $0 was being truncated at times
@@ -634,6 +638,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 
     defstab = stabent("_",TRUE);
 
+    subname = str_make("main",4);
     if (perldb) {
        debstash = hnew(0);
        stab_xhash(stabent("_DB",TRUE)) = debstash;
@@ -641,7 +646,6 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
        dbargs = stab_xarray(aadd((tmpstab = stabent("args",TRUE))));
        tmpstab->str_pok |= SP_MULTI;
        dbargs->ary_flags = 0;
-       subname = str_make("main",4);
        DBstab = stabent("DB",TRUE);
        DBstab->str_pok |= SP_MULTI;
        DBline = stabent("dbline",TRUE);
@@ -1030,7 +1034,7 @@ int *arglast;
            retval |= error_count;
        }
        else if (last_root && last_elen == bufend - bufptr
-         && *bufptr == *last_eval && !bcmp(bufptr,last_eval)){
+         && *bufptr == *last_eval && !bcmp(bufptr,last_eval,last_elen)){
            retval = 0;
            eval_root = last_root;      /* no point in reparsing */
        }
diff --git a/perl.h b/perl.h
index 09edd07..c9064b1 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $RCSfile: perl.h,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:06:10 $
+/* $RCSfile: perl.h,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:41:07 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       perl.h,v $
+ * Revision 4.0.1.5  91/11/11  16:41:07  lwall
+ * patch19: uts wrongly defines S_ISDIR() et al
+ * patch19: too many preprocessors can't expand a macro right in #if
+ * patch19: added little-endian pack/unpack options
+ * 
  * Revision 4.0.1.4  91/11/05  18:06:10  lwall
  * patch11: various portability fixes
  * patch11: added support for dbz
@@ -165,6 +170,20 @@ extern int memcmp();
 #endif
 
 #include <sys/stat.h>
+#ifdef uts
+#undef S_ISDIR
+#undef S_ISCHR
+#undef S_ISBLK
+#undef S_ISREG
+#undef S_ISFIFO
+#undef S_ISLNK
+#define S_ISDIR(P) (((P)&S_IFMT)==S_IFDIR)
+#define S_ISCHR(P) (((P)&S_IFMT)==S_IFCHR)
+#define S_ISBLK(P) (((P)&S_IFMT)==S_IFBLK)
+#define S_ISREG(P) (((P)&S_IFMT)==S_IFREG)
+#define S_ISFIFO(P) (((P)&S_IFMT)==S_IFIFO)
+#define S_ISLNK(P) (((P)&S_IFMT)==S_IFLNK)
+#endif
 
 #ifdef I_TIME
 #   include <time.h>
@@ -344,10 +363,6 @@ EXT int dbmlen;
 #   endif
 #endif
 
-#if S_ISBLK(060000) == 060000
-       XXX Your sys/stat.h appears to be buggy.  Please fix it.
-#endif
-
 #ifndef S_ISREG
 #   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
 #endif
@@ -426,7 +441,7 @@ EXT int dbmlen;
 #   define SLOPPYDIVIDE
 #endif
 
-#if defined(cray) || defined(convex) || BYTEORDER > 0xffff
+#if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff
 #   define QUAD
 #endif
 
@@ -434,7 +449,7 @@ EXT int dbmlen;
 #   ifdef cray
 #      define quad int
 #   else
-#      ifdef convex
+#      if defined(convex) || defined (uts)
 #          define quad long long
 #      else
 #          define quad long
@@ -585,6 +600,27 @@ EXT STR *Str;
 #endif
 #endif
 
+/*
+ * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
+ * -DWS
+ */
+#if BYTEORDER != 0x1234
+# define HAS_VTOHL
+# define HAS_VTOHS
+# define HAS_HTOVL
+# define HAS_HTOVS
+# if BYTEORDER == 0x4321
+#  define vtohl(x)     ((((x)&0xFF)<<24)       \
+                       +(((x)>>24)&0xFF)       \
+                       +(((x)&0x0000FF00)<<8)  \
+                       +(((x)&0x00FF0000)>>8)  )
+#  define vtohs(x)     ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
+#  define htovl(x)     vtohl(x)
+#  define htovs(x)     vtohs(x)
+# endif
+       /* otherwise default to functions in util.c */
+#endif
+
 #ifdef CASTNEGFLOAT
 #define U_S(what) ((unsigned short)(what))
 #define U_I(what) ((unsigned int)(what))
index d3d6d5b..4ffb76e 100644 (file)
--- a/perl.man
+++ b/perl.man
@@ -1,7 +1,10 @@
 .rn '' }`
-''' $RCSfile: perl.man,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:11:05 $
+''' $RCSfile: perl.man,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:42:00 $
 ''' 
 ''' $Log:      perl.man,v $
+''' Revision 4.0.1.5  91/11/11  16:42:00  lwall
+''' patch19: added little-endian pack/unpack options
+''' 
 ''' Revision 4.0.1.4  91/11/05  18:11:05  lwall
 ''' patch11: added sort {} LIST
 ''' patch11: added eval {}
@@ -2014,7 +2017,7 @@ operators:
        if (defined &$var) { &$var($parm); undef &$var; }
 
 .fi
-:Ip "do EXPR" 8 3
+.Ip "do EXPR" 8 3
 Uses the value of EXPR as a filename and executes the contents of the file
 as a
 .I perl
@@ -3071,6 +3074,8 @@ of values, as follows:
        f       A single-precision float in the native format.
        d       A double-precision float in the native format.
        p       A pointer to a string.
+       v       A short in \*(L"VAX\*(R" (little-endian) order.
+       V       A long in \*(L"VAX\*(R" (little-endian) order.
        x       A null byte.
        X       Back up a byte.
        @       Null fill to absolute position.
@@ -5893,7 +5898,10 @@ All of the $^X variables are new except for $^T.
 The default top-of-form format for FILEHANDLE is now FILEHANDLE_TOP rather
 than top.
 .PP
-The eval {} and sort {} constructs were added in version 4.011.
+The eval {} and sort {} constructs were added in version 4.018.
+.PP
+The v and V (little-endian) template options for pack and unpack were
+added in 4.019.
 .SH BUGS
 .PP
 .I Perl
index f8cb4ca..e1520cc 100644 (file)
@@ -5,7 +5,13 @@ if (! -x '/usr/ucb/groups') {
     exit 0;
 }
 
-print "1..1\n";
+print "1..2\n";
+
+$pwgid = $( + 0;
+($pwgnam) = getgrgid($pwgid);
+@basegroup{$pwgid,$pwgnam} = (1,1);
+
+$seen{$pwgid}++;
 
 for (split(' ', $()) {
     next if $seen{$_}++;
@@ -17,8 +23,25 @@ for (split(' ', $()) {
        push(@gr, $_);
     }
 } 
-$gr1 = join(' ',sort @gr);
-$gr2 = join(' ', sort split(' ',`/usr/ucb/groups`));
-#print "gr1 is <$gr1>\n";
-#print "gr2 is <$gr2>\n";
-print +($gr1 eq $gr2) ? "ok 1\n" : "not ok 1\n";
+
+$gr1 = join(' ', sort @gr);
+
+$gr2 = join(' ', grep(!$basegroup{$_}, sort split(' ',`/usr/ucb/groups`)));
+
+if ($gr1 eq $gr2) {
+    print "ok 1\n";
+}
+else {
+    print "#gr1 is <$gr1>\n";
+    print "#gr2 is <$gr2>\n";
+    print "not ok 1\n";
+}
+
+# multiple 0's indicate GROUPSTYPE is currently long but should be short
+
+if ($pwgid == 0 || $seen{0} < 2) {
+    print "ok 2\n";
+}
+else {
+    print "not ok 2 (groupstype should be type short, not long)\n";
+}
diff --git a/t/op/readdir.t b/t/op/readdir.t
new file mode 100644 (file)
index 0000000..8125bd4
--- /dev/null
@@ -0,0 +1,20 @@
+#!./perl
+
+eval 'opendir(NOSUCH, "no/such/directory");';
+if ($@) { print "1..0\n"; exit; }
+
+print "1..3\n";
+
+if (opendir(OP, "op")) { print "ok 1\n"; } else { print "not ok 1\n"; }
+@D = grep(/^[^\.]/, readdir(OP));
+closedir(OP);
+
+if (@D > 20 && @D < 100) { print "ok 2\n"; } else { print "not ok 2\n"; }
+
+@R = sort @D;
+@G = <op/*>;
+while (@R && @G && "op/".$R[0] eq $G[0]) {
+       shift(@R);
+       shift(@G);
+}
+if (@R == 0 && @G == 0) { print "ok 3\n"; } else { print "not ok 3\n"; }
index 73a3944..658a5bd 100644 (file)
@@ -1,8 +1,8 @@
 #!./perl
 
-# $RCSfile: sort.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:43:47 $
+# $RCSfile: sort.t,v $$Revision: 4.0.1.2 $$Date: 91/11/11 16:43:47 $
 
-print "1..9\n";
+print "1..10\n";
 
 sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; }
 
@@ -41,3 +41,8 @@ print ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n");
 @a = (10,2,3,4);
 @b = sort {$a <=> $b;} @a;
 print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
+
+$sub = 'reverse';
+$x = join('', sort $sub @harry);
+print ($x eq 'xdogcatCainAbel' ? "ok 10\n" : "not ok 10\n");
+
index 1d1b22c..78b97dc 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-# $RCSfile: stat.t,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:44:44 $
+# $RCSfile: stat.t,v $$Revision: 4.0.1.3 $$Date: 91/11/11 16:44:49 $
 
 print "1..56\n";
 
@@ -11,6 +11,8 @@ $DEV = `ls -l /dev`;
 unlink "Op.stat.tmp";
 open(FOO, ">Op.stat.tmp");
 
+$junk = `ls Op.stat.tmp`;      # hack to make Apollo update link count
+
 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
     $blksize,$blocks) = stat(FOO);
 if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
@@ -35,7 +37,8 @@ else {
 }
 print "#4      :$mtime: != :$ctime:\n";
 
-`cp /dev/null Op.stat.tmp`;
+`rm -f Op.stat.tmp`;
+`touch Op.stat.tmp`;
 
 if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
 if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
diff --git a/toke.c b/toke.c
index 14ce7f6..4858c2c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $RCSfile: toke.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 19:02:48 $
+/* $RCSfile: toke.c,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:45:51 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       toke.c,v $
+ * Revision 4.0.1.5  91/11/11  16:45:51  lwall
+ * patch19: default arg for shift was wrong after first subroutine definition
+ * 
  * Revision 4.0.1.4  91/11/05  19:02:48  lwall
  * patch11: \x and \c were subject to double interpretation in regexps
  * patch11: prepared for ctype implementations that don't define isascii()
@@ -1198,29 +1201,25 @@ yylex()
                FUN2x(O_SUBSTR);
            if (strEQ(d,"sub")) {
                yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
-               if (perldb) {
-                   savelong(&subline);
-                   saveitem(subname);
-               }
+               savelong(&subline);
+               saveitem(subname);
 
                subline = curcmd->c_line;
                d = bufend;
                while (s < d && isSPACE(*s))
                    s++;
                if (isALPHA(*s) || *s == '_' || *s == '\'') {
-                   if (perldb) {
-                       str_sset(subname,curstname);
-                       str_ncat(subname,"'",1);
-                       for (d = s+1; isALNUM(*d) || *d == '\''; d++)
-                           /*SUPPRESS 530*/
-                           ;
-                       if (d[-1] == '\'')
-                           d--;
-                       str_ncat(subname,s,d-s);
-                   }
+                   str_sset(subname,curstname);
+                   str_ncat(subname,"'",1);
+                   for (d = s+1; isALNUM(*d) || *d == '\''; d++)
+                       /*SUPPRESS 530*/
+                       ;
+                   if (d[-1] == '\'')
+                       d--;
+                   str_ncat(subname,s,d-s);
                    *(--s) = '\\';      /* force next ident to WORD */
                }
-               else if (perldb)
+               else
                    str_set(subname,"?");
                OPERATOR(SUB);
            }
index 4e55fbf..d622ab2 100644 (file)
--- a/usersub.c
+++ b/usersub.c
@@ -1,10 +1,13 @@
-/* $Header: usersub.c,v 4.0 91/03/20 01:55:56 lwall Locked $
+/* $RCSfile: usersub.c,v $$Revision: 4.0.1.1 $$Date: 91/11/11 16:47:17 $
  *
  *  This file contains stubs for routines that the user may define to
  *  set up glue routines for C libraries or to decrypt encrypted scripts
  *  for execution.
  *
  * $Log:       usersub.c,v $
+ * Revision 4.0.1.1  91/11/11  16:47:17  lwall
+ * patch19: deleted some unused functions from usersub.c
+ * 
  * Revision 4.0  91/03/20  01:55:56  lwall
  * 4.0 baseline.
  * 
@@ -19,7 +22,7 @@ userinit()
 }
 
 /*
- * The following is supplied by John MacDonald as a means of decrypting
+ * The following is supplied by John Macdonald as a means of decrypting
  * and executing (presumably proprietary) scripts that have been encrypted
  * by a (presumably secret) method.  The idea is that you supply your own
  * routine in place of cryptfilter (which is purposefully a very weak
@@ -34,6 +37,12 @@ userinit()
 #include <vfork.h>
 #endif
 
+#ifdef CRYPTLOCAL
+
+#include "cryptlocal.h"
+
+#else  /* ndef CRYPTLOCAL */
+
 #define        CRYPT_MAGIC_1   0xfb
 #define        CRYPT_MAGIC_2   0xf1
 
@@ -47,6 +56,8 @@ FILE *        fil;
     }
 }
 
+#endif /* CRYPTLOCAL */
+
 #ifndef MSDOS
 static FILE    *lastpipefile;
 static int     pipepid;
@@ -95,6 +106,7 @@ VOID (*func)();
        _exit(0);
     }
     close(p[1]);
+    close(fileno(fil));
     fclose(fil);
     str = afetch(fdpid,p[0],TRUE);
     str->str_u.str_useful = pipepid;
@@ -112,6 +124,7 @@ cryptswitch()
     ch = getc(rsfp);
     if (ch == CRYPT_MAGIC_1) {
        if (getc(rsfp) == CRYPT_MAGIC_2) {
+           if( perldb ) fatal("can't debug an encrypted script");
            rsfp = mypfiopen( rsfp, cryptfilter );
            preprocess = 1;     /* force call to pclose when done */
        }
@@ -121,63 +134,6 @@ cryptswitch()
     else
        ungetc(ch,rsfp);
 }
-
-FILE *
-cryptopen(cmd)         /* open a (possibly encrypted) program for input */
-char   *cmd;
-{
-    FILE       *fil = fopen( cmd, "r" );
-
-    lastpipefile = Nullfp;
-    pipepid = 0;
-
-    if( fil ) {
-       int     ch = getc( fil );
-       int     lines = 0;
-       int     chars = 0;
-
-       /* Search for the magic cookie that starts the encrypted script,
-       ** while still allowing a few lines of unencrypted text to let
-       ** '#!' and the nih hack both continue to work.  (These lines
-       ** will end up being ignored.)
-       */
-       while( ch != CRYPT_MAGIC_1 && ch != EOF && lines < 5 && chars < 300 ) {
-           if( ch == '\n' )
-               ++lines;
-           ch = getc( fil );
-           ++chars;
-       }
-
-       if( ch == CRYPT_MAGIC_1 ) {
-           if( (ch = getc( fil ) ) == CRYPT_MAGIC_2 ) {
-               if( perldb ) fatal("can't debug an encrypted script");
-               /* we found it, decrypt the rest of the file */
-               fil = mypfiopen( fil, cryptfilter );
-               return( lastpipefile = fil );
-           } else
-               /* if its got MAGIC 1 without MAGIC 2, too bad */
-               fatal( "bad encryption format" );
-       }
-
-       /* this file is not encrypted - rewind and process it normally */
-       rewind( fil );
-    }
-
-    return( fil );
-}
-
-VOID
-cryptclose(fil)
-FILE   *fil;
-{
-    if( fil == Nullfp )
-       return;
-
-    if( fil == lastpipefile )
-       mypclose( fil );
-    else
-       fclose( fil );
-}
 #endif /* !MSDOS */
 
 #endif /* CRYPTSCRIPT */
diff --git a/util.c b/util.c
index e55b2ef..f8586b5 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,4 +1,4 @@
-/* $RCSfile: util.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 19:18:26 $
+/* $RCSfile: util.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:48:54 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       util.c,v $
+ * Revision 4.0.1.4  91/11/11  16:48:54  lwall
+ * patch19: study was busted by 4.018
+ * patch19: added little-endian pack/unpack options
+ * 
  * Revision 4.0.1.3  91/11/05  19:18:26  lwall
  * patch11: safe malloc code now integrated into Perl's malloc when possible
  * patch11: index("little", "longer string") could visit faraway places
@@ -685,12 +689,8 @@ STR *littlestr;
 #ifdef POINTERRIGOR
     if (littlestr->str_pok & SP_CASEFOLD) {    /* case insignificant? */
        do {
-#ifndef lint
-           while (big[pos-previous] != first && big[pos-previous] != fold[first]
-             && (pos += screamnext[pos]) )
-               /*SUPPRESS 530*/
-               ;
-#endif
+           if (big[pos-previous] != first && big[pos-previous] != fold[first])
+               continue;
            for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
                if (x >= bigend)
                    return Nullch;
@@ -715,11 +715,8 @@ STR *littlestr;
     }
     else {
        do {
-#ifndef lint
-           while (big[pos-previous] != first && (pos += screamnext[pos]))
-               /*SUPPRESS 530*/
-               ;
-#endif
+           if (big[pos-previous] != first)
+               continue;
            for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
                if (x >= bigend)
                    return Nullch;
@@ -746,12 +743,8 @@ STR *littlestr;
     big -= previous;
     if (littlestr->str_pok & SP_CASEFOLD) {    /* case insignificant? */
        do {
-#ifndef lint
-           while (big[pos] != first && big[pos] != fold[first]
-             && (pos += screamnext[pos]) )
-               /*SUPPRESS 530*/
-               ;
-#endif
+           if (big[pos] != first && big[pos] != fold[first])
+               continue;
            for (x=big+pos+1,s=little; s < littleend; /**/ ) {
                if (x >= bigend)
                    return Nullch;
@@ -776,11 +769,8 @@ STR *littlestr;
     }
     else {
        do {
-#ifndef lint
-           while (big[pos] != first && (pos += screamnext[pos]))
-               /*SUPPRESS 530*/
-               ;
-#endif
+           if (big[pos] != first)
+               continue;
            for (x=big+pos+1,s=little; s < littleend; /**/ ) {
                if (x >= bigend)
                    return Nullch;
@@ -1236,6 +1226,14 @@ char *pat, *args;
 #endif /* HAS_VPRINTF */
 #endif /* I_VARARGS */
 
+/*
+ * I think my_swap(), htonl() and ntohl() have never been used.
+ * perl.h contains last-chance references to my_swap(), my_htonl()
+ * and my_ntohl().  I presume these are the intended functions;
+ * but htonl() and ntohl() have the wrong names.  There are no
+ * functions my_htonl() and my_ntohl() defined anywhere.
+ * -DWS
+ */
 #ifdef MYSWAP
 #if BYTEORDER != 0x4321
 short
@@ -1315,7 +1313,64 @@ register long l;
 }
 
 #endif /* BYTEORDER != 0x4321 */
-#endif /* HAS_HTONS */
+#endif /* MYSWAP */
+
+/*
+ * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
+ * If these functions are defined,
+ * the BYTEORDER is neither 0x1234 nor 0x4321.
+ * However, this is not assumed.
+ * -DWS
+ */
+
+#define HTOV(name,type)                                                \
+       type                                                    \
+       name (n)                                                \
+       register type n;                                        \
+       {                                                       \
+           union {                                             \
+               type value;                                     \
+               char c[sizeof(type)];                           \
+           } u;                                                \
+           register int i;                                     \
+           register int s;                                     \
+           for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {  \
+               u.c[i] = (n >> s) & 0xFF;                       \
+           }                                                   \
+           return u.value;                                     \
+       }
+
+#define VTOH(name,type)                                                \
+       type                                                    \
+       name (n)                                                \
+       register type n;                                        \
+       {                                                       \
+           union {                                             \
+               type value;                                     \
+               char c[sizeof(type)];                           \
+           } u;                                                \
+           register int i;                                     \
+           register int s;                                     \
+           u.value = n;                                        \
+           n = 0;                                              \
+           for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {  \
+               n += (u.c[i] & 0xFF) << s;                      \
+           }                                                   \
+           return n;                                           \
+       }
+
+#if defined(HAS_HTOVS) && !defined(htovs)
+HTOV(htovs,short)
+#endif
+#if defined(HAS_HTOVL) && !defined(htovl)
+HTOV(htovl,long)
+#endif
+#if defined(HAS_VTOHS) && !defined(vtohs)
+VTOH(vtohs,short)
+#endif
+#if defined(HAS_VTOHL) && !defined(vtohl)
+VTOH(vtohl,long)
+#endif
 
 #ifndef MSDOS
 FILE *