summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLarry Wall <lwall@netlabs.com>1991-11-11 03:50:16 +0000
committerLarry Wall <lwall@netlabs.com>1991-11-11 03:50:16 +0000
commit988174c19bcf26f6c6e0551f1dfbba78203bc2ce (patch)
tree7918e82dffc7e46c520ab9fafb727f369b32e8d9
parent55204971972392ce5a252fbbd6d78b1c48ed70e3 (diff)
downloadperl-988174c19bcf26f6c6e0551f1dfbba78203bc2ce.tar.gz
perl 4.0 patch 19: (combined patch)
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.
-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 *