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.
# 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
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
cpp
csh
egrep
+line
nroff
+perl
test
uname
yacc
: index or strcpy
echo " "
case "$d_index" in
-n) dflt=n;;
+undef) dflt=n;;
*) if $test -f /unix; then
dflt=n
else
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`
. 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
'')
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
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
-/* $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
*
* 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
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) {
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;
}
}
}
lastspat = cmd->c_spat;
match = !(cmdflags & CF_FIRSTNEG);
- retstr = &str_yes;
+ retstr = match ? &str_yes : &str_no;
goto flipmaybe;
}
else
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;
}
}
. ./config.sh
rm -f x2p/config.sh
+cp cppstdin x2p
echo " "
echo "Doing variable substitutions on .SH files..."
-/* $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
*
* 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
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) {
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;
-/* $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
*
* 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
}
}
break;
+ case 'v':
case 'n':
case 'S':
along = (strend - s) / sizeof(unsigned short);
if (datumtype == 'n')
aushort = ntohs(aushort);
#endif
+#ifdef HAS_VTOHS
+ if (datumtype == 'v')
+ aushort = vtohs(aushort);
+#endif
culong += aushort;
}
}
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));
}
}
}
break;
+ case 'V':
case 'N':
case 'L':
along = (strend - s) / sizeof(unsigned long);
if (datumtype == 'N')
aulong = ntohl(aulong);
#endif
+#ifdef HAS_VTOHL
+ if (datumtype == 'V')
+ aulong = vtohl(aulong);
+#endif
if (checksum > 32)
cdouble += (double)aulong;
else
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));
}
STR *oldsecond;
ARRAY *oldstack;
HASH *stash;
+ STR *sortsubvar;
static ARRAY *sortstack = Null(ARRAY*);
if (gimme != G_ARRAY) {
return sp;
}
up = &st[sp];
+ sortsubvar = *up;
st += sp; /* temporarily make st point to args */
for (i = 1; i <= max; i++) {
/*SUPPRESS 560*/
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))
-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=''
-libswanted=`echo $libswanted | sed 's/malloc //'`
+libswanted=`echo $libswanted | sed -e 's/malloc //' -e 's/BSD //`
+optimize='+O1'
--- /dev/null
+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."
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'
-ccflags="$ccflags -DCRIPPLED_CC -g"
-d_lstat=$undef
+ccflags="$ccflags -DCRIPPLED_CC"
+d_lstat=$define
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";
-#define PATCHLEVEL 18
+#define PATCHLEVEL 19
-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
*
* 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
defstab = stabent("_",TRUE);
+ subname = str_make("main",4);
if (perldb) {
debstash = hnew(0);
stab_xhash(stabent("_DB",TRUE)) = debstash;
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);
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 */
}
-/* $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
*
* 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
#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>
# 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
# define SLOPPYDIVIDE
#endif
-#if defined(cray) || defined(convex) || BYTEORDER > 0xffff
+#if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff
# define QUAD
#endif
# ifdef cray
# define quad int
# else
-# ifdef convex
+# if defined(convex) || defined (uts)
# define quad long long
# else
# define quad long
#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))
.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 {}
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
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.
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
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{$_}++;
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";
+}
--- /dev/null
+#!./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"; }
#!./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; }
@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");
+
#!./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";
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";}
}
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";}
-/* $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
*
* 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()
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);
}
-/* $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.
*
}
/*
- * 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
#include <vfork.h>
#endif
+#ifdef CRYPTLOCAL
+
+#include "cryptlocal.h"
+
+#else /* ndef CRYPTLOCAL */
+
#define CRYPT_MAGIC_1 0xfb
#define CRYPT_MAGIC_2 0xf1
}
}
+#endif /* CRYPTLOCAL */
+
#ifndef MSDOS
static FILE *lastpipefile;
static int pipepid;
_exit(0);
}
close(p[1]);
+ close(fileno(fil));
fclose(fil);
str = afetch(fdpid,p[0],TRUE);
str->str_u.str_useful = pipepid;
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 */
}
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 */
-/* $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
*
* 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
#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;
}
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;
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;
}
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;
#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
}
#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 *
projects / p5sagit/p5-mst-13.2.git / commitdiff