-/* $Header: cmd.c,v 3.0.1.1 89/10/26 23:04:21 lwall Locked $
+/* $Header: cmd.c,v 3.0.1.2 89/11/11 04:08:56 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: cmd.c,v $
+ * Revision 3.0.1.2 89/11/11 04:08:56 lwall
+ * patch2: non-BSD machines required two ^D's for <>
+ * patch2: grow_dlevel() not inside #ifdef DEBUGGING
+ *
* Revision 3.0.1.1 89/10/26 23:04:21 lwall
* patch1: heuristically disabled optimization could cause core dump
*
fp = stab_io(last_in_stab)->ifp;
retstr = stab_val(defstab);
newsp = -2;
+ keepgoing:
if (fp && str_gets(retstr, fp, 0)) {
if (*retstr->str_ptr == '0' && retstr->str_cur == 1)
match = FALSE;
match = TRUE;
stab_io(last_in_stab)->lines++;
}
- else if (stab_io(last_in_stab)->flags & IOF_ARGV)
- goto doeval; /* doesn't necessarily count as EOF yet */
+ else if (stab_io(last_in_stab)->flags & IOF_ARGV) {
+ if (!fp)
+ goto doeval; /* first time through */
+ fp = nextargv(last_in_stab);
+ if (fp)
+ goto keepgoing;
+ (void)do_close(last_in_stab,FALSE);
+ stab_io(last_in_stab)->flags |= IOF_START;
+ retstr = &str_undef;
+ match = FALSE;
+ }
else {
retstr = &str_undef;
match = FALSE;
}
}
+#ifdef DEBUGGING
void
grow_dlevel()
{
Renew(debname, dlmax, char);
Renew(debdelim, dlmax, char);
}
+#endif
*/
#$d_crypt CRYPT /**/
+/* CSH:
+ * This symbol, if defined, indicates that the C-shell exists.
+ * If defined, contains the full pathname of csh.
+ */
+#$d_csh CSH "$csh" /**/
+
/* DOSUID:
* This symbol, if defined, indicates that the C program should
* check the script that it is executing for setuid/setgid bits, and
/* I_SYSTIME:
* This symbol is defined if this system has the file <sys/time.h>.
*/
+/* I_TIMETOO:
+ * This symbol is defined if <sys/time.h> exists but doesn't include
+ * <time.h>.
+ */
#$d_tminsys TMINSYS /**/
#$i_systime I_SYSTIME /**/
+#$i_timetoo I_TIMETOO /**/
/* VARARGS:
* This symbol, if defined, indicates to the C program that it should
#$d_vprintf VPRINTF /**/
#$d_charvspr CHARVSPRINTF /**/
+/* WAIT4:
+ * This symbol, if defined, indicates that wait4() exists.
+ */
+#$d_wait4 WAIT4 /**/
+
/* GIDTYPE:
* This symbol has a value like gid_t, int, ushort, or whatever type is
* used to declare group ids in the kernel.
#$i_pwd I_PWD /**/
#$d_pwquota PWQUOTA /**/
#$d_pwage PWAGE /**/
-#$d_pwage PWCHANGE /**/
-#$d_pwage PWCLASS /**/
-#$d_pwage PWEXPIRE /**/
+#$d_pwchange PWCHANGE /**/
+#$d_pwclass PWCLASS /**/
+#$d_pwexpire PWEXPIRE /**/
/* I_SYSDIR:
* This symbol, if defined, indicates to the C program that it should
-/* $Header: consarg.c,v 3.0 89/10/18 15:10:30 lwall Locked $
+/* $Header: consarg.c,v 3.0.1.1 89/11/11 04:14:30 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: consarg.c,v $
+ * Revision 3.0.1.1 89/11/11 04:14:30 lwall
+ * patch2: '-' x 26 made warnings about undefined value
+ * patch2: eval with no args caused strangeness
+ * patch2: local(@foo) didn't work, but local(@foo,$bar) did
+ *
* Revision 3.0 89/10/18 15:10:30 lwall
* 3.0 baseline
*
break;
case O_REPEAT:
i = (int)str_gnum(s2);
+ str_nset(str,"",0);
while (i-- > 0)
str_scat(str,s1);
break;
arg[2].arg_flags |= AF_ARYOK;
}
}
+ else if (arg->arg_type == O_ASSIGN)
+ arg[1].arg_flags |= AF_ARYOK;
}
else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
arg1->arg_type = O_LHELEM;
arg[2].arg_flags |= AF_ARYOK;
}
}
+ else if (arg->arg_type == O_ASSIGN)
+ arg[1].arg_flags |= AF_ARYOK;
}
else if (arg1->arg_type == O_ASLICE) {
arg1->arg_type = O_LASLICE;
ARG *arg;
{
Renew(arg, 3, ARG);
+ if (arg->arg_len == 0)
+ arg[1].arg_type = A_NULL;
arg->arg_len = 2;
arg[2].arg_ptr.arg_hash = curstash;
arg[2].arg_type = A_NULL;
-/* $Header: doarg.c,v 3.0 89/10/18 15:10:41 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.1 89/11/11 04:17:20 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doarg.c,v $
+ * Revision 3.0.1.1 89/11/11 04:17:20 lwall
+ * patch2: printf %c, %D, %X and %O didn't work right
+ * patch2: printf of unsigned vs signed needed separate casts on some machines
+ *
* Revision 3.0 89/10/18 15:10:41 lwall
* 3.0 baseline
*
case 'l':
dolong = TRUE;
break;
- case 'D': case 'X': case 'O':
- dolong = TRUE;
- /* FALL THROUGH */
case 'c':
- *buf = (int)str_gnum(*(sarg++));
- str_ncat(str,buf,1); /* force even if null */
- *buf = '\0';
- s = t+1;
+ ch = *(++t);
+ *t = '\0';
+ xlen = (int)str_gnum(*(sarg++));
+ if (strEQ(t-2,"%c")) { /* some printfs fail on null chars */
+ *buf = xlen;
+ str_ncat(str,s,t - s - 2);
+ str_ncat(str,buf,1); /* so handle simple case */
+ *buf = '\0';
+ }
+ else
+ (void)sprintf(buf,s,xlen);
+ s = t;
+ *(t--) = ch;
break;
- case 'd': case 'x': case 'o': case 'u':
+ case 'D':
+ dolong = TRUE;
+ /* FALL THROUGH */
+ case 'd':
ch = *(++t);
*t = '\0';
if (dolong)
s = t;
*(t--) = ch;
break;
+ case 'X': case 'O':
+ dolong = TRUE;
+ /* FALL THROUGH */
+ case 'x': case 'o': case 'u':
+ ch = *(++t);
+ *t = '\0';
+ if (dolong)
+ (void)sprintf(buf,s,(unsigned long)str_gnum(*(sarg++)));
+ else
+ (void)sprintf(buf,s,(unsigned int)str_gnum(*(sarg++)));
+ s = t;
+ *(t--) = ch;
+ break;
case 'E': case 'e': case 'f': case 'G': case 'g':
ch = *(++t);
*t = '\0';
-/* $Header: doio.c,v 3.0.1.1 89/10/26 23:10:05 lwall Locked $
+/* $Header: doio.c,v 3.0.1.2 89/11/11 04:25:51 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doio.c,v $
+ * Revision 3.0.1.2 89/11/11 04:25:51 lwall
+ * patch2: orthogonalized the file modes some so we can have <& +<& etc.
+ * patch2: do_open() now detects sockets passed to process from parent
+ * patch2: fd's above 2 are now closed on exec
+ * patch2: csh code can now use csh from other than /bin
+ * patch2: getsockopt, get{sock,peer}name didn't define result properly
+ * patch2: warn("shutdown") was replicated
+ * patch2: gethostbyname was misdeclared
+ * patch2: telldir() is sometimes a macro
+ *
* Revision 3.0.1.1 89/10/26 23:10:05 lwall
* patch1: Configure now checks for BSD shadow passwords
*
fp = mypopen(name,"w");
writing = 1;
}
- else if (*name == '>' && name[1] == '>') {
-#ifdef TAINT
- taintproper("Insecure dependency in open");
-#endif
- mode[0] = stio->type = 'a';
- for (name += 2; isspace(*name); name++) ;
- fp = fopen(name, mode);
- writing = 1;
- }
- else if (*name == '>' && name[1] == '&') {
-#ifdef TAINT
- taintproper("Insecure dependency in open");
-#endif
- for (name += 2; isspace(*name); name++) ;
- if (isdigit(*name))
- fd = atoi(name);
- else {
- stab = stabent(name,FALSE);
- if (stab_io(stab) && stab_io(stab)->ifp) {
- fd = fileno(stab_io(stab)->ifp);
- stio->type = stab_io(stab)->type;
- }
- else
- fd = -1;
- }
- fp = fdopen(dup(fd),stio->type == 'a' ? "a" :
- (stio->type == '<' ? "r" : "w") );
- writing = 1;
- }
else if (*name == '>') {
#ifdef TAINT
taintproper("Insecure dependency in open");
#endif
- for (name++; isspace(*name); name++) ;
- if (strEQ(name,"-")) {
- fp = stdout;
- stio->type = '-';
+ name++;
+ if (*name == '>') {
+ mode[0] = stio->type = 'a';
+ name++;
}
- else {
+ else
mode[0] = 'w';
- fp = fopen(name,mode);
- }
writing = 1;
+ if (*name == '&') {
+ duplicity:
+ name++;
+ while (isspace(*name))
+ name++;
+ if (isdigit(*name))
+ fd = atoi(name);
+ else {
+ stab = stabent(name,FALSE);
+ if (!stab || !stab_io(stab))
+ return FALSE;
+ if (stab_io(stab) && stab_io(stab)->ifp) {
+ fd = fileno(stab_io(stab)->ifp);
+ if (stab_io(stab)->type == 's')
+ stio->type = 's';
+ }
+ else
+ fd = -1;
+ }
+ fp = fdopen(dup(fd),mode);
+ }
+ else {
+ while (isspace(*name))
+ name++;
+ if (strEQ(name,"-")) {
+ fp = stdout;
+ stio->type = '-';
+ }
+ else {
+ fp = fopen(name,mode);
+ }
+ }
}
else {
if (*name == '<') {
- for (name++; isspace(*name); name++) ;
+ mode[0] = 'r';
+ name++;
+ while (isspace(*name))
+ name++;
+ if (*name == '&')
+ goto duplicity;
if (strEQ(name,"-")) {
fp = stdin;
stio->type = '-';
}
- else {
- mode[0] = 'r';
+ else
fp = fopen(name,mode);
- }
}
else if (name[len-1] == '|') {
#ifdef TAINT
(void)fclose(fp);
return FALSE;
}
- if ((statbuf.st_mode & S_IFMT) != S_IFREG &&
+ result = (statbuf.st_mode & S_IFMT);
+ if (result != S_IFREG &&
#ifdef S_IFSOCK
- (statbuf.st_mode & S_IFMT) != S_IFSOCK &&
+ result != S_IFSOCK &&
#endif
#ifdef S_IFFIFO
- (statbuf.st_mode & S_IFMT) != S_IFFIFO &&
+ result != S_IFFIFO &&
+#endif
+#ifdef S_IFIFO
+ result != S_IFIFO &&
#endif
- (statbuf.st_mode & S_IFMT) != S_IFCHR) {
+ result != 0 && /* socket? */
+ result != S_IFCHR) {
(void)fclose(fp);
return FALSE;
}
+#ifdef S_IFSOCK
+ if (result == S_IFSOCK || result == 0)
+ stio->type = 's'; /* in case a socket was passed in to us */
+#endif
}
+#if defined(FCNTL) && defined(F_SETFD)
+ fd = fileno(fp);
+ if (fd >= 3)
+ fcntl(fd,F_SETFD,1);
+#endif
stio->ifp = fp;
- if (writing)
- stio->ofp = fp;
+ if (writing) {
+ if (stio->type != 's')
+ stio->ofp = fp;
+ else
+ stio->ofp = fdopen(fileno(fp),"w");
+ }
return TRUE;
}
/* save an extra exec if possible */
- if (csh > 0 && strnEQ(cmd,"/bin/csh -c",11)) {
+#ifdef CSH
+ if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
strcpy(flags,"-c");
- s = cmd+11;
+ s = cmd+cshlen+3;
if (*s == 'f') {
s++;
strcat(flags,"f");
*--s = '\0';
if (s[-1] == '\'') {
*--s = '\0';
- execl("/bin/csh","csh", flags,ncmd,(char*)0);
+ execl(cshname,"csh", flags,ncmd,(char*)0);
*s = '\'';
return FALSE;
}
}
}
+#endif /* CSH */
/* see if there are shell metacharacters in it */
case O_GSOCKOPT:
st[sp] = str_2static(str_new(257));
st[sp]->str_cur = 256;
+ st[sp]->str_pok = 1;
if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
goto nuts;
break;
nuts:
if (dowarn)
- warn("shutdown() on closed fd");
+ warn("[gs]etsockopt() on closed fd");
st[sp] = &str_undef;
return sp;
st[sp] = str_2static(str_new(257));
st[sp]->str_cur = 256;
+ st[sp]->str_pok = 1;
fd = fileno(stio->ifp);
switch (optype) {
case O_GETSOCKNAME:
nuts:
if (dowarn)
- warn("shutdown() on closed fd");
+ warn("get{sock,peer}name() on closed fd");
st[sp] = &str_undef;
return sp;
register int sp = arglast[0];
register char **elem;
register STR *str;
- struct hostent *gethostbynam();
+ struct hostent *gethostbyname();
struct hostent *gethostbyaddr();
#ifdef GETHOSTENT
struct hostent *gethostent();
register int sp = arglast[1];
register STIO *stio;
long along;
+#ifndef telldir
long telldir();
+#endif
struct DIRENT *readdir();
register struct DIRENT *dp;
-/* $Header: dolist.c,v 3.0.1.1 89/10/26 23:11:51 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.2 89/11/11 04:28:17 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.2 89/11/11 04:28:17 lwall
+ * patch2: non-existent slice values are now undefined rather than null
+ *
* Revision 3.0.1.1 89/10/26 23:11:51 lwall
* patch1: split in a subroutine wrongly freed referenced arguments
* patch1: reverse didn't work
lval);
}
else
- st[sp-1] = Nullstr;
+ st[sp-1] = &str_undef;
}
}
else {
str_magic(st[sp-1],stab,magic,tmps,len);
}
else
- st[sp-1] = Nullstr;
+ st[sp-1] = &str_undef;
}
}
sp--;
if (st[max])
st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval);
else
- st[sp] = Nullstr;
+ st[sp] = &str_undef;
}
else {
if (st[max]) {
str_magic(st[sp],stab,magic,tmps,len);
}
else
- st[sp] = Nullstr;
+ st[sp] = &str_undef;
}
}
return sp;
-/* $Header: eval.c,v 3.0 89/10/18 15:17:04 lwall Locked $
+/* $Header: eval.c,v 3.0.1.1 89/11/11 04:31:51 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: eval.c,v $
+ * Revision 3.0.1.1 89/11/11 04:31:51 lwall
+ * patch2: mkdir and rmdir needed to quote argument when passed to shell
+ * patch2: mkdir and rmdir now return better error codes
+ * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
+ *
* Revision 3.0 89/10/18 15:17:04 lwall
* 3.0 baseline
*
if (arg[1].arg_flags & AF_ARYOK) {
if (arg->arg_len == 1) {
arg->arg_type = O_LOCAL;
- arg->arg_flags |= AF_LOCAL;
goto local;
}
else {
#endif
#ifdef MKDIR
value = (double)(mkdir(tmps,anum) >= 0);
+ goto donumset;
#else
- (void)sprintf(buf,"mkdir %s 2>&1",tmps);
+ (void)strcpy(buf,"mkdir ");
+#endif
+#if !defined(MKDIR) || !defined(RMDIR)
one_liner:
+ for (tmps2 = buf+6; *tmps; ) {
+ *tmps2++ = '\\';
+ *tmps2++ = *tmps++;
+ }
+ (void)strcpy(tmps2," 2>&1");
rsfp = mypopen(buf,"r");
if (rsfp) {
*buf = '\0';
tmps2 = fgets(buf,sizeof buf,rsfp);
(void)mypclose(rsfp);
if (tmps2 != Nullch) {
- for (errno = 1; errno <= sys_nerr; errno++) {
+ for (errno = 1; errno < sys_nerr; errno++) {
if (instr(buf,sys_errlist[errno])) /* you don't see this */
goto say_zero;
}
errno = 0;
+#ifndef EACCES
+#define EACCES EPERM
+#endif
+ if (instr(buf,"cannot make"))
+ errno = EEXIST;
+ else if (instr(buf,"non-exist"))
+ errno = ENOENT;
+ else if (instr(buf,"not empty"))
+ errno = EBUSY;
+ else if (instr(buf,"cannot access"))
+ errno = EACCES;
+ else
+ errno = EPERM;
goto say_zero;
}
- else
- value = 1.0;
+ else { /* some mkdirs return no failure indication */
+ tmps = str_get(st[1]);
+ anum = (stat(tmps,&statbuf) >= 0);
+ if (optype == O_RMDIR)
+ anum = !anum;
+ if (anum)
+ errno = 0;
+ else
+ errno = EACCES; /* a guess */
+ value = (double)anum;
+ }
+ goto donumset;
}
else
goto say_zero;
#endif
- goto donumset;
case O_RMDIR:
if (maxarg < 1)
tmps = str_get(stab_val(defstab));
value = (double)(rmdir(tmps) >= 0);
goto donumset;
#else
- (void)sprintf(buf,"rmdir %s 2>&1",tmps);
+ (void)strcpy(buf,"rmdir ");
goto one_liner; /* see above in MKDIR */
#endif
case O_GETPPID:
fatal("Unsupported socket function");
#endif /* SOCKET */
case O_FILENO:
+ if (maxarg < 1)
+ goto say_undef;
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
case O_SEEKDIR:
case O_REWINDDIR:
case O_CLOSEDIR:
+ if (maxarg < 1)
+ goto say_undef;
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
* kit sizes from getting too big.
*/
-/* $Header: evalargs.xc,v 3.0.1.1 89/10/26 23:12:55 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.2 89/11/11 04:33:05 lwall Locked $
*
* $Log: evalargs.xc,v $
+ * Revision 3.0.1.2 89/11/11 04:33:05 lwall
+ * patch2: Configure now locates csh
+ *
* Revision 3.0.1.1 89/10/26 23:12:55 lwall
* patch1: glob didn't free a temporary string
*
argflags |= AF_POST; /* enable newline chopping */
last_in_stab = argptr.arg_stab;
old_record_separator = record_separator;
- if (csh > 0)
- record_separator = 0;
- else
- record_separator = '\n';
+#ifdef CSH
+ record_separator = 0;
+#else
+ record_separator = '\n';
+#endif
goto do_read;
case A_READ:
last_in_stab = argptr.arg_stab;
}
}
fp = nextargv(last_in_stab);
- if (!fp) /* Note: fp != stab_io(last_in_stab)->ifp */
+ if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
(void)do_close(last_in_stab,FALSE); /* now it does*/
+ stab_io(last_in_stab)->flags |= IOF_START;
+ }
}
else if (argtype == A_GLOB) {
(void) interp(str,stab_val(last_in_stab),sp);
st = stack->ary_array;
tmpstr = Str_new(55,0);
- if (csh > 0) {
- str_set(tmpstr,"/bin/csh -cf 'set nonomatch; glob ");
- str_scat(tmpstr,str);
- str_cat(tmpstr,"'|");
- }
- else {
- str_set(tmpstr, "echo ");
- str_scat(tmpstr,str);
- str_cat(tmpstr,
- "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
- }
+#ifdef CSH
+ str_nset(tmpstr,cshname,cshlen);
+ str_cat(tmpstr," -cf 'set nonomatch; glob ");
+ str_scat(tmpstr,str);
+ str_cat(tmpstr,"'|");
+#else
+ str_set(tmpstr, "echo ");
+ str_scat(tmpstr,str);
+ str_cat(tmpstr,
+ "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
+#endif
(void)do_open(last_in_stab,tmpstr->str_ptr);
fp = stab_io(last_in_stab)->ifp;
str_free(tmpstr);
-/* $Header: hash.c,v 3.0 89/10/18 15:18:32 lwall Locked $
+/* $Header: hash.c,v 3.0.1.1 89/11/11 04:34:18 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: hash.c,v $
+ * Revision 3.0.1.1 89/11/11 04:34:18 lwall
+ * patch2: CX/UX needed to set the key each time in associative iterators
+ *
* Revision 3.0 89/10/18 15:18:32 lwall
* 3.0 baseline
*
if (entry) {
#ifdef NDBM
#ifdef _CX_UX
+ key.dptr = entry->hent_key;
+ key.dsize = entry->hent_klen;
key = dbm_nextkey(tb->tbl_dbm, key);
#else
key = dbm_nextkey(tb->tbl_dbm);
$pos = index($argumentative,$first);
if($pos >= $[) {
if($args[$pos+1] eq ':') {
- shift;
+ shift(@ARGV);
if($rest eq '') {
- $rest = shift;
+ $rest = shift(@ARGV);
}
eval "\$opt_$first = \$rest;";
}
else {
eval "\$opt_$first = 1";
if($rest eq '') {
- shift;
+ shift(@ARGV);
}
else {
$ARGV[0] = "-$rest";
$ARGV[0] = "-$rest";
}
else {
- shift;
+ shift(@ARGV);
}
}
}
echo "Extracting makedepend (with variable substitutions)"
$spitshell >makedepend <<!GROK!THIS!
$startsh
-# $Header: makedepend.SH,v 3.0 89/10/18 15:20:19 lwall Locked $
+# $Header: makedepend.SH,v 3.0.1.1 89/11/11 04:35:32 lwall Locked $
#
# $Log: makedepend.SH,v $
+# Revision 3.0.1.1 89/11/11 04:35:32 lwall
+# patch2: makedepend now uses cppflags determined by Configure
+#
# Revision 3.0 89/10/18 15:20:19 lwall
# 3.0 baseline
#
export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$)
cat='$cat'
-ccflags='$ccflags $sockethdr'
+cppflags='$cppflags'
cp='$cp'
cpp='$cppstdin'
echo='$echo'
$spitshell >>makedepend <<'!NO!SUBS!'
-: the following weeds options from ccflags that are of no interest to cpp
-case "$ccflags" in
-'');;
-*) set X $ccflags
- ccflags=''
- for flag do
- case $flag in
- -D*|-I*) ccflags="$ccflags $flag";;
- esac
- done
- ;;
-esac
-
$cat /dev/null >.deptmp
$rm -f *.c.c c/*.c.c
if test -f Makefile; then
-e 's|\\$||' \
-e p \
-e '}'
- $cpp -I/usr/local/include -I. $ccflags $file.c | \
+ $cpp -I/usr/local/include -I. $cppflags $file.c | \
$sed \
-e '/^# *[0-9]/!d' \
-e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
-/* $Header: malloc.c,v 3.0.1.1 89/10/26 23:15:05 lwall Locked $
+/* $Header: malloc.c,v 3.0.1.2 89/11/11 04:36:37 lwall Locked $
*
* $Log: malloc.c,v $
+ * Revision 3.0.1.2 89/11/11 04:36:37 lwall
+ * patch2: malloc pointer corruption check made more portable
+ *
* Revision 3.0.1.1 89/10/26 23:15:05 lwall
* patch1: some declarations were missing from malloc.c
* patch1: sparc machines had alignment problems in malloc.c
if ((p = (union overhead *)nextf[bucket]) == NULL)
return (NULL);
/* remove from linked list */
- if (*((int*)p) > 0x10000000)
+#ifdef RCHECK
+ if (*((int*)p) & (sizeof(union overhead) - 1))
#ifndef I286
fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
#else
fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
#endif
- nextf[bucket] = nextf[bucket]->ov_next;
+#endif
+ nextf[bucket] = p->ov_next;
p->ov_magic = MAGIC;
p->ov_index= bucket;
#ifdef MSTATS
-#define PATCHLEVEL 2
+#define PATCHLEVEL 3
#!./perl
-# $Header: TEST,v 3.0 89/10/18 15:24:06 lwall Locked $
+# $Header: TEST,v 3.0.1.1 89/11/11 04:58:01 lwall Locked $
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
if ($test =~ /\.orig$/) {
next;
}
+ if ($test =~ /\.rej$/) {
+ next;
+ }
if ($test =~ /~$/) {
next;
}
#!./perl
-# $Header: io.argv,v 3.0 89/10/18 15:26:10 lwall Locked $
+# $Header: io.argv,v 3.0.1.1 89/11/11 04:59:05 lwall Locked $
print "1..5\n";
$x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
-if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3\n";}
+if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";}
@ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp');
while (<>) {
#!./perl
-# $Header: op.magic,v 3.0 89/10/18 15:29:54 lwall Locked $
+# $Header: op.magic,v 3.0.1.1 89/11/11 05:00:07 lwall Locked $
$| = 1; # command buffering
eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval
if (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";}
+unlink 'ajslkdfpqjsjfk';
$! = 0;
-open(foo,'ajslkdfpqjsjfkslkjdflksd');
+open(foo,'ajslkdfpqjsjfk');
if ($! == 2) {print "ok 2\n";} else {print "not ok 2\n";}
# the next tests are embedded inside system simply because sh spits out
#!./perl
-# $Header: op.mkdir,v 3.0 89/10/18 15:30:05 lwall Locked $
+# $Header: op.mkdir,v 3.0.1.1 89/11/11 05:00:47 lwall Locked $
print "1..7\n";
print (mkdir('blurfl',0666) ? "ok 1\n" : "not ok 1\n");
print (mkdir('blurfl',0666) ? "not ok 2\n" : "ok 2\n");
-print ($! == 17 ? "ok 3\n" : "not ok 3\n");
+print ($! =~ /exists/ ? "ok 3\n" : "not ok 3\n");
print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
-print ($! == 2 ? "ok 7\n" : "not ok 7\n");
+print ($! =~ /such/ ? "ok 7\n" : "not ok 7\n");
#!./perl
-# $Header: op.split,v 3.0 89/10/18 15:31:24 lwall Locked $
+# $Header: op.split,v 3.0.1.1 89/11/11 05:01:44 lwall Locked $
print "1..12\n";
# Does assignment to a list imply split to one more field than that?
$foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`;
-print $foo eq '' || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n";
+print $foo =~ /DEBUGGING/ || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n";
# Can we say how many fields to split to when assigning to a list?
($a,$b) = split(' ','1 2 3 4 5 6', 2);
#!./perl
-# $Header: op.stat,v 3.0 89/10/18 15:31:33 lwall Locked $
+# $Header: op.stat,v 3.0.1.1 89/11/11 05:02:46 lwall Locked $
print "1..56\n";
if (-c '/dev/tty') {print "ok 29\n";} else {print "not ok 29\n";}
if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
-if (! -e '/dev/printer' || -S '/dev/printer')
+if (! -e '/dev/printer' || -c '/dev/printer' || -S '/dev/printer')
{print "ok 31\n";}
else
{print "not ok 31\n";}
-/* $Header: a2p.h,v 3.0 89/10/18 15:34:14 lwall Locked $
+/* $Header: a2p.h,v 3.0.1.1 89/11/11 05:07:00 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: a2p.h,v $
+ * Revision 3.0.1.1 89/11/11 05:07:00 lwall
+ * patch2: Configure may now set -DDEBUGGING
+ *
* Revision 3.0 89/10/18 15:34:14 lwall
* 3.0 baseline
*
char *cval;
} ops[OPSMAX]; /* hope they have 200k to spare */
-#define DEBUGGING
-
#include <stdio.h>
#include <ctype.h>
projects / platform / upstream / perl.git / commitdiff