summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xConfigure128
-rw-r--r--MANIFEST2
-rw-r--r--cmd.c25
-rw-r--r--doSH1
-rw-r--r--doarg.c25
-rw-r--r--dolist.c28
-rw-r--r--hints/aix_rs.sh10
-rw-r--r--hints/hp9000_800.sh3
-rw-r--r--hints/isc_3_2_2.sh7
-rw-r--r--hints/sco_3.sh5
-rw-r--r--hints/uts.sh4
-rw-r--r--installperl7
-rw-r--r--patchlevel.h2
-rw-r--r--perl.c10
-rw-r--r--perl.h50
-rw-r--r--perl.man14
-rw-r--r--t/op/groups.t35
-rw-r--r--t/op/readdir.t20
-rw-r--r--t/op/sort.t9
-rw-r--r--t/op/stat.t7
-rw-r--r--toke.c31
-rw-r--r--usersub.c74
-rw-r--r--util.c103
23 files changed, 393 insertions, 207 deletions
diff --git a/Configure b/Configure
index aba4247556..a777a141d8 100755
--- 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
'')
diff --git a/MANIFEST b/MANIFEST
index ca59619ccc..0adfbf5b24 100644
--- 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 250950913f..0e51f22f26 100644
--- 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 ec3a1fc286..43fd322ea5 100644
--- 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 9785d46c47..c40bf6825e 100644
--- 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;
diff --git a/dolist.c b/dolist.c
index 345c5acfd3..a452e8e7cd 100644
--- 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))
diff --git a/hints/aix_rs.sh b/hints/aix_rs.sh
index 17b22a1a36..9b845a70ae 100644
--- a/hints/aix_rs.sh
+++ b/hints/aix_rs.sh
@@ -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=''
diff --git a/hints/hp9000_800.sh b/hints/hp9000_800.sh
index c2c41d3a74..b5f22ffaea 100644
--- a/hints/hp9000_800.sh
+++ b/hints/hp9000_800.sh
@@ -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
index 0000000000..15825953d4
--- /dev/null
+++ b/hints/isc_3_2_2.sh
@@ -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."
diff --git a/hints/sco_3.sh b/hints/sco_3.sh
index a151fe0eed..1bb8fb11a9 100644
--- a/hints/sco_3.sh
+++ b/hints/sco_3.sh
@@ -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'
diff --git a/hints/uts.sh b/hints/uts.sh
index c31733cb8d..c4d94c42f2 100644
--- a/hints/uts.sh
+++ b/hints/uts.sh
@@ -1,2 +1,2 @@
-ccflags="$ccflags -DCRIPPLED_CC -g"
-d_lstat=$undef
+ccflags="$ccflags -DCRIPPLED_CC"
+d_lstat=$define
diff --git a/installperl b/installperl
index e05e75ce59..643317a9d6 100644
--- a/installperl
+++ b/installperl
@@ -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";
diff --git a/patchlevel.h b/patchlevel.h
index 1af605efed..111b8fe68d 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 18
+#define PATCHLEVEL 19
diff --git a/perl.c b/perl.c
index 67b88ebb53..f93095de24 100644
--- 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 09edd0727c..c9064b164f 100644
--- 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))
diff --git a/perl.man b/perl.man
index d3d6d5bedd..4ffb76e8e4 100644
--- 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
diff --git a/t/op/groups.t b/t/op/groups.t
index f8cb4cad58..e1520cc3d6 100644
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -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
index 0000000000..8125bd4190
--- /dev/null
+++ b/t/op/readdir.t
@@ -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"; }
diff --git a/t/op/sort.t b/t/op/sort.t
index 73a394421c..658a5bd1bc 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -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");
+
diff --git a/t/op/stat.t b/t/op/stat.t
index 1d1b22cac8..78b97dc191 100644
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -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 14ce7f6b0a..4858c2c246 100644
--- 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);
}
diff --git a/usersub.c b/usersub.c
index 4e55fbf07e..d622ab2a9c 100644
--- 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 e55b2efc14..f8586b5f96 100644
--- 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 *
View Lorry Controller Status