From: Larry Wall Date: Fri, 10 Nov 1989 16:20:25 +0000 (+0000) Subject: perl 3.0 patch #3 Patch #2 continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf38876a182e0df9dd73362f56cf0ab8b43aa789;p=p5sagit%2Fp5-mst-13.2.git perl 3.0 patch #3 Patch #2 continued --- diff --git a/cmd.c b/cmd.c index 2864650..7fc7427 100644 --- a/cmd.c +++ b/cmd.c @@ -1,4 +1,4 @@ -/* $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 * @@ -6,6 +6,10 @@ * 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 * @@ -475,6 +479,7 @@ until_loop: 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; @@ -482,8 +487,17 @@ until_loop: 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; @@ -1060,6 +1074,7 @@ int base; } } +#ifdef DEBUGGING void grow_dlevel() { @@ -1067,3 +1082,4 @@ grow_dlevel() Renew(debname, dlmax, char); Renew(debdelim, dlmax, char); } +#endif diff --git a/config.h.SH b/config.h.SH index 7d069a2..c3c8630 100644 --- a/config.h.SH +++ b/config.h.SH @@ -91,6 +91,12 @@ sed <config.h -e 's!^#undef!/\*#undef!' */ #$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 @@ -376,8 +382,13 @@ sed <config.h -e 's!^#undef!/\*#undef!' /* I_SYSTIME: * This symbol is defined if this system has the file . */ +/* I_TIMETOO: + * This symbol is defined if exists but doesn't include + * . + */ #$d_tminsys TMINSYS /**/ #$i_systime I_SYSTIME /**/ +#$i_timetoo I_TIMETOO /**/ /* VARARGS: * This symbol, if defined, indicates to the C program that it should @@ -412,6 +423,11 @@ sed <config.h -e 's!^#undef!/\*#undef!' #$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. @@ -475,9 +491,9 @@ sed <config.h -e 's!^#undef!/\*#undef!' #$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 diff --git a/consarg.c b/consarg.c index 5a2c84f..b24322e 100644 --- a/consarg.c +++ b/consarg.c @@ -1,4 +1,4 @@ -/* $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 * @@ -6,6 +6,11 @@ * 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 * @@ -304,6 +309,7 @@ register ARG *arg; break; case O_REPEAT: i = (int)str_gnum(s2); + str_nset(str,"",0); while (i-- > 0) str_scat(str,s1); break; @@ -652,6 +658,8 @@ register ARG *arg; 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; @@ -667,6 +675,8 @@ register ARG *arg; 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; @@ -900,6 +910,8 @@ fixeval(arg) 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; diff --git a/doarg.c b/doarg.c index 7ff4d4d..6a45dd6 100644 --- a/doarg.c +++ b/doarg.c @@ -1,4 +1,4 @@ -/* $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 * @@ -6,6 +6,10 @@ * 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 * @@ -505,16 +509,25 @@ register STR **sarg; 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) @@ -524,6 +537,19 @@ register STR **sarg; 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'; diff --git a/doio.c b/doio.c index a50d18f..a2960ad 100644 --- a/doio.c +++ b/doio.c @@ -1,4 +1,4 @@ -/* $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 * @@ -6,6 +6,16 @@ * 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 * @@ -89,61 +99,65 @@ register char *name; 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 @@ -177,21 +191,39 @@ register char *name; (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; } @@ -823,9 +855,10 @@ char *cmd; /* 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"); @@ -841,12 +874,13 @@ char *cmd; *--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 */ @@ -1102,6 +1136,7 @@ int *arglast; 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; @@ -1117,7 +1152,7 @@ int *arglast; nuts: if (dowarn) - warn("shutdown() on closed fd"); + warn("[gs]etsockopt() on closed fd"); st[sp] = &str_undef; return sp; @@ -1143,6 +1178,7 @@ int *arglast; 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: @@ -1159,7 +1195,7 @@ int *arglast; nuts: if (dowarn) - warn("shutdown() on closed fd"); + warn("get{sock,peer}name() on closed fd"); st[sp] = &str_undef; return sp; @@ -1175,7 +1211,7 @@ int *arglast; 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(); @@ -1687,7 +1723,9 @@ int *arglast; register int sp = arglast[1]; register STIO *stio; long along; +#ifndef telldir long telldir(); +#endif struct DIRENT *readdir(); register struct DIRENT *dp; diff --git a/dolist.c b/dolist.c index 0c3b6a6..05e61a3 100644 --- a/dolist.c +++ b/dolist.c @@ -1,4 +1,4 @@ -/* $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 * @@ -6,6 +6,9 @@ * 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 @@ -668,7 +671,7 @@ int *arglast; lval); } else - st[sp-1] = Nullstr; + st[sp-1] = &str_undef; } } else { @@ -681,7 +684,7 @@ int *arglast; str_magic(st[sp-1],stab,magic,tmps,len); } else - st[sp-1] = Nullstr; + st[sp-1] = &str_undef; } } sp--; @@ -691,7 +694,7 @@ int *arglast; 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]) { @@ -702,7 +705,7 @@ int *arglast; str_magic(st[sp],stab,magic,tmps,len); } else - st[sp] = Nullstr; + st[sp] = &str_undef; } } return sp; diff --git a/eval.c b/eval.c index 32da854..5fa73be 100644 --- a/eval.c +++ b/eval.c @@ -1,4 +1,4 @@ -/* $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 * @@ -6,6 +6,11 @@ * 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 * @@ -169,7 +174,6 @@ register int sp; 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 { @@ -1449,29 +1453,59 @@ register int sp; #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)); @@ -1484,7 +1518,7 @@ register int sp; 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: @@ -1968,6 +2002,8 @@ register int sp; 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 @@ -2014,6 +2050,8 @@ register int sp; 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 diff --git a/evalargs.xc b/evalargs.xc index d2b7c64..54b7b7b 100644 --- a/evalargs.xc +++ b/evalargs.xc @@ -2,9 +2,12 @@ * 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 * @@ -232,10 +235,11 @@ 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; @@ -258,24 +262,26 @@ } } 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); diff --git a/hash.c b/hash.c index 6031fa8..fb8e36f 100644 --- a/hash.c +++ b/hash.c @@ -1,4 +1,4 @@ -/* $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 * @@ -6,6 +6,9 @@ * 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 * @@ -377,6 +380,8 @@ register HASH *tb; 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); diff --git a/lib/getopts.pl b/lib/getopts.pl index 9269885..7effafa 100644 --- a/lib/getopts.pl +++ b/lib/getopts.pl @@ -14,16 +14,16 @@ sub Getopts { $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"; @@ -36,7 +36,7 @@ sub Getopts { $ARGV[0] = "-$rest"; } else { - shift; + shift(@ARGV); } } } diff --git a/makedepend.SH b/makedepend.SH index 5cb95c5..000bf71 100644 --- a/makedepend.SH +++ b/makedepend.SH @@ -15,9 +15,12 @@ esac echo "Extracting makedepend (with variable substitutions)" $spitshell >makedepend <>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 @@ -96,7 +86,7 @@ for file in `$cat .clist`; do -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/' \ diff --git a/malloc.c b/malloc.c index 4318a2c..ee926f6 100644 --- a/malloc.c +++ b/malloc.c @@ -1,6 +1,9 @@ -/* $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 @@ -137,13 +140,15 @@ malloc(nbytes) 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 diff --git a/patchlevel.h b/patchlevel.h index e3d7670..558d48c 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 2 +#define PATCHLEVEL 3 diff --git a/t/TEST b/t/TEST index e9ed3e9..a554c34 100644 --- a/t/TEST +++ b/t/TEST @@ -1,6 +1,6 @@ #!./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. @@ -30,6 +30,9 @@ while ($test = shift) { if ($test =~ /\.orig$/) { next; } + if ($test =~ /\.rej$/) { + next; + } if ($test =~ /~$/) { next; } diff --git a/t/io.argv b/t/io.argv index 2284e9f..a66d26f 100644 --- a/t/io.argv +++ b/t/io.argv @@ -1,6 +1,6 @@ #!./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"; @@ -18,7 +18,7 @@ if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\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 (<>) { diff --git a/t/op.magic b/t/op.magic index 9468a35..4b5dba8 100644 --- a/t/op.magic +++ b/t/op.magic @@ -1,6 +1,6 @@ #!./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 @@ -9,8 +9,9 @@ print "1..5\n"; 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 diff --git a/t/op.mkdir b/t/op.mkdir index 93e2ccd..99e04b0 100644 --- a/t/op.mkdir +++ b/t/op.mkdir @@ -1,6 +1,6 @@ #!./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"; @@ -8,8 +8,8 @@ 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"); diff --git a/t/op.split b/t/op.split index 2018ac9..c42b98b 100644 --- a/t/op.split +++ b/t/op.split @@ -1,6 +1,6 @@ #!./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"; @@ -48,7 +48,7 @@ print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\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); diff --git a/t/op.stat b/t/op.stat index 72c18a9..92f907c 100644 --- a/t/op.stat +++ b/t/op.stat @@ -1,6 +1,6 @@ #!./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"; @@ -75,7 +75,7 @@ if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\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";} diff --git a/x2p/a2p.h b/x2p/a2p.h index 5654e8e..b322516 100644 --- a/x2p/a2p.h +++ b/x2p/a2p.h @@ -1,4 +1,4 @@ -/* $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 * @@ -6,6 +6,9 @@ * 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 * @@ -216,8 +219,6 @@ union { char *cval; } ops[OPSMAX]; /* hope they have 200k to spare */ -#define DEBUGGING - #include #include