lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/11/89)
System: perl version 3.0 Patch #: 3 Priority: HIGH Subject: Patch #2 continued Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: *** DO NOT RECOMPILE--APPLY PATCH 4 NEXT *** If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@jpl-devvax.jpl.nasa.gov If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 3.0 LIST ^ note the c where PATH is a return path FROM ME TO YOU either in Internet notation, or in bang notation from some well-known host, and LIST is the number of one or more patches you need, separated by spaces, commas, and/or hyphens. Saying 35- says everything from 35 to the end. You can also get the patches via anonymous FTP from jpl-devvax.jpl.nasa.gov (128.149.1.143). Index: patchlevel.h Prereq: 2 1c1 < #define PATCHLEVEL 2 --- > #define PATCHLEVEL 3 Index: t/TEST Prereq: 3.0 *** t/TEST.old Sat Nov 11 05:18:32 1989 --- t/TEST Sat Nov 11 05:18:34 1989 *************** *** 1,6 **** #!./perl ! # $Header: TEST,v 3.0 89/10/18 15:24:06 lwall Locked $ # This is written in a peculiar style, since we're trying to avoid # most of the constructs we'll be testing for. --- 1,6 ---- #!./perl ! # $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. *************** *** 28,33 **** --- 28,36 ---- $bad = 0; while ($test = shift) { if ($test =~ /\.orig$/) { + next; + } + if ($test =~ /\.rej$/) { next; } if ($test =~ /~$/) { Index: x2p/a2p.h Prereq: 3.0 *** x2p/a2p.h.old Sat Nov 11 05:20:23 1989 --- x2p/a2p.h Sat Nov 11 05:20:25 1989 *************** *** 1,4 **** ! /* $Header: a2p.h,v 3.0 89/10/18 15:34:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: a2p.h,v 3.0.1.1 89/11/11 05:07:00 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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 * *************** *** 215,222 **** int ival; char *cval; } ops[OPSMAX]; /* hope they have 200k to spare */ - - #define DEBUGGING #include <stdio.h> #include <ctype.h> --- 218,223 ---- Index: cmd.c Prereq: 3.0.1.1 *** cmd.c.old Sat Nov 11 05:11:32 1989 --- cmd.c Sat Nov 11 05:11:37 1989 *************** *** 1,4 **** ! /* $Header: cmd.c,v 3.0.1.1 89/10/26 23:04:21 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: cmd.c,v 3.0.1.2 89/11/11 04:08:56 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * 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,480 **** --- 479,485 ---- 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,489 **** 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 { retstr = &str_undef; match = FALSE; --- 487,503 ---- match = TRUE; stab_io(last_in_stab)->lines++; } ! 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,1065 **** --- 1074,1080 ---- } } + #ifdef DEBUGGING void grow_dlevel() { *************** *** 1067,1069 **** --- 1082,1085 ---- Renew(debname, dlmax, char); Renew(debdelim, dlmax, char); } + #endif Index: config.h.SH *** config.h.SH.old Sat Nov 11 05:11:52 1989 --- config.h.SH Sat Nov 11 05:11:55 1989 *************** *** 91,96 **** --- 91,102 ---- */ #$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,383 **** --- 382,394 ---- /* 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 *************** *** 412,417 **** --- 423,433 ---- #$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,483 **** #$i_pwd I_PWD /**/ #$d_pwquota PWQUOTA /**/ #$d_pwage PWAGE /**/ ! #$d_pwage PWCHANGE /**/ ! #$d_pwage PWCLASS /**/ ! #$d_pwage PWEXPIRE /**/ /* I_SYSDIR: * This symbol, if defined, indicates to the C program that it should --- 491,499 ---- #$i_pwd I_PWD /**/ #$d_pwquota PWQUOTA /**/ #$d_pwage PWAGE /**/ ! #$d_pwchange PWCHANGE /**/ ! #$d_pwclass PWCLASS /**/ ! #$d_pwexpire PWEXPIRE /**/ /* I_SYSDIR: * This symbol, if defined, indicates to the C program that it should Index: consarg.c Prereq: 3.0 *** consarg.c.old Sat Nov 11 05:12:09 1989 --- consarg.c Sat Nov 11 05:12:13 1989 *************** *** 1,4 **** ! /* $Header: consarg.c,v 3.0 89/10/18 15:10:30 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: consarg.c,v 3.0.1.1 89/11/11 04:14:30 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * 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,309 **** --- 309,315 ---- break; case O_REPEAT: i = (int)str_gnum(s2); + str_nset(str,"",0); while (i-- > 0) str_scat(str,s1); break; *************** *** 652,657 **** --- 658,665 ---- 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,672 **** --- 675,682 ---- 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,905 **** --- 910,917 ---- 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; Index: doarg.c Prereq: 3.0 *** doarg.c.old Sat Nov 11 05:12:26 1989 --- doarg.c Sat Nov 11 05:12:29 1989 *************** *** 1,4 **** ! /* $Header: doarg.c,v 3.0 89/10/18 15:10:41 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doarg.c,v 3.0.1.1 89/11/11 04:17:20 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * 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,520 **** 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; break; ! case 'd': case 'x': case 'o': case 'u': ch = *(++t); *t = '\0'; if (dolong) --- 509,533 ---- case 'l': dolong = TRUE; break; case 'c': ! 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': ! dolong = TRUE; ! /* FALL THROUGH */ ! case 'd': ch = *(++t); *t = '\0'; if (dolong) *************** *** 521,526 **** --- 534,552 ---- (void)sprintf(buf,s,(long)str_gnum(*(sarg++))); else (void)sprintf(buf,s,(int)str_gnum(*(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; Index: doio.c Prereq: 3.0.1.1 *** doio.c.old Sat Nov 11 05:12:47 1989 --- doio.c Sat Nov 11 05:12:53 1989 *************** *** 1,4 **** ! /* $Header: doio.c,v 3.0.1.1 89/10/26 23:10:05 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: doio.c,v 3.0.1.2 89/11/11 04:25:51 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,21 ---- * 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,149 **** 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 = '-'; - } - else { - mode[0] = 'w'; - fp = fopen(name,mode); - } - writing = 1; - } else { if (*name == '<') { ! for (name++; isspace(*name); name++) ; if (strEQ(name,"-")) { fp = stdin; stio->type = '-'; } ! else { ! mode[0] = 'r'; fp = fopen(name,mode); - } } else if (name[len-1] == '|') { #ifdef TAINT --- 99,163 ---- fp = mypopen(name,"w"); writing = 1; } ! else if (*name == '>') { #ifdef TAINT taintproper("Insecure dependency in open"); #endif ! name++; ! if (*name == '>') { ! mode[0] = stio->type = 'a'; ! name++; ! } ! else ! mode[0] = 'w'; 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 == '<') { ! mode[0] = 'r'; ! name++; ! while (isspace(*name)) ! name++; ! if (*name == '&') ! goto duplicity; if (strEQ(name,"-")) { fp = stdin; stio->type = '-'; } ! else fp = fopen(name,mode); } else if (name[len-1] == '|') { #ifdef TAINT *************** *** 177,197 **** (void)fclose(fp); return FALSE; } ! if ((statbuf.st_mode & S_IFMT) != S_IFREG && #ifdef S_IFSOCK ! (statbuf.st_mode & S_IFMT) != S_IFSOCK && #endif #ifdef S_IFFIFO ! (statbuf.st_mode & S_IFMT) != S_IFFIFO && #endif ! (statbuf.st_mode & S_IFMT) != S_IFCHR) { (void)fclose(fp); return FALSE; } } stio->ifp = fp; ! if (writing) ! stio->ofp = fp; return TRUE; } --- 191,229 ---- (void)fclose(fp); return FALSE; } ! result = (statbuf.st_mode & S_IFMT); ! if (result != S_IFREG && #ifdef S_IFSOCK ! result != S_IFSOCK && #endif #ifdef S_IFFIFO ! result != S_IFFIFO && #endif ! #ifdef S_IFIFO ! result != S_IFIFO && ! #endif ! 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) { ! if (stio->type != 's') ! stio->ofp = fp; ! else ! stio->ofp = fdopen(fileno(fp),"w"); ! } return TRUE; } *************** *** 823,831 **** /* save an extra exec if possible */ ! if (csh > 0 && strnEQ(cmd,"/bin/csh -c",11)) { strcpy(flags,"-c"); ! s = cmd+11; if (*s == 'f') { s++; strcat(flags,"f"); --- 855,864 ---- /* save an extra exec if possible */ ! #ifdef CSH ! if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) { strcpy(flags,"-c"); ! s = cmd+cshlen+3; if (*s == 'f') { s++; strcat(flags,"f"); *************** *** 841,852 **** *--s = '\0'; if (s[-1] == '\'') { *--s = '\0'; ! execl("/bin/csh","csh", flags,ncmd,(char*)0); *s = '\''; return FALSE; } } } /* see if there are shell metacharacters in it */ --- 874,886 ---- *--s = '\0'; if (s[-1] == '\'') { *--s = '\0'; ! execl(cshname,"csh", flags,ncmd,(char*)0); *s = '\''; return FALSE; } } } + #endif /* CSH */ /* see if there are shell metacharacters in it */ *************** *** 1102,1107 **** --- 1136,1142 ---- 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,1123 **** nuts: if (dowarn) ! warn("shutdown() on closed fd"); st[sp] = &str_undef; return sp; --- 1152,1158 ---- nuts: if (dowarn) ! warn("[gs]etsockopt() on closed fd"); st[sp] = &str_undef; return sp; *************** *** 1143,1148 **** --- 1178,1184 ---- 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,1165 **** nuts: if (dowarn) ! warn("shutdown() on closed fd"); st[sp] = &str_undef; return sp; --- 1195,1201 ---- nuts: if (dowarn) ! warn("get{sock,peer}name() on closed fd"); st[sp] = &str_undef; return sp; *************** *** 1175,1181 **** register int sp = arglast[0]; register char **elem; register STR *str; ! struct hostent *gethostbynam(); struct hostent *gethostbyaddr(); #ifdef GETHOSTENT struct hostent *gethostent(); --- 1211,1217 ---- register int sp = arglast[0]; register char **elem; register STR *str; ! struct hostent *gethostbyname(); struct hostent *gethostbyaddr(); #ifdef GETHOSTENT struct hostent *gethostent(); *************** *** 1687,1693 **** --- 1723,1731 ---- register int sp = arglast[1]; register STIO *stio; long along; + #ifndef telldir long telldir(); + #endif struct DIRENT *readdir(); register struct DIRENT *dp; Index: dolist.c Prereq: 3.0.1.1 *** dolist.c.old Sat Nov 11 05:13:14 1989 --- dolist.c Sat Nov 11 05:13:18 1989 *************** *** 1,4 **** ! /* $Header: dolist.c,v 3.0.1.1 89/10/26 23:11:51 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: dolist.c,v 3.0.1.2 89/11/11 04:28:17 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,674 **** lval); } else ! st[sp-1] = Nullstr; } } else { --- 671,677 ---- lval); } else ! st[sp-1] = &str_undef; } } else { *************** *** 681,687 **** str_magic(st[sp-1],stab,magic,tmps,len); } else ! st[sp-1] = Nullstr; } } sp--; --- 684,690 ---- str_magic(st[sp-1],stab,magic,tmps,len); } else ! st[sp-1] = &str_undef; } } sp--; *************** *** 691,697 **** if (st[max]) st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval); else ! st[sp] = Nullstr; } else { if (st[max]) { --- 694,700 ---- if (st[max]) st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval); else ! st[sp] = &str_undef; } else { if (st[max]) { *************** *** 702,708 **** str_magic(st[sp],stab,magic,tmps,len); } else ! st[sp] = Nullstr; } } return sp; --- 705,711 ---- str_magic(st[sp],stab,magic,tmps,len); } else ! st[sp] = &str_undef; } } return sp; Index: eval.c Prereq: 3.0 *** eval.c.old Sat Nov 11 05:13:34 1989 --- eval.c Sat Nov 11 05:13:38 1989 *************** *** 1,4 **** ! /* $Header: eval.c,v 3.0 89/10/18 15:17:04 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: eval.c,v 3.0.1.1 89/11/11 04:31:51 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * 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,175 **** 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 { --- 174,179 ---- *************** *** 1449,1457 **** #endif #ifdef MKDIR value = (double)(mkdir(tmps,anum) >= 0); #else ! (void)sprintf(buf,"mkdir %s 2>&1",tmps); one_liner: rsfp = mypopen(buf,"r"); if (rsfp) { *buf = '\0'; --- 1453,1469 ---- #endif #ifdef MKDIR value = (double)(mkdir(tmps,anum) >= 0); + goto donumset; #else ! (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'; *************** *** 1458,1477 **** tmps2 = fgets(buf,sizeof buf,rsfp); (void)mypclose(rsfp); if (tmps2 != Nullch) { ! for (errno = 1; errno <= sys_nerr; errno++) { if (instr(buf,sys_errlist[errno])) /* you don't see this */ goto say_zero; } errno = 0; goto say_zero; } ! else ! value = 1.0; } else goto say_zero; #endif - goto donumset; case O_RMDIR: if (maxarg < 1) tmps = str_get(stab_val(defstab)); --- 1470,1511 ---- tmps2 = fgets(buf,sizeof buf,rsfp); (void)mypclose(rsfp); if (tmps2 != Nullch) { ! 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 { /* 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 case O_RMDIR: if (maxarg < 1) tmps = str_get(stab_val(defstab)); *************** *** 1484,1490 **** value = (double)(rmdir(tmps) >= 0); goto donumset; #else ! (void)sprintf(buf,"rmdir %s 2>&1",tmps); goto one_liner; /* see above in MKDIR */ #endif case O_GETPPID: --- 1518,1524 ---- value = (double)(rmdir(tmps) >= 0); goto donumset; #else ! (void)strcpy(buf,"rmdir "); goto one_liner; /* see above in MKDIR */ #endif case O_GETPPID: *************** *** 1968,1973 **** --- 2002,2009 ---- 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,2019 **** --- 2050,2057 ---- 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 Index: evalargs.xc Prereq: 3.0.1.1 *** evalargs.xc.old Sat Nov 11 05:13:58 1989 --- evalargs.xc Sat Nov 11 05:14:02 1989 *************** *** 2,10 **** * kit sizes from getting too big. */ ! /* $Header: evalargs.xc,v 3.0.1.1 89/10/26 23:12:55 lwall Locked $ * * $Log: evalargs.xc,v $ * Revision 3.0.1.1 89/10/26 23:12:55 lwall * patch1: glob didn't free a temporary string * --- 2,13 ---- * kit sizes from getting too big. */ ! /* $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,241 **** 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'; goto do_read; case A_READ: last_in_stab = argptr.arg_stab; --- 235,245 ---- argflags |= AF_POST; /* enable newline chopping */ last_in_stab = argptr.arg_stab; old_record_separator = record_separator; ! #ifdef CSH ! record_separator = 0; ! #else ! record_separator = '\n'; ! #endif goto do_read; case A_READ: last_in_stab = argptr.arg_stab; *************** *** 258,281 **** } } fp = nextargv(last_in_stab); ! if (!fp) /* Note: fp != stab_io(last_in_stab)->ifp */ (void)do_close(last_in_stab,FALSE); /* now it does*/ } 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'|"); ! } (void)do_open(last_in_stab,tmpstr->str_ptr); fp = stab_io(last_in_stab)->ifp; str_free(tmpstr); --- 262,287 ---- } } fp = nextargv(last_in_stab); ! 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); ! #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); Index: lib/getopts.pl *** lib/getopts.pl.old Sat Nov 11 05:14:27 1989 --- lib/getopts.pl Sat Nov 11 05:14:29 1989 *************** *** 14,22 **** $pos = index($argumentative,$first); if($pos >= $[) { if($args[$pos+1] eq ':') { ! shift; if($rest eq '') { ! $rest = shift; } eval "\$opt_$first = \$rest;"; } --- 14,22 ---- $pos = index($argumentative,$first); if($pos >= $[) { if($args[$pos+1] eq ':') { ! shift(@ARGV); if($rest eq '') { ! $rest = shift(@ARGV); } eval "\$opt_$first = \$rest;"; } *************** *** 23,29 **** else { eval "\$opt_$first = 1"; if($rest eq '') { ! shift; } else { $ARGV[0] = "-$rest"; --- 23,29 ---- else { eval "\$opt_$first = 1"; if($rest eq '') { ! shift(@ARGV); } else { $ARGV[0] = "-$rest"; *************** *** 36,42 **** $ARGV[0] = "-$rest"; } else { ! shift; } } } --- 36,42 ---- $ARGV[0] = "-$rest"; } else { ! shift(@ARGV); } } } Index: hash.c Prereq: 3.0 *** hash.c.old Sat Nov 11 05:14:13 1989 --- hash.c Sat Nov 11 05:14:16 1989 *************** *** 1,4 **** ! /* $Header: hash.c,v 3.0 89/10/18 15:18:32 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: hash.c,v 3.0.1.1 89/11/11 04:34:18 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,382 **** --- 380,387 ---- 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); Index: t/io.argv Prereq: 3.0 *** t/io.argv.old Sat Nov 11 05:18:43 1989 --- t/io.argv Sat Nov 11 05:18:45 1989 *************** *** 1,6 **** #!./perl ! # $Header: io.argv,v 3.0 89/10/18 15:26:10 lwall Locked $ print "1..5\n"; --- 1,6 ---- #!./perl ! # $Header: io.argv,v 3.0.1.1 89/11/11 04:59:05 lwall Locked $ print "1..5\n"; *************** *** 18,24 **** $x = `echo foo|./perl -e 'while (<>) {print $_;}'`; ! if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3\n";} @ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp'); while (<>) { --- 18,24 ---- $x = `echo foo|./perl -e 'while (<>) {print $_;}'`; ! 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 (<>) { Index: makedepend.SH Prereq: 3.0 *** makedepend.SH.old Sat Nov 11 05:14:37 1989 --- makedepend.SH Sat Nov 11 05:14:40 1989 *************** *** 15,23 **** 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 $ # # $Log: makedepend.SH,v $ # Revision 3.0 89/10/18 15:20:19 lwall # 3.0 baseline # --- 15,26 ---- echo "Extracting makedepend (with variable substitutions)" $spitshell >makedepend <<!GROK!THIS! $startsh ! # $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 # *************** *** 25,31 **** export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) cat='$cat' ! ccflags='$ccflags $sockethdr' cp='$cp' cpp='$cppstdin' echo='$echo' --- 28,34 ---- export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) cat='$cat' ! cppflags='$cppflags' cp='$cp' cpp='$cppstdin' echo='$echo' *************** *** 42,60 **** $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 --- 45,50 ---- *************** *** 96,102 **** -e 's|\\$||' \ -e p \ -e '}' ! $cpp -I/usr/local/include -I. $ccflags $file.c | \ $sed \ -e '/^# *[0-9]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \ --- 86,92 ---- -e 's|\\$||' \ -e p \ -e '}' ! $cpp -I/usr/local/include -I. $cppflags $file.c | \ $sed \ -e '/^# *[0-9]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \ Index: malloc.c Prereq: 3.0.1.1 *** malloc.c.old Sat Nov 11 05:14:52 1989 --- malloc.c Sat Nov 11 05:14:56 1989 *************** *** 1,6 **** ! /* $Header: malloc.c,v 3.0.1.1 89/10/26 23:15:05 lwall Locked $ * * $Log: malloc.c,v $ * 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 --- 1,9 ---- ! /* $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,149 **** if ((p = (union overhead *)nextf[bucket]) == NULL) return (NULL); /* remove from linked list */ ! if (*((int*)p) > 0x10000000) #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; p->ov_magic = MAGIC; p->ov_index= bucket; #ifdef MSTATS --- 140,154 ---- if ((p = (union overhead *)nextf[bucket]) == NULL) return (NULL); /* remove from linked list */ ! #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 ! #endif ! nextf[bucket] = p->ov_next; p->ov_magic = MAGIC; p->ov_index= bucket; #ifdef MSTATS Index: t/op.magic Prereq: 3.0 *** t/op.magic.old Sat Nov 11 05:18:55 1989 --- t/op.magic Sat Nov 11 05:18:57 1989 *************** *** 1,6 **** #!./perl ! # $Header: op.magic,v 3.0 89/10/18 15:29:54 lwall Locked $ $| = 1; # command buffering --- 1,6 ---- #!./perl ! # $Header: op.magic,v 3.0.1.1 89/11/11 05:00:07 lwall Locked $ $| = 1; # command buffering *************** *** 9,16 **** 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";} $! = 0; ! open(foo,'ajslkdfpqjsjfkslkjdflksd'); if ($! == 2) {print "ok 2\n";} else {print "not ok 2\n";} # the next tests are embedded inside system simply because sh spits out --- 9,17 ---- 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,'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 Index: t/op.mkdir Prereq: 3.0 *** t/op.mkdir.old Sat Nov 11 05:19:04 1989 --- t/op.mkdir Sat Nov 11 05:19:06 1989 *************** *** 1,6 **** #!./perl ! # $Header: op.mkdir,v 3.0 89/10/18 15:30:05 lwall Locked $ print "1..7\n"; --- 1,6 ---- #!./perl ! # $Header: op.mkdir,v 3.0.1.1 89/11/11 05:00:47 lwall Locked $ print "1..7\n"; *************** *** 8,15 **** 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 (-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"); --- 8,15 ---- print (mkdir('blurfl',0666) ? "ok 1\n" : "not ok 1\n"); print (mkdir('blurfl',0666) ? "not ok 2\n" : "ok 2\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 ($! =~ /such/ ? "ok 7\n" : "not ok 7\n"); Index: t/op.split Prereq: 3.0 *** t/op.split.old Sat Nov 11 05:19:14 1989 --- t/op.split Sat Nov 11 05:19:16 1989 *************** *** 1,6 **** #!./perl ! # $Header: op.split,v 3.0 89/10/18 15:31:24 lwall Locked $ print "1..12\n"; --- 1,6 ---- #!./perl ! # $Header: op.split,v 3.0.1.1 89/11/11 05:01:44 lwall Locked $ print "1..12\n"; *************** *** 48,54 **** # 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"; # Can we say how many fields to split to when assigning to a list? ($a,$b) = split(' ','1 2 3 4 5 6', 2); --- 48,54 ---- # Does assignment to a list imply split to one more field than that? $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`; ! 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); Index: t/op.stat Prereq: 3.0 *** t/op.stat.old Sat Nov 11 05:19:25 1989 --- t/op.stat Sat Nov 11 05:19:28 1989 *************** *** 1,6 **** #!./perl ! # $Header: op.stat,v 3.0 89/10/18 15:31:33 lwall Locked $ print "1..56\n"; --- 1,6 ---- #!./perl ! # $Header: op.stat,v 3.0.1.1 89/11/11 05:02:46 lwall Locked $ print "1..56\n"; *************** *** 75,81 **** 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') {print "ok 31\n";} else {print "not ok 31\n";} --- 75,81 ---- 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' || -c '/dev/printer' || -S '/dev/printer') {print "ok 31\n";} else {print "not ok 31\n";}