lwall@netlabs.com (Larry Wall) (06/20/91)
Submitted-by: Larry Wall <lwall@netlabs.com> Posting-number: Volume 20, Issue 59 Archive-name: perl/patch07 Patch-To: perl: Volume 18, Issue 19-54 System: perl version 4.0 Patch #: 7 Priority: High Subject: patch #4, continued Description: See patch #4. 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 NOTHING--INSTALL ALL PATCHES UP THROUGH #09 FIRST *** 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@netlabs.com If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 4.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. Index: patchlevel.h Prereq: 6 1c1 < #define PATCHLEVEL 6 --- > #define PATCHLEVEL 7 Index: x2p/hash.c Prereq: 4.0 *** x2p/hash.c.old Fri Jun 7 12:28:04 1991 --- x2p/hash.c Fri Jun 7 12:28:05 1991 *************** *** 1,11 **** ! /* $Header: hash.c,v 4.0 91/03/20 01:57:49 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: hash.c,v $ * Revision 4.0 91/03/20 01:57:49 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: hash.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:15:55 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: hash.c,v $ + * Revision 4.0.1.1 91/06/07 12:15:55 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:57:49 lwall * 4.0 baseline. * Index: hash.h Prereq: 4.0 *** hash.h.old Fri Jun 7 12:24:15 1991 --- hash.h Fri Jun 7 12:24:15 1991 *************** *** 1,11 **** ! /* $Header: hash.h,v 4.0 91/03/20 01:22:38 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: hash.h,v $ * Revision 4.0 91/03/20 01:22:38 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: hash.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:10:33 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: hash.h,v $ + * Revision 4.0.1.1 91/06/07 11:10:33 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:22:38 lwall * 4.0 baseline. * Index: x2p/hash.h Prereq: 4.0 *** x2p/hash.h.old Fri Jun 7 12:28:07 1991 --- x2p/hash.h Fri Jun 7 12:28:07 1991 *************** *** 1,11 **** ! /* $Header: hash.h,v 4.0 91/03/20 01:57:53 lwall Locked $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: hash.h,v $ * Revision 4.0 91/03/20 01:57:53 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: hash.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:16:04 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: hash.h,v $ + * Revision 4.0.1.1 91/06/07 12:16:04 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:57:53 lwall * 4.0 baseline. * Index: hints/hpux.sh *** hints/hpux.sh.old Fri Jun 7 12:24:28 1991 --- hints/hpux.sh Fri Jun 7 12:24:29 1991 *************** *** 1,4 **** - d_syscall=$undef echo " " echo "NOTE: regression test op.read may fail due to an NFS bug in HP/UX." echo "If so, don't worry about it." --- 1,7 ---- echo " " echo "NOTE: regression test op.read may fail due to an NFS bug in HP/UX." echo "If so, don't worry about it." + case `(uname -r) 2>/dev/null` in + *3.1*) d_syscall=$undef ;; + *2.1*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;; + esac Index: installperl *** installperl.old Fri Jun 7 12:25:08 1991 --- installperl Fri Jun 7 12:25:08 1991 *************** *** 6,13 **** shift; } ! @scripts = 'h2ph'; ! @manpages = ('perl.man', 'h2ph.man'); $version = sprintf("%5.3f", $]); $release = substr($version,0,3); --- 6,13 ---- shift; } ! @scripts = ('h2ph', 'x2p/s2p', 'x2p/find2perl'); ! @manpages = ('perl.man', 'h2ph.man', 'x2p/a2p.man', 'x2p/s2p.man'); $version = sprintf("%5.3f", $]); $release = substr($version,0,3); *************** *** 72,77 **** --- 72,85 ---- &link("$installbin/sperl$ver", "$installbin/suidperl") if $d_dosuid; } + ($bdev,$bino) = stat($installbin); + ($ddev,$dino) = stat('x2p'); + + if ($bdev != $ddev || $bino != $dino) { + &unlink("$installbin/a2p"); + &cmd("cp x2p/a2p $installbin/a2p"); + } + # Make some enemies in the name of standardization. :-) ($udev,$uino) = stat("/usr/bin"); *************** *** 85,95 **** # Install scripts. ! &makedir($scriptdir); for (@scripts) { ! &cmd("cp $_ $scriptdir"); ! &chmod(0755, "$scriptdir/$_"); } # Install library files. --- 93,103 ---- # Install scripts. ! &makedir($installscr); for (@scripts) { ! &cmd("cp $_ $installscr"); ! s#.*/##; &chmod(0755, "$installscr/$_"); } # Install library files. *************** *** 111,116 **** --- 119,125 ---- if ($mdev != $ddev || $mino != $dino) { for (@manpages) { ($new = $_) =~ s/man$/$manext/; + $new =~ s#.*/##; print STDERR " Installing $mansrc/$new\n"; next if $nonono; open(MI,$_); Index: makedepend.SH Prereq: 4.0 *** makedepend.SH.old Fri Jun 7 12:25:25 1991 --- makedepend.SH Fri Jun 7 12:25:26 1991 *************** *** 15,23 **** echo "Extracting makedepend (with variable substitutions)" $spitshell >makedepend <<!GROK!THIS! $startsh ! # $Header: makedepend.SH,v 4.0 91/03/20 01:27:04 lwall Locked $ # # $Log: makedepend.SH,v $ # Revision 4.0 91/03/20 01:27:04 lwall # 4.0 baseline. # --- 15,29 ---- echo "Extracting makedepend (with variable substitutions)" $spitshell >makedepend <<!GROK!THIS! $startsh ! # $RCSfile: makedepend.SH,v $$Revision: 4.0.1.2 $$Date: 91/06/07 15:40:06 $ # # $Log: makedepend.SH,v $ + # Revision 4.0.1.2 91/06/07 15:40:06 lwall + # patch4: fixed cppstdin to run in the right directory + # + # Revision 4.0.1.1 91/06/07 11:20:06 lwall + # patch4: Makefile is no longer self-modifying code under makedepend + # # Revision 4.0 91/03/20 01:27:04 lwall # 4.0 baseline. # *************** *** 28,34 **** cat='$cat' cppflags='$cppflags' cp='$cp' ! cpp='$cppstdin' echo='$echo' egrep='$egrep' expr='$expr' --- 34,41 ---- cat='$cat' cppflags='$cppflags' cp='$cp' ! cppstdin='$cppstdin' ! cppminus='$cppminus' echo='$echo' egrep='$egrep' expr='$expr' *************** *** 46,55 **** $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then ! mf=Makefile ! else ! mf=makefile fi if test -f $mf; then defrule=`<$mf sed -n \ -e '/^\.c\.o:.*;/{' \ --- 53,61 ---- $cat /dev/null >.deptmp $rm -f *.c.c c/*.c.c if test -f Makefile; then ! cp Makefile makefile fi + mf=makefile if test -f $mf; then defrule=`<$mf sed -n \ -e '/^\.c\.o:.*;/{' \ *************** *** 84,90 **** -e 's|\\$||' \ -e p \ -e '}' ! $cpp -I/usr/local/include -I. $cppflags $file.c | \ $sed \ -e '/^# *[0-9]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \ --- 90,96 ---- -e 's|\\$||' \ -e p \ -e '}' ! $cppstdin -I/usr/local/include -I. $cppflags $cppminus <$file.c | sed -e 's#\.[0-9][0-9]*\.c#'"$file.c#" | \ $sed \ -e '/^# *[0-9]/!d' \ -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \ *************** *** 93,144 **** $uniq | $sort | $uniq >> .deptmp done ! $sed <Makefile >Makefile.new -e '1,/^# AUTOMATICALLY/!d' make shlist || ($echo "Searching for .SH files..."; \ $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist) if $test -s .deptmp; then for file in `cat .shlist`; do ! $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \ /bin/sh $file >> .deptmp done ! $echo "Updating Makefile..." $echo "# If this runs make out of memory, delete /usr/include lines." \ ! >> Makefile.new $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ ! >>Makefile.new else make hlist || ($echo "Searching for .h files..."; \ $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist) $echo "You don't seem to have a proper C preprocessor. Using grep instead." $egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp ! $echo "Updating Makefile..." <.clist $sed -n \ -e '/\//{' \ -e 's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p" \ -e d \ -e '}' \ ! -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> Makefile.new <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \ $sed 's|^[^;]*/||' | \ ! $sed -f .hsed >> Makefile.new <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \ ! >> Makefile.new <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \ ! $sed -f .hsed >> Makefile.new <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \ ! >> Makefile.new for file in `$cat .shlist`; do ! $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \ ! /bin/sh $file >> Makefile.new done fi ! $rm -f Makefile.old ! $cp Makefile Makefile.old ! $cp Makefile.new Makefile ! $rm Makefile.new ! $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> Makefile $rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed !NO!SUBS! --- 99,150 ---- $uniq | $sort | $uniq >> .deptmp done ! $sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d' make shlist || ($echo "Searching for .SH files..."; \ $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist) if $test -s .deptmp; then for file in `cat .shlist`; do ! $echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \ /bin/sh $file >> .deptmp done ! $echo "Updating $mf..." $echo "# If this runs make out of memory, delete /usr/include lines." \ ! >> $mf.new $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ ! >>$mf.new else make hlist || ($echo "Searching for .h files..."; \ $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist) $echo "You don't seem to have a proper C preprocessor. Using grep instead." $egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp ! $echo "Updating $mf..." <.clist $sed -n \ -e '/\//{' \ -e 's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p" \ -e d \ -e '}' \ ! -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> $mf.new <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \ $sed 's|^[^;]*/||' | \ ! $sed -f .hsed >> $mf.new <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \ ! >> $mf.new <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \ ! $sed -f .hsed >> $mf.new <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \ ! >> $mf.new for file in `$cat .shlist`; do ! $echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \ ! /bin/sh $file >> $mf.new done fi ! $rm -f $mf.old ! $cp $mf $mf.old ! $cp $mf.new $mf ! $rm $mf.new ! $echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf $rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed !NO!SUBS! Index: malloc.c *** malloc.c.old Fri Jun 7 12:25:29 1991 --- malloc.c Fri Jun 7 12:25:30 1991 *************** *** 1,6 **** ! /* $RCSfile: malloc.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:48:31 $ * * $Log: malloc.c,v $ * Revision 4.0.1.1 91/04/11 17:48:31 lwall * patch1: Configure now figures out malloc ptr type * --- 1,9 ---- ! /* $RCSfile: malloc.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:20:45 $ * * $Log: malloc.c,v $ + * Revision 4.0.1.2 91/06/07 11:20:45 lwall + * patch4: many, many itty-bitty portability fixes + * * Revision 4.0.1.1 91/04/11 17:48:31 lwall * patch1: Configure now figures out malloc ptr type * *************** *** 160,166 **** p->ov_rmagic = RMAGIC; *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC; #endif ! return ((char *)(p + 1)); } /* --- 163,169 ---- p->ov_rmagic = RMAGIC; *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC; #endif ! return ((MALLOCPTRTYPE *)(p + 1)); } /* *************** *** 230,240 **** } void ! free(cp) ! char *cp; { register int size; register union overhead *op; if (cp == NULL) return; --- 233,244 ---- } void ! free(mp) ! MALLOCPTRTYPE *mp; { register int size; register union overhead *op; + char *cp = (char*)mp; if (cp == NULL) return; *************** *** 277,284 **** int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */ MALLOCPTRTYPE * ! realloc(cp, nbytes) ! char *cp; unsigned nbytes; { register u_int onb; --- 281,288 ---- int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */ MALLOCPTRTYPE * ! realloc(mp, nbytes) ! MALLOCPTRTYPE *mp; unsigned nbytes; { register u_int onb; *************** *** 286,291 **** --- 290,296 ---- char *res; register int i; int was_alloced = 0; + char *cp = (char*)mp; if (cp == NULL) return (malloc(nbytes)); *************** *** 331,345 **** *((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC; } #endif ! return(cp); } ! if ((res = malloc(nbytes)) == NULL) return (NULL); if (cp != res) /* common optimization */ (void)bcopy(cp, res, (int)((nbytes < onb) ? nbytes : onb)); if (was_alloced) free(cp); ! return (res); } /* --- 336,350 ---- *((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC; } #endif ! return((MALLOCPTRTYPE*)cp); } ! if ((res = (char*)malloc(nbytes)) == NULL) return (NULL); if (cp != res) /* common optimization */ (void)bcopy(cp, res, (int)((nbytes < onb) ? nbytes : onb)); if (was_alloced) free(cp); ! return ((MALLOCPTRTYPE*)res); } /* Index: hints/mips.sh *** hints/mips.sh.old Fri Jun 7 12:24:31 1991 --- hints/mips.sh Fri Jun 7 12:24:31 1991 *************** *** 1,6 **** ! optimize='-g' d_volatile=undef d_castneg=undef cc=cc libpth="/usr/lib/cmplrs/cc $libpth" groupstype=int --- 1,17 ---- ! cmd_cflags='optimize="-g"' ! perl_cflags='optimize="-g"' ! tcmd_cflags='optimize="-g"' ! tperl_cflags='optimize="-g"' d_volatile=undef d_castneg=undef cc=cc libpth="/usr/lib/cmplrs/cc $libpth" groupstype=int + nm_opts='-B' + case $PATH in + *bsd*:/bin:*) cat <<END + NOTE: Some people have reported having much better luck with Mips CC than + with the BSD cc. Put /bin first in your PATH if you have difficulties. + END + ;; + esac Index: h2pl/mkvars *** h2pl/mkvars.old Fri Jun 7 12:24:06 1991 --- h2pl/mkvars Fri Jun 7 12:24:06 1991 *************** *** 19,25 **** $val = eval "&$var;"; if ($@) { warn "$@: $_"; ! print <<EOT warn "\$$var isn't correctly set" if defined \$_main{'$var'}; EOT next; --- 19,25 ---- $val = eval "&$var;"; if ($@) { warn "$@: $_"; ! print <<EOT; warn "\$$var isn't correctly set" if defined \$_main{'$var'}; EOT next; Index: msdos/msdos.c Prereq: 4.0 *** msdos/msdos.c.old Fri Jun 7 12:25:45 1991 --- msdos/msdos.c Fri Jun 7 12:25:45 1991 *************** *** 1,11 **** ! /* $Header: msdos.c,v 4.0 91/03/20 01:34:46 lwall Locked $ * * (C) Copyright 1989, 1990 Diomidis Spinellis. * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: msdos.c,v $ * Revision 4.0 91/03/20 01:34:46 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: msdos.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:37 $ * * (C) Copyright 1989, 1990 Diomidis Spinellis. * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: msdos.c,v $ + * Revision 4.0.1.1 91/06/07 11:22:37 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:34:46 lwall * 4.0 baseline. * Index: lib/newgetopt.pl *** lib/newgetopt.pl.old Fri Jun 7 12:25:16 1991 --- lib/newgetopt.pl Fri Jun 7 12:25:16 1991 *************** *** 0 **** --- 1,204 ---- + # newgetopt.pl -- new options parsing + + # SCCS Status : @(#)@ newgetopt.pl 1.7 + # Author : Johan Vromans + # Created On : Tue Sep 11 15:00:12 1990 + # Last Modified By: Johan Vromans + # Last Modified On: Sun Oct 14 14:35:36 1990 + # Update Count : 34 + # Status : Okay + + # This package implements a new getopt function. This function adheres + # to the new syntax (long option names, no bundling). + # + # Arguments to the function are: + # + # - a list of possible options. These should designate valid perl + # identifiers, optionally followed by an argument specifier ("=" + # for mandatory arguments or ":" for optional arguments) and an + # argument type specifier: "n" or "i" for integer numbers, "f" for + # real (fix) numbers or "s" for strings. + # + # - if the first option of the list consists of non-alphanumeric + # characters only, it is interpreted as a generic option starter. + # Everything starting with one of the characters from the starter + # will be considered an option. + # Likewise, a double occurrence (e.g. "--") signals end of + # the options list. + # The default value for the starter is "-". + # + # Upon return, the option variables, prefixed with "opt_", are defined + # and set to the respective option arguments, if any. + # Options that do not take an argument are set to 1. Note that an + # option with an optional argument will be defined, but set to '' if + # no actual argument has been supplied. + # A return status of 0 (false) indicates that the function detected + # one or more errors. + # + # Special care is taken to give a correct treatment to optional arguments. + # + # E.g. if option "one:i" (i.e. takes an optional integer argument), + # then the following situations are handled: + # + # -one -two -> $opt_one = '', -two is next option + # -one -2 -> $opt_one = -2 + # + # Also, assume "foo=s" and "bar:s" : + # + # -bar -xxx -> $opt_bar = '', '-xxx' is next option + # -foo -bar -> $opt_foo = '-bar' + # -foo -- -> $opt_foo = '--' + # + + # HISTORY + # 20-Sep-1990 Johan Vromans + # Set options w/o argument to 1. + # Correct the dreadful semicolon/require bug. + + + package newgetopt; + + $debug = 0; # for debugging + + sub main'NGetOpt { + local (@optionlist) = @_; + local ($[) = 0; + local ($genprefix) = "-"; + local ($error) = 0; + local ($opt, $optx, $arg, $type, $mand, @hits); + + # See if the first element of the optionlist contains option + # starter characters. + $genprefix = shift (@optionlist) if $optionlist[0] =~ /^\W+$/; + + # Turn into regexp. + $genprefix =~ s/(\W)/\\\1/g; + $genprefix = "[" . $genprefix . "]"; + + # Verify correctness of optionlist. + @hits = grep ($_ !~ /^\w+([=:][infse])?$/, @optionlist); + if ( $#hits >= 0 ) { + foreach $opt ( @hits ) { + print STDERR ("Error in option spec: \"", $opt, "\"\n"); + $error++; + } + return 0; + } + + # Process argument list + + while ( $#main'ARGV >= 0 ) { #'){ + + # >>> See also the continue block <<< + + # Get next argument + $opt = shift (@main'ARGV); #'); + print STDERR ("=> option \"", $opt, "\"\n") if $debug; + $arg = undef; + + # Check for exhausted list. + if ( $opt =~ /^$genprefix/o ) { + # Double occurrence is terminator + return ($error == 0) if $opt eq "$+$+"; + $opt = $'; # option name (w/o prefix) + } + else { + # Apparently not an option - push back and exit. + unshift (@main'ARGV, $opt); #'); + return ($error == 0); + } + + # Grep in option list. Hide regexp chars from option. + ($optx = $opt) =~ s/(\W)/\\\1/g; + @hits = grep (/^$optx([=:].+)?$/, @optionlist); + if ( $#hits != 0 ) { + print STDERR ("Unknown option: ", $opt, "\n"); + $error++; + next; + } + + # Determine argument status. + undef $type; + $type = $+ if $hits[0] =~ /[=:].+$/; + print STDERR ("=> found \"$hits[0]\" for ", $opt, "\n") if $debug; + + # If it is an option w/o argument, we're almost finished with it. + if ( ! defined $type ) { + $arg = 1; # supply explicit value + next; + } + + # Get mandatory status and type info. + ($mand, $type) = $type =~ /^(.)(.)$/; + + # Check if the argument list is exhausted. + if ( $#main'ARGV < 0 ) { #'){ + + # Complain if this option needs an argument. + if ( $mand eq "=" ) { + print STDERR ("Option ", $opt, " requires an argument\n"); + $error++; + } + next; + } + + # Get (possibly optional) argument. + $arg = shift (@main'ARGV); #'); + + # Check if it is a valid argument. A mandatory string takes + # anything. + if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/o ) { + + # Check for option list terminator. + if ( $arg eq "$+$+" ) { + # Complain if an argument is required. + if ($mand eq "=") { + print STDERR ("Option ", $opt, " requires an argument\n"); + $error++; + } + # Push back so the outer loop will terminate. + unshift (@main'ARGV, $arg); #'); + $arg = ""; # don't assign it + next; + } + + # Maybe the optional argument is the next option? + if ( $mand eq ":" && $' =~ /[a-zA-Z_]/ ) { + # Yep. Push back. + unshift (@main'ARGV, $arg); #'); + $arg = ""; # don't assign it + next; + } + } + + if ( $type eq "n" || $type eq "i" ) { # numeric/integer + if ( $arg !~ /^-?[0-9]+$/ ) { + print STDERR ("Value \"", $arg, "\" invalid for option ", + $opt, " (numeric required)\n"); + $error++; + } + next; + } + + if ( $type eq "f" ) { # fixed real number, int is also ok + if ( $arg !~ /^-?[0-9.]+$/ ) { + print STDERR ("Value \"", $arg, "\" invalid for option ", + $opt, " (real number required)\n"); + $error++; + } + next; + } + + if ( $type eq "s" ) { # string + next; + } + + } + continue { + print STDERR ("=> \$main'opt_$opt = $arg\n") if $debug; + eval ("\$main'opt_$opt = \$arg"); + } + + return ($error == 0); + } + 1; Index: hints/next.sh *** hints/next.sh.old Fri Jun 7 12:24:33 1991 --- hints/next.sh Fri Jun 7 12:24:34 1991 *************** *** 1,2 **** : Just disable defaulting to -fpcc-struct-return, since gcc is native compiler. ! ccflags="$ccflags " --- 1,4 ---- : Just disable defaulting to -fpcc-struct-return, since gcc is native compiler. ! nativegcc='define' ! groupstype="int" ! usemymalloc="n" Index: os2/os2.c Prereq: 4.0 *** os2/os2.c.old Fri Jun 7 12:25:51 1991 --- os2/os2.c Fri Jun 7 12:25:52 1991 *************** *** 1,11 **** ! /* $Header: os2.c,v 4.0 91/03/20 01:36:21 lwall Locked $ * * (C) Copyright 1989, 1990 Diomidis Spinellis. * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: os2.c,v $ * Revision 4.0 91/03/20 01:36:21 lwall * 4.0 baseline. * --- 1,14 ---- ! /* $RCSfile: os2.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:23:06 $ * * (C) Copyright 1989, 1990 Diomidis Spinellis. * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: os2.c,v $ + * Revision 4.0.1.1 91/06/07 11:23:06 lwall + * patch4: new copyright notice + * * Revision 4.0 91/03/20 01:36:21 lwall * 4.0 baseline. * Index: t/op/pat.t Prereq: 4.0 *** t/op/pat.t.old Fri Jun 7 12:27:08 1991 --- t/op/pat.t Fri Jun 7 12:27:09 1991 *************** *** 1,8 **** #!./perl ! # $Header: pat.t,v 4.0 91/03/20 01:54:01 lwall Locked $ ! print "1..43\n"; $x = "abc\ndef\n"; --- 1,8 ---- #!./perl ! # $RCSfile: pat.t,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:01:26 $ ! print "1..48\n"; $x = "abc\ndef\n"; *************** *** 118,120 **** --- 118,176 ---- print $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n"; print /x {3,4}/ ? "not ok 42\n" : "ok 42\n"; print /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n"; + + $_ = "now is the time for all good men to come to."; + @words = /(\w+)/g; + print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to" + ? "ok 44\n" + : "not ok 44\n"; + + @words = (); + while (/\w+/g) { + push(@words, $&); + } + print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to" + ? "ok 45\n" + : "not ok 45\n"; + + @words = (); + while (/to/g) { + push(@words, $&); + } + print join(':',@words) eq "to:to" + ? "ok 46\n" + : "not ok 46 @words\n"; + + @words = /to/g; + print join(':',@words) eq "to:to" + ? "ok 47\n" + : "not ok 47 @words\n"; + + $_ = "abcdefghi"; + + $pat1 = 'def'; + $pat2 = '^def'; + $pat3 = '.def.'; + $pat4 = 'abc'; + $pat5 = '^abc'; + $pat6 = 'abc$'; + $pat7 = 'ghi'; + $pat8 = '\w*ghi'; + $pat9 = 'ghi$'; + + $t1=$t2=$t3=$t4=$t5=$t6=$t7=$t8=$t9=0; + + for $iter (1..5) { + $t1++ if /$pat1/o; + $t2++ if /$pat2/o; + $t3++ if /$pat3/o; + $t4++ if /$pat4/o; + $t5++ if /$pat5/o; + $t6++ if /$pat6/o; + $t7++ if /$pat7/o; + $t8++ if /$pat8/o; + $t9++ if /$pat9/o; + } + + $x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9"; + print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n"; Index: emacs/perl-mode.el *** emacs/perl-mode.el.old Fri Jun 7 12:23:45 1991 --- emacs/perl-mode.el Fri Jun 7 12:23:46 1991 *************** *** 572,578 **** (or arg (setq arg 1)) (if (< arg 0) (forward-char 1)) (and (/= arg 0) ! (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=" nil 'move arg) (goto-char (1- (match-end 0)))) (point)) --- 572,578 ---- (or arg (setq arg 1)) (if (< arg 0) (forward-char 1)) (and (/= arg 0) ! (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\." nil 'move arg) (goto-char (1- (match-end 0)))) (point)) Index: perl.c *** perl.c.old Fri Jun 7 12:25:55 1991 --- perl.c Fri Jun 7 12:25:57 1991 *************** *** 1,11 **** ! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:05 $\nPatch level: ###\n"; /* ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.c,v $ * Revision 4.0.1.1 91/04/11 17:49:05 lwall * patch1: fixed undefined environ problem * --- 1,20 ---- ! char rcsid[] = "$RCSfile: perl.c,v $$Revision: 4.0.1.3 $$Date: 91/06/07 11:40:18 $\nPatch level: ###\n"; /* ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: perl.c,v $ + * Revision 4.0.1.3 91/06/07 11:40:18 lwall + * patch4: changed old $^P to $^X + * + * Revision 4.0.1.2 91/06/07 11:26:16 lwall + * patch4: new copyright notice + * patch4: added $^P variable to control calling of perldb routines + * patch4: added $^F variable to specify maximum system fd, default 2 + * patch4: debugger lost track of lines in eval + * * Revision 4.0.1.1 91/04/11 17:49:05 lwall * patch1: fixed undefined environ problem * *************** *** 23,28 **** --- 32,39 ---- #include "patchlevel.h" #endif + char *getenv(); + #ifdef IAMSUID #ifndef DOSUID #define DOSUID *************** *** 50,56 **** { register STR *str; register char *s; ! char *index(), *strcpy(), *getenv(); bool dosearch = FALSE; #ifdef DOSUID char *validarg = ""; --- 61,67 ---- { register STR *str; register char *s; ! char *getenv(); bool dosearch = FALSE; #ifdef DOSUID char *validarg = ""; *************** *** 656,662 **** (void)hadd(sigstab); } ! magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\024\027"); userinit(); /* in case linked C routines want magical variables */ amperstab = stabent("&",allstabs); --- 667,673 ---- (void)hadd(sigstab); } ! magicalize("!#?^~=-%.+&*()<>,\\/[|`':\004\t\020\024\027\006"); userinit(); /* in case linked C routines want magical variables */ amperstab = stabent("&",allstabs); *************** *** 740,746 **** str_set(stab_val(tmpstab),origfilename); magicname("0", Nullch, 0); } ! if (tmpstab = stabent("\020",allstabs)) str_set(stab_val(tmpstab),origargv[0]); if (argvstab = stabent("ARGV",allstabs)) { argvstab->str_pok |= SP_MULTI; --- 751,757 ---- str_set(stab_val(tmpstab),origfilename); magicname("0", Nullch, 0); } ! if (tmpstab = stabent("\030",allstabs)) str_set(stab_val(tmpstab),origargv[0]); if (argvstab = stabent("ARGV",allstabs)) { argvstab->str_pok |= SP_MULTI; *************** *** 830,835 **** --- 841,871 ---- } } + void + savelines(array, str) + ARRAY *array; + STR *str; + { + register char *s = str->str_ptr; + register char *send = str->str_ptr + str->str_cur; + register char *t; + register int line = 1; + + while (s && s < send) { + STR *tmpstr = Str_new(85,0); + + t = index(s, '\n'); + if (t) + t++; + else + t = send; + + str_nset(tmpstr, s, t - s); + astore(array, line++, tmpstr); + s = t; + } + } + /* this routine is in perl.c by virtue of being sort of an alternate main() */ int *************** *** 871,877 **** curcmd->c_filestab = fstab("(eval)"); curcmd->c_line = 1; str_sset(linestr,str); ! str_cat(linestr,";"); /* be kind to them */ } else { if (last_root && !in_eval) { --- 907,915 ---- curcmd->c_filestab = fstab("(eval)"); curcmd->c_line = 1; str_sset(linestr,str); ! str_cat(linestr,";\n"); /* be kind to them */ ! if (perldb) ! savelines(stab_xarray(curcmd->c_filestab), linestr); } else { if (last_root && !in_eval) { *************** *** 1201,1206 **** --- 1239,1247 ---- fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname); exit(status); #else + #ifdef MSDOS + abort(); /* nothing else to do */ + #else /* ! MSDOS */ # ifndef SIGABRT # define SIGABRT SIGILL # endif *************** *** 1208,1213 **** --- 1249,1255 ---- # define SIGILL 6 /* blech */ # endif kill(getpid(),SIGABRT); /* for use with undump */ + #endif /* ! MSDOS */ #endif } Index: perl.h *** perl.h.old Fri Jun 7 12:26:00 1991 --- perl.h Fri Jun 7 12:26:01 1991 *************** *** 1,11 **** ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:49:51 $ * ! * Copyright (c) 1989, Larry Wall * ! * You may distribute under the terms of the GNU General Public License ! * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.h,v $ * Revision 4.0.1.1 91/04/11 17:49:51 lwall * patch1: hopefully straightened out some of the Xenix mess * --- 1,16 ---- ! /* $RCSfile: perl.h,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:28:33 $ * ! * Copyright (c) 1991, Larry Wall * ! * You may distribute under the terms of either the GNU General Public ! * License or the Artistic License, as specified in the README file. * * $Log: perl.h,v $ + * Revision 4.0.1.2 91/06/07 11:28:33 lwall + * patch4: new copyright notice + * patch4: made some allowances for "semi-standard" C + * patch4: many, many itty-bitty portability fixes + * * Revision 4.0.1.1 91/04/11 17:49:51 lwall * patch1: hopefully straightened out some of the Xenix mess * *************** *** 47,53 **** #endif /* !MSDOS */ ! #if defined(HASVOLATILE) || defined(__STDC__) #define VOLATILE volatile #else #define VOLATILE --- 52,62 ---- #endif /* !MSDOS */ ! #if defined(__STDC__) || defined(_AIX) || defined(__stdc__) ! # define STANDARD_C 1 ! #endif ! ! #if defined(HASVOLATILE) || defined(STANDARD_C) #define VOLATILE volatile #else #define VOLATILE *************** *** 81,93 **** #include <ctype.h> #include <setjmp.h> #ifndef MSDOS ! #include <sys/param.h> /* if this needs types.h we're still wrong */ #endif ! #ifdef __STDC__ /* Use all the "standard" definitions */ #include <stdlib.h> #include <string.h> ! #endif /* __STDC__ */ #if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234 #undef HAS_MEMCMP --- 90,105 ---- #include <ctype.h> #include <setjmp.h> #ifndef MSDOS ! #ifdef PARAM_NEEDS_TYPES ! #include <sys/types.h> #endif ! #include <sys/param.h> ! #endif ! #ifdef STANDARD_C /* Use all the "standard" definitions */ #include <stdlib.h> #include <string.h> ! #endif /* STANDARD_C */ #if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234 #undef HAS_MEMCMP *************** *** 95,113 **** #ifdef HAS_MEMCPY ! # ifndef __STDC__ # ifndef memcpy extern char * memcpy(), *memset(); extern int memcmp(); # endif /* ndef memcpy */ ! # endif /* ndef __STDC__ */ ! #define bcopy(s1,s2,l) memcpy(s2,s1,l) ! #define bzero(s,l) memset(s,0,l) #endif /* HAS_MEMCPY */ #ifndef HAS_BCMP /* prefer bcmp slightly 'cuz it doesn't order */ ! #define bcmp(s1,s2,l) memcmp(s1,s2,l) #endif #ifndef _TYPES_ /* If types.h defines this it's easy. */ --- 107,131 ---- #ifdef HAS_MEMCPY ! # ifndef STANDARD_C # ifndef memcpy extern char * memcpy(), *memset(); extern int memcmp(); # endif /* ndef memcpy */ ! # endif /* ndef STANDARD_C */ ! # ifndef bcopy ! # define bcopy(s1,s2,l) memcpy(s2,s1,l) ! # endif ! # ifndef bzero ! # define bzero(s,l) memset(s,0,l) ! # endif #endif /* HAS_MEMCPY */ #ifndef HAS_BCMP /* prefer bcmp slightly 'cuz it doesn't order */ ! # ifndef bcmp ! # define bcmp(s1,s2,l) memcmp(s1,s2,l) ! # endif #endif #ifndef _TYPES_ /* If types.h defines this it's easy. */ *************** *** 245,250 **** --- 263,275 ---- # endif #endif + #ifdef FPUTS_BOTCH + /* work around botch in SunOS 4.0.1 and 4.0.2 */ + # ifndef fputs + # define fputs(str,fp) fprintf(fp,"%s",str) + # endif + #endif + /* * The following gobbledygook brought to you on behalf of __STDC__. * (I could just use #ifndef __STDC__, but this is more bulletproof *************** *** 345,350 **** --- 370,379 ---- # define S_ISGID 02000 #endif + #ifdef f_next + #undef f_next + #endif + typedef unsigned int STRLEN; typedef struct arg ARG; *************** *** 377,383 **** # define I286 #endif ! #ifndef __STDC__ #ifdef CHARSPRINTF char *sprintf(); #else --- 406,412 ---- # define I286 #endif ! #ifndef STANDARD_C #ifdef CHARSPRINTF char *sprintf(); #else *************** *** 681,686 **** --- 710,720 ---- EXT bool sawvec INIT(FALSE); EXT bool localizing INIT(FALSE); /* are we processing a local() list? */ + #ifndef MAXSYSFD + # define MAXSYSFD 2 + #endif + EXT int maxsysfd INIT(MAXSYSFD); /* top fd to pass to subprocesses */ + #ifdef CSH char *cshname INIT(CSH); int cshlen INIT(0); *************** *** 790,796 **** /* Fix these up for __STDC__ */ EXT long basetime INIT(0); char *mktemp(); ! #ifndef __STDC__ /* All of these are in stdlib.h or time.h for ANSI C */ double atof(); long time(); --- 824,830 ---- /* Fix these up for __STDC__ */ EXT long basetime INIT(0); char *mktemp(); ! #ifndef STANDARD_C /* All of these are in stdlib.h or time.h for ANSI C */ double atof(); long time(); *************** *** 797,803 **** struct tm *gmtime(), *localtime(); char *index(), *rindex(); char *strcpy(), *strcat(); ! #endif /* ! __STDC__ */ #ifdef EUNICE #define UNLINK unlnk --- 831,837 ---- struct tm *gmtime(), *localtime(); char *index(), *rindex(); char *strcpy(), *strcat(); ! #endif /* ! STANDARD_C */ #ifdef EUNICE #define UNLINK unlnk Index: perl.man *** perl.man.old Fri Jun 7 12:26:10 1991 --- perl.man Fri Jun 7 12:26:13 1991 *************** *** 1,7 **** .rn '' }` ! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $ ''' ''' $Log: perl.man,v $ ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall ''' patch1: fixed some typos ''' --- 1,14 ---- .rn '' }` ! ''' $RCSfile: perl.man,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:41:23 $ ''' ''' $Log: perl.man,v $ + ''' Revision 4.0.1.2 91/06/07 11:41:23 lwall + ''' patch4: added global modifier for pattern matches + ''' patch4: default top-of-form format is now FILEHANDLE_TOP + ''' patch4: added $^P variable to control calling of perldb routines + ''' patch4: added $^F variable to specify maximum system fd, default 2 + ''' patch4: changed old $^P to $^X + ''' ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall ''' patch1: fixed some typos ''' *************** *** 1606,1663 **** (getpwuid($<))[7] || die "You're homeless!\en"; .fi - ''' Beginning of part 2 - ''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $ - ''' - ''' $Log: perl.man,v $ - ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall - ''' patch1: fixed some typos - ''' - ''' Revision 4.0 91/03/20 01:38:08 lwall - ''' 4.0 baseline. - ''' - ''' Revision 3.0.1.11 91/01/11 18:17:08 lwall - ''' patch42: fixed some man page entries - ''' - ''' Revision 3.0.1.10 90/11/10 01:46:29 lwall - ''' patch38: random cleanup - ''' patch38: added alarm function - ''' - ''' Revision 3.0.1.9 90/10/15 18:17:37 lwall - ''' patch29: added caller - ''' patch29: index and substr now have optional 3rd args - ''' patch29: added SysV IPC - ''' - ''' Revision 3.0.1.8 90/08/13 22:21:00 lwall - ''' patch28: documented that you can't interpolate $) or $| in pattern - ''' - ''' Revision 3.0.1.7 90/08/09 04:27:04 lwall - ''' patch19: added require operator - ''' - ''' Revision 3.0.1.6 90/08/03 11:15:29 lwall - ''' patch19: Intermediate diffs for Randal - ''' - ''' Revision 3.0.1.5 90/03/27 16:15:17 lwall - ''' patch16: MSDOS support - ''' - ''' Revision 3.0.1.4 90/03/12 16:46:02 lwall - ''' patch13: documented behavior of @array = /noparens/ - ''' - ''' Revision 3.0.1.3 90/02/28 17:55:58 lwall - ''' patch9: grep now returns number of items matched in scalar context - ''' patch9: documented in-place modification capabilites of grep - ''' - ''' Revision 3.0.1.2 89/11/17 15:30:16 lwall - ''' patch5: fixed some manual typos and indent problems - ''' - ''' 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 - ''' - ''' .PP Along with the literals and variables mentioned earlier, the operations in the following section can serve as terms in an expression. --- 1613,1618 ---- *************** *** 1796,1802 **** .fi .ne 23 ! Here's an example of looking up non-numeric uids: .nf print "User: "; --- 1751,1757 ---- .fi .ne 23 ! Here's an example that looks up non-numeric uids in the passwd file: .nf print "User: "; *************** *** 2718,2725 **** 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. ! .Ip "m/PATTERN/io" 8 4 ! .Ip "/PATTERN/io" 8 Searches a string for a pattern match, and returns true (1) or false (\'\'). If no string is specified via the =~ or !~ operator, the $_ string is searched. --- 2673,2680 ---- 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. ! .Ip "m/PATTERN/gio" 8 4 ! .Ip "/PATTERN/gio" 8 Searches a string for a pattern match, and returns true (1) or false (\'\'). If no string is specified via the =~ or !~ operator, the $_ string is searched. *************** *** 2778,2783 **** --- 2733,2768 ---- of the line, and assigns those three fields to $F1, $F2 and $Etc. The conditional is true if any variables were assigned, i.e. if the pattern matched. + .Sp + The \*(L"g\*(R" modifier specifies global pattern matching\*(--that is, + matching as many times as possible within the string. How it behaves + depends on the context. In an array context, it returns a list of + all the substrings matched by all the parentheses in the regular expression. + If there are no parentheses, it returns a list of all the matched strings, + as if there were parentheses around the whole pattern. In a scalar context, + it iterates through the string, returning TRUE each time it matches, and + FALSE when it eventually runs out of matches. (In other words, it remembers + where it left off last time and restarts the search at that point.) It + presumes that you have not modified the string since the last match. + Modifying the string between matches may result in undefined behavior. + (You can actually get away with in-place modifications via substr() + that do not change the length of the entire string. In general, however, + you should be using s///g for such modifications.) Examples: + .nf + + # array context + ($one,$five,$fifteen) = (\`uptime\` =~ /(\ed+\e.\ed+)/g); + + # scalar context + $/ = 1; $* = 1; + while ($paragraph = <>) { + while ($paragraph =~ /[a-z][\'")]*[.!?]+[\'")]*\es/g) { + $sentences++; + } + } + print "$sentences\en"; + + .fi .Ip "mkdir(FILENAME,MODE)" 8 3 Creates the directory specified by FILENAME, with permissions specified by MODE (as modified by umask). *************** *** 2802,2871 **** the first thing in VAR, and the maximum length of VAR is SIZE plus the size of the message type. Returns true if successful, or false if there is an error. - ''' Beginning of part 3 - ''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $ - ''' - ''' $Log: perl.man,v $ - ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall - ''' patch1: fixed some typos - ''' - ''' Revision 4.0 91/03/20 01:38:08 lwall - ''' 4.0 baseline. - ''' - ''' Revision 3.0.1.12 91/01/11 18:18:15 lwall - ''' patch42: added binary and hex pack/unpack options - ''' - ''' Revision 3.0.1.11 90/11/10 01:48:21 lwall - ''' patch38: random cleanup - ''' patch38: documented tr///cds - ''' - ''' Revision 3.0.1.10 90/10/20 02:15:17 lwall - ''' patch37: patch37: fixed various typos in man page - ''' - ''' Revision 3.0.1.9 90/10/16 10:02:43 lwall - ''' patch29: you can now read into the middle string - ''' patch29: index and substr now have optional 3rd args - ''' patch29: added scalar reverse - ''' patch29: added scalar - ''' patch29: added SysV IPC - ''' patch29: added waitpid - ''' patch29: added sysread and syswrite - ''' - ''' Revision 3.0.1.8 90/08/09 04:39:04 lwall - ''' patch19: added require operator - ''' patch19: added truncate operator - ''' patch19: unpack can do checksumming - ''' - ''' Revision 3.0.1.7 90/08/03 11:15:42 lwall - ''' patch19: Intermediate diffs for Randal - ''' - ''' Revision 3.0.1.6 90/03/27 16:17:56 lwall - ''' patch16: MSDOS support - ''' - ''' Revision 3.0.1.5 90/03/12 16:52:21 lwall - ''' patch13: documented that print $filehandle &foo is ambiguous - ''' patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST) - ''' - ''' Revision 3.0.1.4 90/02/28 18:00:09 lwall - ''' patch9: added pipe function - ''' patch9: documented how to handle arbitrary weird characters in filenames - ''' patch9: documented the unflushed buffers problem on piped opens - ''' patch9: documented how to force top of page - ''' - ''' Revision 3.0.1.3 89/12/21 20:10:12 lwall - ''' patch7: documented that s`pat`repl` does command substitution on replacement - ''' patch7: documented that $timeleft from select() is likely not implemented - ''' - ''' Revision 3.0.1.2 89/11/17 15:31:05 lwall - ''' patch5: fixed some manual typos and indent problems - ''' patch5: added warning about print making an array context - ''' - ''' 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 - ''' .Ip "next LABEL" 8 8 .Ip "next" 8 The --- 2787,2792 ---- *************** *** 3661,3666 **** --- 3582,3588 ---- If SUBROUTINE is specified, gives the name of a subroutine that returns an integer less than, equal to, or greater than 0, depending on how the elements of the array are to be ordered. + (The <=> and cmp operators are extremely useful in such routines.) In the interests of efficiency the normal calling code for subroutines is bypassed, with the following effects: the subroutine may not be a recursive subroutine, and the two elements to be compared are passed into the subroutine *************** *** 3673,3684 **** .ne 4 sub byage { ! $age{$a} - $age{$b}; # presuming integers } @sortedclass = sort byage @class; .ne 9 ! sub reverse { $a lt $b ? 1 : $a gt $b ? \-1 : 0; } @harry = (\'dog\',\'cat\',\'x\',\'Cain\',\'Abel\'); @george = (\'gone\',\'chased\',\'yz\',\'Punished\',\'Axed\'); print sort @harry; --- 3595,3606 ---- .ne 4 sub byage { ! $age{$a} <=> $age{$b}; # presuming integers } @sortedclass = sort byage @class; .ne 9 ! sub reverse { $b cmp $a; } @harry = (\'dog\',\'cat\',\'x\',\'Cain\',\'Abel\'); @george = (\'gone\',\'chased\',\'yz\',\'Punished\',\'Axed\'); print sort @harry; *************** *** 3842,3847 **** --- 3764,3770 ---- } .fi + (This only works on machines for which the device number is negative under NFS.) .Ip "study(SCALAR)" 8 6 .Ip "study SCALAR" 8 .Ip "study" *************** *** 4266,4330 **** For more on formats, see the section on formats later on. .Sp Note that write is NOT the opposite of read. - ''' Beginning of part 4 - ''' $RCSfile: perl.man,v $$Revision: 4.0.1.1 $$Date: 91/04/11 17:50:44 $ - ''' - ''' $Log: perl.man,v $ - ''' Revision 4.0.1.1 91/04/11 17:50:44 lwall - ''' patch1: fixed some typos - ''' - ''' Revision 4.0 91/03/20 01:38:08 lwall - ''' 4.0 baseline. - ''' - ''' Revision 3.0.1.14 91/01/11 18:18:53 lwall - ''' patch42: started an addendum and errata section in the man page - ''' - ''' Revision 3.0.1.13 90/11/10 01:51:00 lwall - ''' patch38: random cleanup - ''' - ''' Revision 3.0.1.12 90/10/20 02:15:43 lwall - ''' patch37: patch37: fixed various typos in man page - ''' - ''' Revision 3.0.1.11 90/10/16 10:04:28 lwall - ''' patch29: added @###.## fields to format - ''' - ''' Revision 3.0.1.10 90/08/09 04:47:35 lwall - ''' patch19: added require operator - ''' patch19: added numeric interpretation of $] - ''' - ''' Revision 3.0.1.9 90/08/03 11:15:58 lwall - ''' patch19: Intermediate diffs for Randal - ''' - ''' Revision 3.0.1.8 90/03/27 16:19:31 lwall - ''' patch16: MSDOS support - ''' - ''' Revision 3.0.1.7 90/03/14 12:29:50 lwall - ''' patch15: man page falsely states that you can't subscript array values - ''' - ''' Revision 3.0.1.6 90/03/12 16:54:04 lwall - ''' patch13: improved documentation of *name - ''' - ''' Revision 3.0.1.5 90/02/28 18:01:52 lwall - ''' patch9: $0 is now always the command name - ''' - ''' Revision 3.0.1.4 89/12/21 20:12:39 lwall - ''' patch7: documented that package'filehandle works as well as $package'variable - ''' patch7: documented which identifiers are always in package main - ''' - ''' Revision 3.0.1.3 89/11/17 15:32:25 lwall - ''' patch5: fixed some manual typos and indent problems - ''' patch5: clarified difference between $! and $@ - ''' - ''' 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 - ''' - ''' Revision 3.0 89/10/18 15:21:55 lwall - ''' 3.0 baseline - ''' .Sh "Precedence" .I Perl operators have the following associativity and precedence: --- 4189,4194 ---- *************** *** 4736,4742 **** .ne 10 # a report on the /etc/passwd file ! format top = \& Passwd File Name Login Office Uid Gid Home ------------------------------------------------------------------ --- 4600,4606 ---- .ne 10 # a report on the /etc/passwd file ! format STDOUT_TOP = \& Passwd File Name Login Office Uid Gid Home ------------------------------------------------------------------ *************** *** 4748,4754 **** .ne 29 # a report from a bug report form ! format top = \& Bug Reports @<<<<<<<<<<<<<<<<<<<<<<< @||| @>>>>>>>>>>>>>>>>>>>>>>> $system, $%, $date --- 4612,4618 ---- .ne 29 # a report from a bug report form ! format STDOUT_TOP = \& Bug Reports @<<<<<<<<<<<<<<<<<<<<<<< @||| @>>>>>>>>>>>>>>>>>>>>>>> $system, $%, $date *************** *** 4990,4999 **** --- 4854,4865 ---- .Ip $~ 8 The name of the current report format for the currently selected output channel. + Default is name of the filehandle. (Mnemonic: brother to $^.) .Ip $^ 8 The name of the current top-of-page format for the currently selected output channel. + Default is name of the filehandle with \*(L"_TOP\*(R" appended. (Mnemonic: points to top of page.) .Ip $| 8 If set to nonzero, forces a flush after every write or print on the currently *************** *** 5197,5202 **** --- 5063,5073 ---- (Mnemonic: value of .B \-D switch.) + .Ip $^F 8 2 + The maximum system file descriptor, ordinarily 2. System file descriptors + are passed to subprocesses, while higher file descriptors are not. + During an open, system file descriptors are preserved even if the open + fails. Ordinary file descriptors are closed before the open is attempted. .Ip $^I 8 2 The current value of the inplace-edit extension. Use undef to disable inplace editing. *************** *** 5204,5210 **** .B \-i switch.) .Ip $^P 8 2 ! The name that Perl itself was invoked as, from argv[0]. .Ip $^T 8 2 The time at which the script began running, in seconds since the epoch. The values returned by the --- 5075,5083 ---- .B \-i switch.) .Ip $^P 8 2 ! The internal flag that the debugger clears so that it doesn't ! debug itself. You could conceivable disable debugging yourself ! by clearing it. .Ip $^T 8 2 The time at which the script began running, in seconds since the epoch. The values returned by the *************** *** 5218,5223 **** --- 5091,5098 ---- (Mnemonic: related to the .B \-w switch.) + .Ip $^X 8 2 + The name that Perl itself was executed as, from argv[0]. .Ip $ARGV 8 3 contains the name of the current file when reading from <>. .Ip @ARGV 8 3 *** End of Patch 7 *** exit 0 # Just in case... -- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM Sterling Software, IMD UUCP: uunet!sparky!kent Phone: (402) 291-8300 FAX: (402) 291-4362 Please send comp.sources.misc-related mail to kent@uunet.uu.net.