lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/11/89)
System: perl version 3.0 Patch #: 4 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: *** BEFORE RUNNING CONFIGURE, DELETE OR RENAME YOUR *** *** CURRENT config.sh TO AVOID CONFUSING Configure. *** Configure make depend make make test make install 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: 3 1c1 < #define PATCHLEVEL 3 --- > #define PATCHLEVEL 4 Index: perl.h Prereq: 3.0.1.1 *** perl.h.old Sat Nov 11 05:15:08 1989 --- perl.h Sat Nov 11 05:15:11 1989 *************** *** 1,4 **** ! /* $Header: perl.h,v 3.0.1.1 89/10/26 23:17:08 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.h,v 3.0.1.2 89/11/11 04:39:38 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,17 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.h,v $ + * Revision 3.0.1.2 89/11/11 04:39:38 lwall + * patch2: Configure may now set -DDEBUGGING + * patch2: netinet/in.h needed sys/types.h some places + * patch2: more <sys/time.h> and <time.h> wrangling + * patch2: yydebug moved to where type doesn't matter + * * Revision 3.0.1.1 89/10/26 23:17:08 lwall * patch1: vfork now conditionally defined based on VFORK * patch1: DEC risc machines have a buggy memcmp *************** *** 16,25 **** * */ - #ifndef lint - #define DEBUGGING - #endif - #define VOIDUSED 1 #include "config.h" --- 22,27 ---- *************** *** 51,60 **** #include <setjmp.h> #include <sys/param.h> /* if this needs types.h we're still wrong */ - #ifdef I_NETINET_IN - #include <netinet/in.h> - #endif - #ifndef _TYPES_ /* If types.h defines this it's easy. */ #ifndef major /* Does everyone's types.h define this? */ #include <sys/types.h> --- 53,58 ---- *************** *** 61,77 **** #endif #endif #include <sys/stat.h> ! #ifdef TMINSYS #include <sys/time.h> #else - #ifdef I_SYSTIME - #include <sys/time.h> - #else #include <time.h> #endif - #endif #include <sys/times.h> --- 59,78 ---- #endif #endif + #ifdef I_NETINET_IN + #include <netinet/in.h> + #endif + #include <sys/stat.h> ! #if defined(TMINSYS) || defined(I_SYSTIME) #include <sys/time.h> + #ifdef TIMETOO + #include <time.h> + #endif #else #include <time.h> #endif #include <sys/times.h> *************** *** 93,98 **** --- 94,102 ---- #ifdef NDBM #include <ndbm.h> #define SOME_DBM + #ifdef ODBM + #undef ODBM + #endif #else #ifdef ODBM #ifdef NULL *************** *** 129,135 **** --- 133,143 ---- #define DIRENT dirent #else #ifdef I_SYSDIR + #ifdef hp9000s500 + #include <ndir.h> /* may be wrong in the future */ + #else #include <sys/dir.h> + #endif #define DIRENT direct #endif #endif *************** *** 233,240 **** #define BYTEORDER 01234 #endif #ifndef HTONL ! #if BYTEORDER != 04321 #define HTONS #define HTONL #define NTOHS --- 241,260 ---- #define BYTEORDER 01234 #endif + #if defined(htonl) && !defined(HTONL) + #define HTONL + #endif + #if defined(htons) && !defined(HTONS) + #define HTONS + #endif + #if defined(ntohl) && !defined(NTOHL) + #define NTOHL + #endif + #if defined(ntohs) && !defined(NTOHS) + #define NTOHS + #endif #ifndef HTONL ! #if (BYTEORDER != 04321) && (BYTEORDER != 087654321) #define HTONS #define HTONL #define NTOHS *************** *** 246,252 **** #define ntohl my_ntohl #endif #else ! #if BYTEORDER == 04321 #undef HTONS #undef HTONL #undef NTOHS --- 266,272 ---- #define ntohl my_ntohl #endif #else ! #if (BYTEORDER == 04321) || (BYTEORDER == 087654321) #undef HTONS #undef HTONL #undef NTOHS *************** *** 419,425 **** EXT bool sawi INIT(FALSE); /* study must assume case insensitive */ EXT bool sawvec INIT(FALSE); ! EXT int csh INIT(0); /* 1 if /bin/csh is there, -1 if not */ #ifdef TAINT EXT bool tainted INIT(FALSE); /* using variables controlled by $< */ --- 439,448 ---- EXT bool sawi INIT(FALSE); /* study must assume case insensitive */ EXT bool sawvec INIT(FALSE); ! #ifdef CSH ! char *cshname INIT(CSH); ! int cshlen INIT(0); ! #endif /* CSH */ #ifdef TAINT EXT bool tainted INIT(FALSE); /* using variables controlled by $< */ *************** *** 469,475 **** EXT char *debname; EXT char *debdelim; #define YYDEBUG 1 - extern int yydebug; #endif EXT int perldb INIT(0); --- 492,497 ---- Index: perl.man.1 Prereq: 3.0 *** perl.man.1.old Sat Nov 11 05:15:24 1989 --- perl.man.1 Sat Nov 11 05:15:30 1989 *************** *** 1,7 **** .rn '' }` ! ''' $Header: perl.man.1,v 3.0 89/10/18 15:21:29 lwall Locked $ ''' ''' $Log: perl.man.1,v $ ''' Revision 3.0 89/10/18 15:21:29 lwall ''' 3.0 baseline ''' --- 1,11 ---- .rn '' }` ! ''' $Header: perl.man.1,v 3.0.1.1 89/11/11 04:41:22 lwall Locked $ ''' ''' $Log: perl.man.1,v $ + ''' Revision 3.0.1.1 89/11/11 04:41:22 lwall + ''' patch2: explained about sh and ${1+"$@"} + ''' patch2: documented that space must separate word and '' string + ''' ''' Revision 3.0 89/10/18 15:21:29 lwall ''' 3.0 baseline ''' *************** *** 347,352 **** --- 351,362 ---- .I perl locates the script, it parses the lines and ignores them because the variable $running_under_some_shell is never true. + A better construct than $* would be ${1+"$@"}, which handles embedded spaces + and such in the filenames, but doesn't work if the script is being interpreted + by csh. + In order to start up sh rather than csh, some systems may have to replace the + #! line with a line containing just + a colon, which will be politely ignored by perl. .TP 5 .B \-u causes *************** *** 531,536 **** --- 541,549 ---- .fi Note that you can put curly brackets around the identifier to delimit it from following alphanumerics. + Also note that a single quoted string must be separated from a preceding + word by a space, since single quote is a valid character in an identifier + (see Packages). .PP Array values are interpolated into double-quoted strings by joining all the elements of the array with the delimiter specified in the $" variable, *************** *** 549,555 **** system "echo @ARGV"; .fi ! Within search patterns (which also undergo double-quoteish substitution) there is a bad ambiguity: Is /$foo[bar]/ to be interpreted as /${foo}[bar]/ (where [bar] is a character class for the regular expression) or as /${foo[bar]}/ (where [bar] is the subscript to --- 562,568 ---- system "echo @ARGV"; .fi ! Within search patterns (which also undergo double-quotish substitution) there is a bad ambiguity: Is /$foo[bar]/ to be interpreted as /${foo}[bar]/ (where [bar] is a character class for the regular expression) or as /${foo[bar]}/ (where [bar] is the subscript to Index: perl.man.2 Prereq: 3.0 *** perl.man.2.old Sat Nov 11 05:15:45 1989 --- perl.man.2 Sat Nov 11 05:15:48 1989 *************** *** 1,7 **** ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 3.0 89/10/18 15:21:37 lwall Locked $ ''' ''' $Log: perl.man.2,v $ ''' Revision 3.0 89/10/18 15:21:37 lwall ''' 3.0 baseline ''' --- 1,11 ---- ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 3.0.1.1 89/11/11 04:43:10 lwall Locked $ ''' ''' $Log: perl.man.2,v $ + ''' Revision 3.0.1.1 89/11/11 04:43:10 lwall + ''' patch2: made some line breaks depend on troff vs. nroff + ''' patch2: example of unshift had args backwards + ''' ''' Revision 3.0 89/10/18 15:21:37 lwall ''' 3.0 baseline ''' *************** *** 124,130 **** --- 128,140 ---- print "Files: " $pattern = <STDIN>; chop($pattern); + .ie t \{\ open(pass, \'/etc/passwd\') || die "Can't open passwd: $!\en"; + 'br\} + .el \{\ + open(pass, \'/etc/passwd\') + || die "Can't open passwd: $!\en"; + 'br\} while (<pass>) { ($login,$pass,$uid,$gid) = split(/:/); $uid{$login} = $uid; *************** *** 287,293 **** --- 297,309 ---- .nf .ne 3 + .ie t \{\ die "Can't cd to spool: $!\en" unless chdir \'/usr/spool/news\'; + 'br\} + .el \{\ + die "Can't cd to spool: $!\en" + unless chdir \'/usr/spool/news\'; + 'br\} chdir \'/usr/spool/news\' || die "Can't cd to spool: $!\en" *************** *** 559,564 **** --- 575,581 ---- Note that fcntl will produce a fatal error if used on a machine that doesn't implement fcntl(2). .Ip "fileno(FILEHANDLE)" 8 4 + .Ip "fileno FILEHANDLE" 8 4 Returns the file descriptor for a filehandle. Useful for constructing bitmaps for select(). If FILEHANDLE is an expression, the value is taken as the name of *************** *** 621,627 **** --- 638,650 ---- # An internet sockaddr $sockaddr = 'S n a4 x8'; $hersockaddr = getpeername(S); + .ie t \{\ ($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr); + 'br\} + .el \{\ + ($family, $port, $heraddr) = + unpack($sockaddr,$hersockaddr); + 'br\} .fi .Ip "getpgrp(PID)" 8 4 *************** *** 650,673 **** .Ip "getnetbyaddr(ADDR,ADDRTYPE)" 8 .Ip "getprotobynumber(NUMBER)" 8 .Ip "getservbyport(PORT,PROTO)" 8 ! .Ip "getpwent()" 8 ! .Ip "getgrent()" 8 ! .Ip "gethostent()" 8 ! .Ip "getnetent()" 8 ! .Ip "getprotoent()" 8 ! .Ip "getservent()" 8 ! .Ip "setpwent()" 8 ! .Ip "setgrent()" 8 .Ip "sethostent(STAYOPEN)" 8 .Ip "setnetent(STAYOPEN)" 8 .Ip "setprotoent(STAYOPEN)" 8 .Ip "setservent(STAYOPEN)" 8 ! .Ip "endpwent()" 8 ! .Ip "endgrent()" 8 ! .Ip "endhostent()" 8 ! .Ip "endnetent()" 8 ! .Ip "endprotoent()" 8 ! .Ip "endservent()" 8 These routines perform the same functions as their counterparts in the system library. The return values from the various get routines are as follows: --- 673,696 ---- .Ip "getnetbyaddr(ADDR,ADDRTYPE)" 8 .Ip "getprotobynumber(NUMBER)" 8 .Ip "getservbyport(PORT,PROTO)" 8 ! .Ip "getpwent" 8 ! .Ip "getgrent" 8 ! .Ip "gethostent" 8 ! .Ip "getnetent" 8 ! .Ip "getprotoent" 8 ! .Ip "getservent" 8 ! .Ip "setpwent" 8 ! .Ip "setgrent" 8 .Ip "sethostent(STAYOPEN)" 8 .Ip "setnetent(STAYOPEN)" 8 .Ip "setprotoent(STAYOPEN)" 8 .Ip "setservent(STAYOPEN)" 8 ! .Ip "endpwent" 8 ! .Ip "endgrent" 8 ! .Ip "endhostent" 8 ! .Ip "endnetent" 8 ! .Ip "endprotoent" 8 ! .Ip "endservent" 8 These routines perform the same functions as their counterparts in the system library. The return values from the various get routines are as follows: *************** *** 702,708 **** --- 725,737 ---- # An internet sockaddr $sockaddr = 'S n a4 x8'; $mysockaddr = getsockname(S); + .ie t \{\ ($family, $port, $myaddr) = unpack($sockaddr,$mysockaddr); + 'br\} + .el \{\ + ($family, $port, $myaddr) = + unpack($sockaddr,$mysockaddr); + 'br\} .fi .Ip "getsockopt(SOCKET,LEVEL,OPTNAME)" 8 3 *************** *** 715,721 **** --- 744,756 ---- .nf .ne 3 + .ie t \{\ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time); + 'br\} + .el \{\ + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + gmtime(time); + 'br\} .fi All array elements are numeric, and come straight out of a struct tm. *************** *** 818,824 **** --- 853,865 ---- Example: .nf + .ie t \{\ $_ = join(\|\':\', $login,$passwd,$uid,$gid,$gcos,$home,$shell); + 'br\} + .el \{\ + $_ = join(\|\':\', + $login,$passwd,$uid,$gid,$gcos,$home,$shell); + 'br\} .fi See *************** *** 929,935 **** if ($sw eq \'-v\') { # init local array with global array local(@ARGV) = @ARGV; ! unshift(\'echo\',@ARGV); system @ARGV; } # @ARGV restored --- 970,976 ---- if ($sw eq \'-v\') { # init local array with global array local(@ARGV) = @ARGV; ! unshift(@ARGV,\'echo\'); system @ARGV; } # @ARGV restored *************** *** 954,960 **** --- 995,1007 ---- .nf .ne 3 + .ie t \{\ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); + 'br\} + .el \{\ + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = + localtime(time); + 'br\} .fi All array elements are numeric, and come straight out of a struct tm. *************** *** 970,975 **** --- 1017,1023 ---- .Ip "lstat(FILEHANDLE)" 8 6 .Ip "lstat FILEHANDLE" 8 .Ip "lstat(EXPR)" 8 + .Ip "lstat SCALARVARIABLE" 8 Does the same thing as the stat() function, but stats a symbolic link instead of the file the symbolic link points to. If symbolic links are unimplemented on your system, a normal stat is done. Index: perl.man.3 Prereq: 3.0 *** perl.man.3.old Sat Nov 11 05:16:05 1989 --- perl.man.3 Sat Nov 11 05:16:09 1989 *************** *** 1,7 **** ''' Beginning of part 3 ! ''' $Header: perl.man.3,v 3.0 89/10/18 15:21:46 lwall Locked $ ''' ''' $Log: perl.man.3,v $ ''' Revision 3.0 89/10/18 15:21:46 lwall ''' 3.0 baseline ''' --- 1,10 ---- ''' Beginning of part 3 ! ''' $Header: perl.man.3,v 3.0.1.1 89/11/11 04:45:06 lwall Locked $ ''' ''' $Log: perl.man.3,v $ + ''' Revision 3.0.1.1 89/11/11 04:45:06 lwall + ''' patch2: made some line breaks depend on troff vs. nroff + ''' ''' Revision 3.0 89/10/18 15:21:46 lwall ''' 3.0 baseline ''' *************** *** 71,81 **** --- 74,102 ---- open article || die "Can't find article $article: $!\en"; while (<article>) {\|.\|.\|. + .ie t \{\ open(LOG, \'>>/usr/spool/news/twitlog\'\|); # (log is reserved) + 'br\} + .el \{\ + open(LOG, \'>>/usr/spool/news/twitlog\'\|); + # (log is reserved) + 'br\} + .ie t \{\ open(article, "caesar <$article |"\|); # decrypt article + 'br\} + .el \{\ + open(article, "caesar <$article |"\|); + # decrypt article + 'br\} + .ie t \{\ open(extract, "|sort >/tmp/Tmp$$"\|); # $$ is our process# + 'br\} + .el \{\ + open(extract, "|sort >/tmp/Tmp$$"\|); + # $$ is our process# + 'br\} .ne 7 # process argument list of files along with any includes *************** *** 91,97 **** --- 112,123 ---- print STDERR "Can't open $filename: $!\en"; return; } + .ie t \{\ while (<$input>) { # note the use of indirection + 'br\} + .el \{\ + while (<$input>) { # note use of indirection + 'br\} if (/^#include "(.*)"/) { do process($1, $input); next; *************** *** 105,114 **** with \*(L">&\*(R", in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) which is to be duped and opened. Here is a script that saves, redirects, and restores .I STDOUT and ! .IR STDIN : .nf .ne 21 --- 131,142 ---- with \*(L">&\*(R", in which case the rest of the string is interpreted as the name of a filehandle (or file descriptor, if numeric) which is to be duped and opened. + You may use & after >, >>, <, +>, +>> and +<. + The mode you specify should match the mode of the original filehandle. Here is a script that saves, redirects, and restores .I STDOUT and ! .IR STDERR : .nf .ne 21 *************** *** 229,235 **** $foo = pack("a14","abcdefg"); # "abcdefg\e0\e0\e0\e0\e0\e0\e0" ! $foo = pack("i9pl", gmtime()); # a real struct tm (on my system anyway) .fi --- 257,263 ---- $foo = pack("a14","abcdefg"); # "abcdefg\e0\e0\e0\e0\e0\e0\e0" ! $foo = pack("i9pl", gmtime); # a real struct tm (on my system anyway) .fi *************** *** 312,317 **** --- 340,346 ---- Returns the number of bytes actually read. SCALAR will be grown or shrunk to the length actually read. .Ip "readdir(DIRHANDLE)" 8 3 + .Ip "readdir DIRHANDLE" 8 Returns the next directory entry for a directory opened by opendir(). If used in an array context, returns all the rest of the entries in the directory. *************** *** 535,541 **** --- 564,576 ---- or to block until something becomes ready: + .ie t \{\ $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef); + 'br\} + .el \{\ + $nfound = select($rout=$rin, $wout=$win, + $eout=$ein, undef); + 'br\} .fi Any of the bitmasks can also be undef. *************** *** 731,739 **** .I rand operator. If EXPR is omitted, does srand(time). ! .Ip "stat(FILEHANDLE)" 8 6 .Ip "stat FILEHANDLE" 8 .Ip "stat(EXPR)" 8 Returns a 13-element array giving the statistics for a file, either the file opened via FILEHANDLE, or named by EXPR. Typically used as follows: --- 766,775 ---- .I rand operator. If EXPR is omitted, does srand(time). ! .Ip "stat(FILEHANDLE)" 8 8 .Ip "stat FILEHANDLE" 8 .Ip "stat(EXPR)" 8 + .Ip "stat SCALARVARIABLE" 8 Returns a 13-element array giving the statistics for a file, either the file opened via FILEHANDLE, or named by EXPR. Typically used as follows: *************** *** 830,836 **** You can use the substr() function as an lvalue, in which case EXPR must be an lvalue. If you assign something shorter than LEN, the string will shrink, and ! if you assign something longer than LEN, the string will grow to accomodate it. To keep the string the same length you may need to pad or chop your value using sprintf(). .Ip "syscall(LIST)" 8 6 --- 866,872 ---- You can use the substr() function as an lvalue, in which case EXPR must be an lvalue. If you assign something shorter than LEN, the string will shrink, and ! if you assign something longer than LEN, the string will grow to accommodate it. To keep the string the same length you may need to pad or chop your value using sprintf(). .Ip "syscall(LIST)" 8 6 *************** *** 925,930 **** --- 961,967 ---- .fi .Ip "umask(EXPR)" 8 4 .Ip "umask EXPR" 8 + .Ip "umask" 8 Sets the umask for the process and returns the old one. If EXPR is omitted, merely returns current umask. .Ip "undef(EXPR)" 8 6 *************** *** 1038,1045 **** your program, to protect older programs. .Ip "wait" 8 6 Waits for a child process to terminate and returns the pid of the deceased ! process. The status is returned in $?. .Ip "wantarray" 8 4 Returns true if the context of the currently executing subroutine is looking for an array value. --- 1075,1085 ---- your program, to protect older programs. .Ip "wait" 8 6 Waits for a child process to terminate and returns the pid of the deceased ! process, or -1 if there are no child processes. The status is returned in $?. + If you expected a child and didn't find it, you probably had a call to + system, a close on a pipe, or backticks between the fork and the wait. + These constructs also do a wait and may have harvested your child process. .Ip "wantarray" 8 4 Returns true if the context of the currently executing subroutine is looking for an array value. *************** *** 1054,1060 **** Produces a message on STDERR just like \*(L"die\*(R", but doesn't exit. .Ip "write(FILEHANDLE)" 8 6 .Ip "write(EXPR)" 8 ! .Ip "write(\|)" 8 Writes a formatted record (possibly multi-line) to the specified file, using the format associated with that file. By default the format for a file is the one having the same name is the --- 1094,1100 ---- Produces a message on STDERR just like \*(L"die\*(R", but doesn't exit. .Ip "write(FILEHANDLE)" 8 6 .Ip "write(EXPR)" 8 ! .Ip "write" 8 Writes a formatted record (possibly multi-line) to the specified file, using the format associated with that file. By default the format for a file is the one having the same name is the Index: perl.man.4 Prereq: 3.0.1.1 *** perl.man.4.old Sat Nov 11 05:16:27 1989 --- perl.man.4 Sat Nov 11 05:16:32 1989 *************** *** 1,7 **** ''' Beginning of part 4 ! ''' $Header: perl.man.4,v 3.0.1.1 89/10/26 23:18:43 lwall Locked $ ''' ''' $Log: perl.man.4,v $ ''' Revision 3.0.1.1 89/10/26 23:18:43 lwall ''' patch1: documented the desirability of unnecessary parentheses ''' --- 1,11 ---- ''' Beginning of part 4 ! ''' $Header: perl.man.4,v 3.0.1.2 89/11/11 04:46:40 lwall Locked $ ''' ''' $Log: perl.man.4,v $ + ''' Revision 3.0.1.2 89/11/11 04:46:40 lwall + ''' patch2: made some line breaks depend on troff vs. nroff + ''' patch2: clarified operation of ^ and $ when $* is false + ''' ''' Revision 3.0.1.1 89/10/26 23:18:43 lwall ''' patch1: documented the desirability of unnecessary parentheses ''' *************** *** 218,224 **** This may or may not bother you. .Sp Note that scalars are already passed by reference, so you can modify scalar ! arguments without using this mechanism by refering explicitly to the $_[nnn] in question. You can modify all the elements of an array by passing all the elements as scalars, but you have to use the * mechanism to push, pop or change the --- 222,228 ---- This may or may not bother you. .Sp Note that scalars are already passed by reference, so you can modify scalar ! arguments without using this mechanism by referring explicitly to the $_[nnn] in question. You can modify all the elements of an array by passing all the elements as scalars, but you have to use the * mechanism to push, pop or change the *************** *** 267,278 **** } .fi ! By default, the ^ character matches only the beginning of the string, ! the $ character matches only at the end (or before the newline at the end) and .I perl does certain optimizations with the assumption that the string contains only one line. You may, however, wish to treat a string as a multi-line buffer, such that the ^ will match after any newline within the string, and $ will match before any newline. --- 271,284 ---- } .fi ! By default, the ^ character is only guaranteed to match at the beginning ! of the string, ! the $ character only at the end (or before the newline at the end) and .I perl does certain optimizations with the assumption that the string contains only one line. + The behavior of ^ and $ on embedded newlines will be inconsistent. You may, however, wish to treat a string as a multi-line buffer, such that the ^ will match after any newline within the string, and $ will match before any newline. *************** *** 477,483 **** --- 483,495 ---- ($name, $aliases, $proto) = getprotobyname('tcp'); ($name, $aliases, $port) = getservbyname($port, 'tcp') unless $port =~ /^\ed+$/;; + .ie t \{\ ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname); + 'br\} + .el \{\ + ($name, $aliases, $type, $len, $thisaddr) = + gethostbyname($hostname); + 'br\} ($name, $aliases, $type, $len, $thataddr) = gethostbyname($them); $this = pack($sockaddr, &AF_INET, 0, $thisaddr); *************** *** 532,538 **** ($addr = accept(NS,S)) || die $!; print "accept ok\en"; ! ($af,$port,$inetaddr) = unpack($pat,$addr); @inetaddr = unpack('C4',$inetaddr); print "$af $port @inetaddr\en"; --- 544,550 ---- ($addr = accept(NS,S)) || die $!; print "accept ok\en"; ! ($af,$port,$inetaddr) = unpack($sockaddr,$addr); @inetaddr = unpack('C4',$inetaddr); print "$af $port @inetaddr\en"; *************** *** 1035,1041 **** If you know what version or patchlevel a particular feature was implemented, you can test $] to see if it will be there. .Ip 4. 4 4 ! Choose mnemonic indentifiers. .Ip 5. 4 4 Be consistent. .Sh "Debugging" --- 1047,1053 ---- If you know what version or patchlevel a particular feature was implemented, you can test $] to see if it will be there. .Ip 4. 4 4 ! Choose mnemonic identifiers. .Ip 5. 4 4 Be consistent. .Sh "Debugging" *************** *** 1219,1225 **** If you try to do something insecure, you will get a fatal error saying something like \*(L"Insecure dependency\*(R" or \*(L"Insecure PATH\*(R". Note that you can still write an insecure system call or exec, ! but only by explicity doing something like the last example above. You can also bypass the tainting mechanism by referencing subpatterns\*(--\c .I perl --- 1231,1237 ---- If you try to do something insecure, you will get a fatal error saying something like \*(L"Insecure dependency\*(R" or \*(L"Insecure PATH\*(R". Note that you can still write an insecure system call or exec, ! but only by explicitly doing something like the last example above. You can also bypass the tainting mechanism by referencing subpatterns\*(--\c .I perl *************** *** 1373,1379 **** OFS \h'|2.5i'$, ORS \h'|2.5i'$\e RLENGTH \h'|2.5i'length($&) ! RS \h'|2.5i'$/ RSTART \h'|2.5i'length($\`) SUBSEP \h'|2.5i'$; --- 1385,1391 ---- OFS \h'|2.5i'$, ORS \h'|2.5i'$\e RLENGTH \h'|2.5i'length($&) ! RS \h'|2.5i'$\/ RSTART \h'|2.5i'length($\`) SUBSEP \h'|2.5i'$; Index: perl.y Prereq: 3.0.1.1 *** perl.y.old Sat Nov 11 05:16:51 1989 --- perl.y Sat Nov 11 05:16:55 1989 *************** *** 1,4 **** ! /* $Header: perl.y,v 3.0.1.1 89/10/26 23:20:41 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: perl.y,v 3.0.1.2 89/11/11 04:49:04 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,17 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.y,v $ + * Revision 3.0.1.2 89/11/11 04:49:04 lwall + * patch2: moved yydebug to where its type doesn't matter + * patch2: !$foo++ was unreasonably illegal + * patch2: local(@foo) didn't work + * patch2: default args to unary operators didn't work + * * Revision 3.0.1.1 89/10/26 23:20:41 lwall * patch1: grandfathered "format stdout" * patch1: operator(); is now normally equivalent to operator; *************** *** 82,92 **** %% /* RULES */ ! prog : lineseq { if (in_eval) ! eval_root = block_head($1); else ! main_root = block_head($1); } ; compblock: block CONTINUE block --- 88,104 ---- %% /* RULES */ ! prog : /* NULL */ ! { ! #if defined(YYDEBUG) && defined(DEBUGGING) ! yydebug = (debug & 1); ! #endif ! } ! /*CONTINUED*/ lineseq { if (in_eval) ! eval_root = block_head($2); else ! main_root = block_head($2); } ; compblock: block CONTINUE block *************** *** 379,396 **** { $$ = mod_match(O_MATCH, $1, $3); } | sexpr NMATCH sexpr { $$ = mod_match(O_NMATCH, $1, $3); } - | term INC - { $$ = addflags(1, AF_POST|AF_UP, - l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); } - | term DEC - { $$ = addflags(1, AF_POST, - l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); } - | INC term - { $$ = addflags(1, AF_PRE|AF_UP, - l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); } - | DEC term - { $$ = addflags(1, AF_PRE, - l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); } | term { $$ = $1; } ; --- 391,396 ---- *************** *** 403,408 **** --- 403,420 ---- { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); } | '~' term { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);} + | term INC + { $$ = addflags(1, AF_POST|AF_UP, + l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); } + | term DEC + { $$ = addflags(1, AF_POST, + l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); } + | INC term + { $$ = addflags(1, AF_PRE|AF_UP, + l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); } + | DEC term + { $$ = addflags(1, AF_PRE, + l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); } | FILETEST WORD { opargs[$1] = 0; /* force it special */ $$ = make_op($1, 1, *************** *** 419,427 **** $1 == O_FTTTY?stabent("STDIN",TRUE):defstab), Nullarg, Nullarg); } | LOCAL '(' expr ')' ! { $$ = l(make_op(O_ITEM, 1, localize(listish(make_list($3))), ! Nullarg,Nullarg)); } | '(' expr ')' { $$ = make_list(hide_ary($2)); } | '(' ')' --- 431,439 ---- $1 == O_FTTTY?stabent("STDIN",TRUE):defstab), Nullarg, Nullarg); } | LOCAL '(' expr ')' ! { $$ = l(localize(make_op(O_ASSIGN, 1, localize(listish(make_list($3))), ! Nullarg,Nullarg))); } | '(' expr ')' { $$ = make_list(hide_ary($2)); } | '(' ')' *************** *** 533,539 **** { $$ = make_op($1,1,cval_to_arg($2), Nullarg,Nullarg); } | UNIOP ! { $$ = make_op($1,1,Nullarg,Nullarg,Nullarg); if ($1 == O_EVAL || $1 == O_RESET) $$ = fixeval($$); } | UNIOP sexpr --- 545,551 ---- { $$ = make_op($1,1,cval_to_arg($2), Nullarg,Nullarg); } | UNIOP ! { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); if ($1 == O_EVAL || $1 == O_RESET) $$ = fixeval($$); } | UNIOP sexpr *************** *** 642,649 **** Nullarg, Nullarg)); } | FUNC0 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); } | FUNC1 '(' ')' ! { $$ = make_op($1, 1, Nullarg, Nullarg, Nullarg); if ($1 == O_EVAL || $1 == O_RESET) $$ = fixeval($$); } | FUNC1 '(' expr ')' --- 654,663 ---- Nullarg, Nullarg)); } | FUNC0 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); } + | FUNC0 '(' ')' + { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); } | FUNC1 '(' ')' ! { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); if ($1 == O_EVAL || $1 == O_RESET) $$ = fixeval($$); } | FUNC1 '(' expr ')' Index: perly.c Prereq: 3.0 *** perly.c.old Sat Nov 11 05:17:09 1989 --- perly.c Sat Nov 11 05:17:12 1989 *************** *** 1,4 **** ! char rcsid[] = "$Header: perly.c,v 3.0 89/10/18 15:22:21 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! char rcsid[] = "$Header: perly.c,v 3.0.1.1 89/11/11 04:50:04 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perly.c,v $ + * Revision 3.0.1.1 89/11/11 04:50:04 lwall + * patch2: moved yydebug to where its type didn't matter + * * Revision 3.0 89/10/18 15:22:21 lwall * 3.0 baseline * *************** *** 92,109 **** perldb = TRUE; s++; goto reswitch; - #ifdef DEBUGGING case 'D': #ifdef TAINT if (euid != uid || egid != gid) fatal("No -D allowed in setuid scripts"); #endif debug = atoi(s+1); ! #ifdef YYDEBUG ! yydebug = (debug & 1); #endif break; - #endif case 'e': #ifdef TAINT if (euid != uid || egid != gid) --- 95,111 ---- perldb = TRUE; s++; goto reswitch; case 'D': + #ifdef DEBUGGING #ifdef TAINT if (euid != uid || egid != gid) fatal("No -D allowed in setuid scripts"); #endif debug = atoi(s+1); ! #else ! warn("Recompile perl with -DDEBUGGING to use -D switch\n"); #endif break; case 'e': #ifdef TAINT if (euid != uid || egid != gid) *************** *** 531,538 **** fatal("Execution aborted due to compilation errors.\n"); New(50,loop_stack,128,struct loop); ! New(51,debname,128,char); ! New(52,debdelim,128,char); curstash = defstash; preprocess = FALSE; --- 533,544 ---- fatal("Execution aborted due to compilation errors.\n"); New(50,loop_stack,128,struct loop); ! #ifdef DEBUGGING ! if (debug) { ! New(51,debname,128,char); ! New(52,debdelim,128,char); ! } ! #endif curstash = defstash; preprocess = FALSE; Index: regcomp.c Prereq: 3.0 *** regcomp.c.old Sat Nov 11 05:17:25 1989 --- regcomp.c Sat Nov 11 05:17:28 1989 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regcomp.c,v 3.0 89/10/18 15:22:29 lwall Locked $ * * $Log: regcomp.c,v $ * Revision 3.0 89/10/18 15:22:29 lwall * 3.0 baseline * --- 7,18 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regcomp.c,v 3.0.1.1 89/11/11 04:51:04 lwall Locked $ * * $Log: regcomp.c,v $ + * Revision 3.0.1.1 89/11/11 04:51:04 lwall + * patch2: /[\000]/ didn't work + * * Revision 3.0 89/10/18 15:22:29 lwall * 3.0 baseline * *************** *** 874,880 **** } if (*regparse != ']') FAIL("unmatched [] in regexp"); - regset(bits,0,0); /* always bomb out on null */ regparse++; return ret; } --- 877,882 ---- Index: regexec.c Prereq: 3.0 *** regexec.c.old Sat Nov 11 05:17:42 1989 --- regexec.c Sat Nov 11 05:17:45 1989 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regexec.c,v 3.0 89/10/18 15:22:53 lwall Locked $ * * $Log: regexec.c,v $ * Revision 3.0 89/10/18 15:22:53 lwall * 3.0 baseline * --- 7,18 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regexec.c,v 3.0.1.1 89/11/11 04:52:04 lwall Locked $ * * $Log: regexec.c,v $ + * Revision 3.0.1.1 89/11/11 04:52:04 lwall + * patch2: /\b$foo/ didn't work + * * Revision 3.0 89/10/18 15:22:53 lwall * 3.0 baseline * *************** *** 262,268 **** } s++; } ! if (tmp && regtry(prog,s)) goto got_it; break; case NBOUND: --- 265,271 ---- } s++; } ! if ((minlen || tmp) && regtry(prog,s)) goto got_it; break; case NBOUND: *************** *** 282,288 **** goto got_it; s++; } ! if (!tmp && regtry(prog,s)) goto got_it; break; case ALNUM: --- 285,291 ---- goto got_it; s++; } ! if ((minlen || !tmp) && regtry(prog,s)) goto got_it; break; case ALNUM: Index: x2p/s2p.SH Prereq: 3.0 *** x2p/s2p.SH.old Sat Nov 11 05:20:38 1989 --- x2p/s2p.SH Sat Nov 11 05:20:40 1989 *************** *** 28,36 **** : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' ! # $Header: s2p.SH,v 3.0 89/10/18 15:35:02 lwall Locked $ # # $Log: s2p.SH,v $ # Revision 3.0 89/10/18 15:35:02 lwall # 3.0 baseline # --- 28,40 ---- : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' ! # $Header: s2p.SH,v 3.0.1.1 89/11/11 05:08:25 lwall Locked $ # # $Log: s2p.SH,v $ + # Revision 3.0.1.1 89/11/11 05:08:25 lwall + # patch2: in s2p, + within patterns needed backslashing + # patch2: s2p was printing out some debugging info to the output file + # # Revision 3.0 89/10/18 15:35:02 lwall # 3.0 baseline # *************** *** 418,424 **** elsif ($c eq ']') { $inbracket = 0; } ! elsif (!$repl && index("()",$c) >= 0) { $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000); $i++; $len++; --- 422,428 ---- elsif ($c eq ']') { $inbracket = 0; } ! elsif (!$repl && index("()+",$c) >= 0) { $_ = substr($_,0,$i) . '\\' . substr($_,$i,10000); $i++; $len++; *************** *** 583,592 **** local($inbracket); local($prefix,$delim,$ch); ! delim: while (s:^([^\](|)[\\/]*)([](|)[\\/])::) { $prefix = $1; $delim = $2; - print "$prefix\t$delim\t$_\n"; if ($delim eq '\\') { s/(.)//; $ch = $1; --- 587,595 ---- local($inbracket); local($prefix,$delim,$ch); ! delim: while (s:^([^\]+(|)[\\/]*)([]+(|)[\\/])::) { $prefix = $1; $delim = $2; if ($delim eq '\\') { s/(.)//; $ch = $1; *************** *** 597,609 **** $inbracket = 1; s/^\^// && ($delim .= '^'); s/^]// && ($delim .= ']'); - print "$prefix\t$delim\t$_\n"; } elsif ($delim eq ']') { $inbracket = 0; } elsif ($inbracket || $delim ne $outer) { - print "Adding\n"; $delim = '\\' . $delim; } $addr .= $prefix; --- 600,610 ---- Index: stab.c Prereq: 3.0 *** stab.c.old Sat Nov 11 05:17:58 1989 --- stab.c Sat Nov 11 05:18:00 1989 *************** *** 1,4 **** ! /* $Header: stab.c,v 3.0 89/10/18 15:23:23 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.c,v 3.0.1.1 89/11/11 04:55:07 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: stab.c,v $ + * Revision 3.0.1.1 89/11/11 04:55:07 lwall + * patch2: sys_errlist[sys_nerr] is illegal + * * Revision 3.0 89/10/18 15:23:23 lwall * 3.0 baseline * *************** *** 140,146 **** case '!': str_numset(stab_val(stab), (double)errno); str_set(stab_val(stab), ! errno < 0 || errno > sys_nerr ? "(unknown)" : sys_errlist[errno]); stab_val(stab)->str_nok = 1; /* what a wonderful hack! */ break; case '<': --- 143,149 ---- case '!': str_numset(stab_val(stab), (double)errno); str_set(stab_val(stab), ! errno < 0 || errno >= sys_nerr ? "(unknown)" : sys_errlist[errno]); stab_val(stab)->str_nok = 1; /* what a wonderful hack! */ break; case '<': Index: str.c Prereq: 3.0.1.1 *** str.c.old Sat Nov 11 05:18:14 1989 --- str.c Sat Nov 11 05:18:19 1989 *************** *** 1,4 **** ! /* $Header: str.c,v 3.0.1.1 89/10/26 23:23:41 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.c,v 3.0.1.2 89/11/11 04:56:22 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: str.c,v $ + * Revision 3.0.1.2 89/11/11 04:56:22 lwall + * patch2: uchar gives Crays fits + * * Revision 3.0.1.1 89/10/26 23:23:41 lwall * patch1: string ordering tests were wrong * patch1: $/ now works even when STDSTDIO undefined *************** *** 840,846 **** else if (*d == '[' && s[-1] == ']') { /* char class? */ int weight = 2; /* let's weigh the evidence */ char seen[256]; ! unsigned char uchar = 0, lastuchar; Zero(seen,256,char); *--s = '\0'; --- 843,849 ---- else if (*d == '[' && s[-1] == ']') { /* char class? */ int weight = 2; /* let's weigh the evidence */ char seen[256]; ! unsigned char unchar = 0, lastunchar; Zero(seen,256,char); *--s = '\0'; *************** *** 857,868 **** weight -= 100; } for (d++; d < s; d++) { ! lastuchar = uchar; ! uchar = (unsigned char)*d; switch (*d) { case '&': case '$': ! weight -= seen[uchar] * 10; if (isalpha(d[1]) || isdigit(d[1]) || d[1] == '_') { d = scanreg(d,s,tokenbuf); --- 860,871 ---- weight -= 100; } for (d++; d < s; d++) { ! lastunchar = unchar; ! unchar = (unsigned char)*d; switch (*d) { case '&': case '$': ! weight -= seen[unchar] * 10; if (isalpha(d[1]) || isdigit(d[1]) || d[1] == '_') { d = scanreg(d,s,tokenbuf); *************** *** 880,886 **** } break; case '\\': ! uchar = 254; if (d[1]) { if (index("wds",d[1])) weight += 100; --- 883,889 ---- } break; case '\\': ! unchar = 254; if (d[1]) { if (index("wds",d[1])) weight += 100; *************** *** 898,905 **** weight += 100; break; case '-': ! if (lastuchar < d[1] || d[1] == '\\') { ! if (index("aA01! ",lastuchar)) weight += 30; if (index("zZ79~",d[1])) weight += 30; --- 901,908 ---- weight += 100; break; case '-': ! if (lastunchar < d[1] || d[1] == '\\') { ! if (index("aA01! ",lastunchar)) weight += 30; if (index("zZ79~",d[1])) weight += 30; *************** *** 913,924 **** weight -= 150; d = bufptr; } ! if (uchar == lastuchar + 1) weight += 5; ! weight -= seen[uchar]; break; } ! seen[uchar]++; } #ifdef DEBUGGING if (debug & 512) --- 916,927 ---- weight -= 150; d = bufptr; } ! if (unchar == lastunchar + 1) weight += 5; ! weight -= seen[unchar]; break; } ! seen[unchar]++; } #ifdef DEBUGGING if (debug & 512) Index: toke.c Prereq: 3.0.1.1 *** toke.c.old Sat Nov 11 05:19:42 1989 --- toke.c Sat Nov 11 05:19:49 1989 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0.1.1 89/10/26 23:26:21 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.2 89/11/11 05:04:42 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: toke.c,v $ + * Revision 3.0.1.2 89/11/11 05:04:42 lwall + * patch2: fixed a CLINE macro conflict + * * Revision 3.0.1.1 89/10/26 23:26:21 lwall * patch1: disambiguated word after "sort" better * *************** *** 20,25 **** --- 23,31 ---- char *reparse; /* if non-null, scanreg found ${foo[$bar]} */ + #ifdef CLINE + #undef CLINE + #endif #define CLINE (cmdline = (line < cmdline ? line : cmdline)) #define META(c) ((c) | 128) *************** *** 86,92 **** retry: #ifdef YYDEBUG ! if (yydebug) if (index(s,'\n')) fprintf(stderr,"Tokener at %s",s); else --- 92,98 ---- retry: #ifdef YYDEBUG ! if (debug & 1) if (index(s,'\n')) fprintf(stderr,"Tokener at %s",s); else *************** *** 159,165 **** } #endif bufend = linestr->str_ptr + linestr->str_cur; ! firstline = FALSE; goto retry; case ' ': case '\t': case '\f': s++; --- 165,177 ---- } #endif bufend = linestr->str_ptr + linestr->str_cur; ! if (firstline) { ! while (s < bufend && isspace(*s)) ! s++; ! if (*s == ':') /* for csh's that have to exec sh scripts */ ! s++; ! firstline = FALSE; ! } goto retry; case ' ': case '\t': case '\f': s++; *************** *** 2094,2103 **** set_csh() { ! if (!csh) { ! if (stat("/bin/csh",&statbuf) < 0) ! csh = -1; ! else ! csh = 1; ! } } --- 2106,2113 ---- set_csh() { ! #ifdef CSH ! if (!cshlen) ! cshlen = strlen(cshname); ! #endif } Index: util.c Prereq: 3.0 *** util.c.old Sat Nov 11 05:20:06 1989 --- util.c Sat Nov 11 05:20:10 1989 *************** *** 1,4 **** ! /* $Header: util.c,v 3.0 89/10/18 15:32:43 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: util.c,v 3.0.1.1 89/11/11 05:06:13 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: util.c,v $ + * Revision 3.0.1.1 89/11/11 05:06:13 lwall + * patch2: made dup2 a little better + * * Revision 3.0 89/10/18 15:32:43 lwall * 3.0 baseline * *************** *** 1089,1094 **** --- 1092,1106 ---- close(p[THIS]); } if (doexec) { + #if !defined(FCNTL) || !defined(F_SETFD) + int fd; + + #ifndef NOFILE + #define NOFILE 20 + #endif + for (fd = 3; fd < NOFILE; fd++) + close(fd); + #endif do_exec(cmd); /* may or may not use the shell */ _exit(1); } *************** *** 1106,1118 **** return fdopen(p[this], mode); } #ifndef DUP2 dup2(oldfd,newfd) int oldfd; int newfd; { close(newfd); ! while (dup(oldfd) != newfd) ; /* good enough for our purposes */ } #endif --- 1118,1153 ---- return fdopen(p[this], mode); } + #ifdef NOTDEF + dumpfds(s) + char *s; + { + int fd; + struct stat tmpstatbuf; + + fprintf(stderr,"%s", s); + for (fd = 0; fd < 32; fd++) { + if (fstat(fd,&tmpstatbuf) >= 0) + fprintf(stderr," %d",fd); + } + fprintf(stderr,"\n"); + } + #endif + #ifndef DUP2 dup2(oldfd,newfd) int oldfd; int newfd; { + int fdtmp[10]; + int fdx = 0; + int fd; + close(newfd); ! while ((fd = dup(oldfd)) != newfd) /* good enough for low fd's */ ! fdtmp[fdx++] = fd; ! while (fdx > 0) ! close(fdtmp[--fdx]); } #endif Index: x2p/walk.c Prereq: 3.0 *** x2p/walk.c.old Sat Nov 11 05:20:53 1989 --- x2p/walk.c Sat Nov 11 05:20:57 1989 *************** *** 1,4 **** ! /* $Header: walk.c,v 3.0 89/10/18 15:35:48 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: walk.c,v 3.0.1.1 89/11/11 05:09:33 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: walk.c,v $ + * Revision 3.0.1.1 89/11/11 05:09:33 lwall + * patch2: in a2p, awk script with no line actions still needs main loop + * * Revision 3.0 89/10/18 15:35:48 lwall * 3.0 baseline * *************** *** 139,145 **** str_cat(str,"continue {\n $FNRbase = $. if eof;\n}\n"); } else ! str_cat(str,"# (no line actions)\n"); if (ops[node+4].ival) { realexit = TRUE; str_cat(str,"\n"); --- 142,148 ---- str_cat(str,"continue {\n $FNRbase = $. if eof;\n}\n"); } else ! str_cat(str,"while (<>) { } # (no line actions)\n"); if (ops[node+4].ival) { realexit = TRUE; str_cat(str,"\n");