perl 3.0 patch #4
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Sun Nov 12 01:32:49 AEST 1989
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 at 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\', at 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");
More information about the Comp.sources.bugs
mailing list