diff options
author | Larry Wall <lwall@netlabs.com> | 1991-11-11 03:50:16 +0000 |
---|---|---|
committer | Larry Wall <lwall@netlabs.com> | 1991-11-11 03:50:16 +0000 |
commit | 988174c19bcf26f6c6e0551f1dfbba78203bc2ce (patch) | |
tree | 7918e82dffc7e46c520ab9fafb727f369b32e8d9 | |
parent | 55204971972392ce5a252fbbd6d78b1c48ed70e3 (diff) | |
download | perl-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-x | Configure | 128 | ||||
-rw-r--r-- | MANIFEST | 2 | ||||
-rw-r--r-- | cmd.c | 25 | ||||
-rw-r--r-- | doSH | 1 | ||||
-rw-r--r-- | doarg.c | 25 | ||||
-rw-r--r-- | dolist.c | 28 | ||||
-rw-r--r-- | hints/aix_rs.sh | 10 | ||||
-rw-r--r-- | hints/hp9000_800.sh | 3 | ||||
-rw-r--r-- | hints/isc_3_2_2.sh | 7 | ||||
-rw-r--r-- | hints/sco_3.sh | 5 | ||||
-rw-r--r-- | hints/uts.sh | 4 | ||||
-rw-r--r-- | installperl | 7 | ||||
-rw-r--r-- | patchlevel.h | 2 | ||||
-rw-r--r-- | perl.c | 10 | ||||
-rw-r--r-- | perl.h | 50 | ||||
-rw-r--r-- | perl.man | 14 | ||||
-rw-r--r-- | t/op/groups.t | 35 | ||||
-rw-r--r-- | t/op/readdir.t | 20 | ||||
-rw-r--r-- | t/op/sort.t | 9 | ||||
-rw-r--r-- | t/op/stat.t | 7 | ||||
-rw-r--r-- | toke.c | 31 | ||||
-rw-r--r-- | usersub.c | 74 | ||||
-rw-r--r-- | util.c | 103 |
23 files changed, 393 insertions, 207 deletions
@@ -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 '') @@ -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 @@ -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; } } @@ -4,6 +4,7 @@ . ./config.sh rm -f x2p/config.sh +cp cppstdin x2p echo " " echo "Doing variable substitutions on .SH files..." @@ -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; @@ -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 @@ -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 */ } @@ -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)) @@ -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";} @@ -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); } @@ -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 */ @@ -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 * |