From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall)
Newsgroups: comp.sources.bugs,comp.lang.perl
Subject: perl 3.0 patch #42
Message-ID: <11027@jpl-devvax.JPL.NASA.GOV>
Date: 12 Jan 91 08:40:50 GMT

System: perl version 3.0
Patch #: 42
Subject: Configure now checks alignment requirements
Subject: Configure checks typecasting behavior better
Subject: Configure now checks for flexfilenames
Subject: executables for multiple versions may now coexist
Subject: added -0 option
Subject: added installperl script
Subject: added some Ultrix, A/UX and IRIX advice to README
Subject: the perl debugger was dumping core frequently
Subject: the postincrement to preincrement optimizer was overzealous
Subject: foreach didn't localize its temp array properly
Subject: assignment to a slice didn't supply an array context to RHS
Subject: variable suicide on local($a,$b) = @_ is now suppressed
Subject: added binary and hex pack/unpack options
Subject: fixed casting problem with n and N pack options
Subject: fixed printf("%c", 0)
Subject: ANSIfied the stat mode checking
Subject: the -i switch is now much more robust and informative
Subject: close on a pipe didn't return failure correctly
Subject: stat on temp values could wipe them out prematurely, i.e. grep(-d,<*>)
Subject: -l didn't work right with _
Subject: sort subroutines didn't allow copying $a or $b to other variables.
Subject: caller() coredumped when called outside the debugger.
Subject: perl -D14 crashed on ..
Subject: waitpid() emulation was useless because of #ifdef WAITPID
Subject: <> input to individual array elements was suboptimal
Subject: the @* format counted lines wrong
Subject: the @* format didn't handle lines with nulls or without newline
Subject: lib/complete.pl is now customizable
Subject: lib/ctime.pl is now packaged better
Subject: some .pl files were missing their trailing 1;
Subject: @_ couldn't be accessed from debugger
Subject: package didn't create symbol tables that could be reset
Subject: split with no arguments could wipe out next operator
Subject: fixed some man page entries
Subject: started an addendum and errata section in the man page
Subject: s/^foo/bar/ occasionally brought on core dumps
Subject: undid unwarranted assumptions about memcmp() return value
Subject: ('a' .. 'z') could lose its value in a loop
Subject: TEST now reports errors more accurately
Subject: t/op.dbm makes fewer assumptions about dbm file extensions
Subject: t/op.mkdir a little wiser about error messages
Subject: eval'ed formats without proper termination blew up
Subject: whitespace now allowed after terminating . of format
Subject: die could exit with 0 value on some machines
Subject: x2p/Makefile.SH blew up on /afs misfeature
Subject: a2p didn't recognize split with regular expression
Subject: a2p didn't handle > redirection right
Subject: x2p/s2p.SH blew up on /afs misfeature

Description:
	Most of these patches are pretty self-explanatory.  Much of this
	is random cleanup in preparation for version 4.0, so I won't talk
	about it here.  A couple of things should be noted, however.

	First, there's a new -0 option that allows you to specify (in octal)
	the initial value of $/, the record separator.  It's primarily
	intended for use with versions of find that support -print0 to
	delimit filenames with nulls, but it's more general than that:

		-0	null
		-01	^A
		-012	default
		-015	CR
		-00	paragraph mode
		-0777	file slurp mode

	This feature is so new that it didn't even make it into the book.

	The other major item is that different patchlevels of perl can
	now coexist in your bin directory.  The names "perl" and "taintperl"
	are just links to "perl3.044" and "tperl3.044".  This has several
	benefits.  The perl3.044 invokes the corresponding tperl3.044 rather
	than taintperl, so it always runs the correct version.  Second, you can
	"freeze" a script by putting a #! line referring to a version that
	it is known to work with.  Third, you can put a new version out
	there to try out before making it the default perl.  Lastly, it
	sells more disk drives.   :-)

	Barring catastrophe, this will likely be the last patch before
	version 4.0 comes out.

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 #44 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@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: 41
1c1
< #define PATCHLEVEL 41
---
> #define PATCHLEVEL 42

Index: Configure
Prereq: 3.0.1.12
*** Configure.old	Fri Jan 11 18:37:20 1991
--- Configure	Fri Jan 11 18:37:41 1991
***************
*** 8,14 ****
  # and edit it to reflect your system.  Some packages may include samples
  # of config.h for certain machines, so you might look for one of those.)
  #
! # $Header: Configure,v 3.0.1.12 90/11/10 00:57:30 lwall Locked $
  #
  # Yes, you may rip this off to use in other distribution packages.
  # (Note: this Configure script was generated automatically.  Rather than
--- 8,14 ----
  # and edit it to reflect your system.  Some packages may include samples
  # of config.h for certain machines, so you might look for one of those.)
  #
! # $Header: Configure,v 3.0.1.13 91/01/11 17:01:32 lwall Locked $
  #
  # Yes, you may rip this off to use in other distribution packages.
  # (Note: this Configure script was generated automatically.  Rather than
***************
*** 94,99 ****
--- 94,100 ----
  csh=''
  Log=''
  Header=''
+ alignbytes=''
  bin=''
  byteorder=''
  contains=''
***************
*** 103,108 ****
--- 104,110 ----
  d_bcopy=''
  d_bzero=''
  d_castneg=''
+ castflags=''
  d_charsprf=''
  d_chsize=''
  d_crypt=''
***************
*** 113,118 ****
--- 115,121 ----
  d_fchmod=''
  d_fchown=''
  d_fcntl=''
+ d_flexfnam=''
  d_flock=''
  d_getgrps=''
  d_gethent=''
***************
*** 639,677 ****
  chmod +x filexp
  $eunicefix filexp
  
- : determine where public executables go
- case "$bin" in
- '')
-     dflt=`./loc . /bin /usr/local/bin /usr/lbin /usr/local /usr/bin`
-     ;;
- *)  dflt="$bin"
-     ;;
- esac
- cont=true
- while $test "$cont" ; do
-     echo " "
-     rp="Where do you want to put the public executables? (~name ok) [$dflt]"
-     $echo $n "$rp $c"
-     . myread
-     bin="$ans"
-     bin=`./filexp "$bin"`
-     if test -d $bin; then
- 	cont=''
-     else
- 	case "$fastread" in
- 	yes) dflt=y;;
- 	*) dflt=n;;
- 	esac
- 	rp="Directory $bin doesn't exist.  Use that name anyway? [$dflt]"
- 	$echo $n "$rp $c"
- 	. myread
- 	dflt=''
- 	case "$ans" in
- 	y*) cont='';;
- 	esac
-     fi
- done
- 
  : determine where manual pages go
  $cat <<EOM
    
--- 642,647 ----
***************
*** 1196,1201 ****
--- 1166,1236 ----
  esac
  libs="$ans"
  
+ : check for size of random number generator
+ echo " "
+ case "$alignbytes" in
+ '')
+     echo "Checking alignment constraints..."
+     $cat >try.c <<'EOCP'
+ struct foobar {
+     char foo;
+     double bar;
+ } try;
+ main()
+ {
+     printf("%d\n", (char*)&try.bar - (char*)&try.foo);
+ }
+ EOCP
+     if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then
+ 	dflt=`./try`
+     else
+ 	dflt='?'
+ 	echo "(I can't seem to compile the test program...)"
+     fi
+     ;;
+ *)
+     dflt="$alignbytes"
+     ;;
+ esac
+ rp="Doubles must be aligned on a how-many-byte boundary? [$dflt]"
+ $echo $n "$rp $c"
+ . myread
+ alignbytes="$ans"
+ $rm -f try.c try
+ 
+ : determine where public executables go
+ case "$bin" in
+ '')
+     dflt=`./loc . /bin /usr/local/bin /usr/lbin /usr/local /usr/bin`
+     ;;
+ *)  dflt="$bin"
+     ;;
+ esac
+ cont=true
+ while $test "$cont" ; do
+     echo " "
+     rp="Where do you want to put the public executables? (~name ok) [$dflt]"
+     $echo $n "$rp $c"
+     . myread
+     bin="$ans"
+     bin=`./filexp "$bin"`
+     if test -d $bin; then
+ 	cont=''
+     else
+ 	case "$fastread" in
+ 	yes) dflt=y;;
+ 	*) dflt=n;;
+ 	esac
+ 	rp="Directory $bin doesn't exist.  Use that name anyway? [$dflt]"
+ 	$echo $n "$rp $c"
+ 	. myread
+ 	dflt=''
+ 	case "$ans" in
+ 	y*) cont='';;
+ 	esac
+     fi
+ done
+ 
  : check for ordering of bytes in a long
  case "$byteorder" in
  '')
***************
*** 1249,1254 ****
--- 1284,1337 ----
  byteorder="$ans"
  $rm -f try.c try
  
+ : check for ability to cast negative floats to unsigned
+ echo " "
+ echo 'Checking to see if your C compiler can cast weird floats to unsigned'
+ $cat >try.c <<'EOCP'
+ main()
+ {
+ 	double f = -123;
+ 	unsigned long along;
+ 	unsigned int aint;
+ 	unsigned short ashort;
+ 	int result = 0;
+ 
+ 	along = (unsigned long)f;
+ 	aint = (unsigned int)f;
+ 	ashort = (unsigned short)f;
+ 	if (along != (unsigned long)-123)
+ 	    result |= 1;
+ 	if (aint != (unsigned int)-123)
+ 	    result |= 1;
+ 	if (ashort != (unsigned short)-123)
+ 	    result |= 1;
+ 	f = (double)0x40000000;
+ 	f = f + f;
+ 	along = (unsigned long)f;
+ 	if (along != 0x80000000)
+ 	    result |= 2;
+ 	f -= 1;
+ 	along = (unsigned long)f;
+ 	if (along != 0x7fffffff)
+ 	    result |= 1;
+ 	f += 2;
+ 	along = (unsigned long)f;
+ 	if (along != 0x80000001)
+ 	    result |= 2;
+ 	exit(result);
+ }
+ EOCP
+ if $cc -o try $ccflags try.c >/dev/null 2>&1 && ./try; then
+     d_castneg="$define"
+     castflags=0
+     echo "Yup, it does."
+ else
+     d_castneg="$undef"
+     castflags=$?
+     echo "Nope, it doesn't."
+ fi
+ $rm -f try.*
+ 
  : see how we invoke the C preprocessor
  echo " "
  echo "Now, how can we feed standard input to your C preprocessor..."
***************
*** 1516,1550 ****
  set bzero d_bzero
  eval $inlibc
  
- : check for ability to cast negative floats to unsigned
- echo " "
- echo 'Checking to see if your C compiler can cast negative float to unsigned'
- $cat >try.c <<'EOCP'
- main()
- {
- 	double f = -123;
- 	unsigned long along;
- 	unsigned int aint;
- 	unsigned short ashort;
- 
- 	along = (unsigned long)f;
- 	aint = (unsigned int)f;
- 	ashort = (unsigned short)f;
- 	if (along == 0L || aint == 0 || ashort == 0)
- 	    exit(1);
- 	else
- 	    exit(0);
- }
- EOCP
- if $cc -o try $ccflags try.c >/dev/null 2>&1 && ./try; then
-     d_castneg="$define"
-     echo "Yup, it does."
- else
-     d_castneg="$undef"
-     echo "Nope, it doesn't."
- fi
- $rm -f try.*
- 
  : see if sprintf is declared as int or pointer to char
  echo " "
  cat >.ucbsprf.c <<'EOF'
--- 1599,1604 ----
***************
*** 1703,1708 ****
--- 1757,1779 ----
      echo "No fcntl.h found, but that's ok."
  fi
  
+ : see if we can have long filenames
+ echo " "
+ rm -f 123456789abcde
+ if (echo hi >123456789abcdef) 2>/dev/null; then
+     : not version 8
+     if test -f 123456789abcde; then
+ 	echo 'You cannot have filenames longer than 14 characters.  Sigh.'
+ 	d_flexfnam="$undef"
+     else
+ 	echo 'You can have filenames longer than 14 characters.'
+ 	d_flexfnam="$define"
+     fi
+ else
+     : version 8 probably
+     echo "You can't have filenames longer than 14 chars.  V8 can't even think about them!"
+     d_flexfnam="$undef"
+ fi 
  : see if flock exists
  set flock d_flock
  eval $inlibc
***************
*** 2687,2692 ****
--- 2758,2764 ----
  csh='$csh'
  Log='$Log'
  Header='$Header'
+ alignbytes='$alignbytes'
  bin='$bin'
  byteorder='$byteorder'
  contains='$contains'
***************
*** 2696,2701 ****
--- 2768,2774 ----
  d_bcopy='$d_bcopy'
  d_bzero='$d_bzero'
  d_castneg='$d_castneg'
+ castflags='$castflags'
  d_charsprf='$d_charsprf'
  d_chsize='$d_chsize'
  d_crypt='$d_crypt'
***************
*** 2706,2711 ****
--- 2779,2785 ----
  d_fchmod='$d_fchmod'
  d_fchown='$d_fchown'
  d_fcntl='$d_fcntl'
+ d_flexfnam='$d_flexfnam'
  d_flock='$d_flock'
  d_getgrps='$d_getgrps'
  d_gethent='$d_gethent'

Index: MANIFEST
*** MANIFEST.old	Fri Jan 11 18:38:01 1991
--- MANIFEST	Fri Jan 11 18:38:05 1991
***************
*** 83,88 ****
--- 83,89 ----
  handy.h			Handy definitions
  hash.c			Associative arrays
  hash.h			Public declarations for the above
+ installperl		Perl script to do "make install" dirty work
  ioctl.pl		Sample ioctl.pl
  lib/abbrev.pl		An abbreviation table builder
  lib/bigfloat.pl		An arbitrary precision floating point package
***************
*** 262,265 ****
  x2p/util.c		Utility routines
  x2p/util.h		Public declarations for the above
  x2p/walk.c		Parse tree walker
- config_h.SH	Produces config.h.
--- 263,265 ----

Index: Makefile.SH
Prereq: 3.0.1.11
*** Makefile.SH.old	Fri Jan 11 18:38:22 1991
--- Makefile.SH	Fri Jan 11 18:38:25 1991
***************
*** 25,33 ****
  
  echo "Extracting Makefile (with variable substitutions)"
  cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.11 90/11/10 01:25:51 lwall Locked $
  #
  # $Log:	Makefile.SH,v $
  # Revision 3.0.1.11  90/11/10  01:25:51  lwall
  # patch38: new arbitrary precision libraries from Mark Biggar
  # 
--- 25,36 ----
  
  echo "Extracting Makefile (with variable substitutions)"
  cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.12 91/01/11 17:05:17 lwall Locked $
  #
  # $Log:	Makefile.SH,v $
+ # Revision 3.0.1.12  91/01/11  17:05:17  lwall
+ # patch42: added installperl script
+ # 
  # Revision 3.0.1.11  90/11/10  01:25:51  lwall
  # patch38: new arbitrary precision libraries from Mark Biggar
  # 
***************
*** 314,358 ****
  	cat perl_man.[1-4] >>perl.man
  
  install: all
! # won't work with csh
! 	export PATH || exit 1
! 	- rm -f $(bin)/perl.old $(bin)/suidperl $(bin)/taintperl
! 	- mv $(bin)/perl $(bin)/perl.old 2>/dev/null
! 	- if test `pwd` != $(bin); then cp $(public) $(bin); fi
! 	- cd $(bin); \
! for pub in $(public); do \
! chmod +x `basename $$pub`; \
! done
! 	- chmod 755 $(bin)/taintperl 2>/dev/null
! !NO!SUBS!
! 
! case "$d_dosuid" in
! *define*)
!     cat >>Makefile <<'!NO!SUBS!'
! 	- chmod 4711 $(bin)/suidperl 2>/dev/null
! !NO!SUBS!
!     ;;
! esac
! 
! cat >>Makefile <<'!NO!SUBS!'
! 	- test $(bin) = /usr/bin || rm -f /usr/bin/perl
! 	- test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin
! 	- chmod +x $(scripts)
! 	- cp $(scripts) $(scriptdir)
! 	- sh ./makedir $(privlib)
! 	- \
! if test `pwd` != $(privlib); then \
! cp $(private) lib/*.pl $(privlib); \
! fi
! #	cd $(privlib); \
! #for priv in $(private); do \
! #chmod +x `basename $$priv`; \
! #done
! 	- if test `pwd` != $(mansrc); then \
! for page in $(manpages); do \
! cp $$page $(mansrc)/`basename $$page .man`.$(manext); \
! done; \
! fi
  	cd x2p; $(MAKE) install
  
  clean:
--- 317,323 ----
  	cat perl_man.[1-4] >>perl.man
  
  install: all
! 	./perl installperl
  	cd x2p; $(MAKE) install
  
  clean:

Index: x2p/Makefile.SH
Prereq: 3.0.1.7
*** x2p/Makefile.SH.old	Fri Jan 11 18:47:45 1991
--- x2p/Makefile.SH	Fri Jan 11 18:47:48 1991
***************
*** 5,10 ****
--- 5,11 ----
  '')
      if test ! -f config.sh; then
  	ln ../config.sh . || \
+ 	ln -s ../config.sh . || \
  	ln ../../config.sh . || \
  	ln ../../../config.sh . || \
  	(echo "Can't find config.sh."; exit 1)
***************
*** 18,26 ****
  esac
  echo "Extracting x2p/Makefile (with variable substitutions)"
  cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.7 90/11/10 02:20:15 lwall Locked $
  #
  # $Log:	Makefile.SH,v $
  # Revision 3.0.1.7  90/11/10  02:20:15  lwall
  # patch38: random cleanup
  # 
--- 19,30 ----
  esac
  echo "Extracting x2p/Makefile (with variable substitutions)"
  cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.8 91/01/11 18:34:40 lwall Locked $
  #
  # $Log:	Makefile.SH,v $
+ # Revision 3.0.1.8  91/01/11  18:34:40  lwall
+ # patch42: x2p/Makefile.SH blew up on /afs misfeature
+ # 
  # Revision 3.0.1.7  90/11/10  02:20:15  lwall
  # patch38: random cleanup
  # 

Index: README
*** README.old	Fri Jan 11 18:38:36 1991
--- README	Fri Jan 11 18:38:39 1991
***************
*** 102,107 ****
--- 102,108 ----
      SGI machines may need -Ddouble="long float".
      Ultrix (2.3) may need to hand assemble teval.s with a -J switch.
      Ultrix on MIPS machines may need -DLANGUAGE_C.
+     Ultrix 4.0 on MIPS machines may need -Olimit 2820 or so.
      Ultrix 3.[01] on MIPS needs to undefine WAITPID--the system call is busted.
      MIPS machines may need to undef d_volatile.
      MIPS machines may need to turn off -O on perly.c and tperly.c.
***************
*** 110,119 ****
--- 111,123 ----
      Xenix 386 needs -Sm11000 for yacc, and may need -UM_I86.
      Genix needs to use libc rather than libc_s, or #undef VARARGS.
      NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR.
+     A/UX may appears to work with -O -B/usr/lib/big/ optimizer flags.
+     A/UX needs -lposix to find rewinddir.
      A/UX may need -ZP -DPOSIX, and -g if big cc is used.
      FPS machines may need -J and -DBADSWITCH.
      UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT.
      Dnix (not dynix) may need to remove -O.
+     IRIX 3.3 may need to undefine VFORK.
      If you get syntax errors on '(', try -DCRIPPLED_CC or -DBADSWITCH or both.
      Machines with half-implemented dbm routines will need to #undef ODBM & NDBM.
      C's that don't try to restore registers on longjmp() may need -DJMPCLOBBER.

Index: t/TEST
Prereq: 3.0.1.2
*** t/TEST.old	Fri Jan 11 18:46:26 1991
--- t/TEST	Fri Jan 11 18:46:27 1991
***************
*** 1,6 ****
  #!./perl
  
! # $Header: TEST,v 3.0.1.2 90/11/10 02:09:07 lwall Locked $
  
  # This is written in a peculiar style, since we're trying to avoid
  # most of the constructs we'll be testing for.
--- 1,6 ----
  #!./perl
  
! # $Header: TEST,v 3.0.1.3 91/01/11 18:28:17 lwall Locked $
  
  # This is written in a peculiar style, since we're trying to avoid
  # most of the constructs we'll be testing for.
***************
*** 62,67 ****
--- 62,68 ----
  		$next = 1;
  		$ok = 1;
  	    } else {
+ 		$next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  		if (/^ok (.*)/ && $1 == $next) {
  		    $next = $next + 1;
  		} else {

Index: x2p/a2p.y
Prereq: 3.0.1.2
*** x2p/a2p.y.old	Fri Jan 11 18:47:56 1991
--- x2p/a2p.y	Fri Jan 11 18:47:59 1991
***************
*** 1,5 ****
  %{
! /* $Header: a2p.y,v 3.0.1.2 90/08/09 05:47:26 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,5 ----
  %{
! /* $Header: a2p.y,v 3.0.1.3 91/01/11 18:35:57 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 7,12 ****
--- 7,16 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	a2p.y,v $
+  * Revision 3.0.1.3  91/01/11  18:35:57  lwall
+  * patch42: a2p didn't recognize split with regular expression
+  * patch42: a2p didn't handle > redirection right
+  * 
   * Revision 3.0.1.2  90/08/09  05:47:26  lwall
   * patch19: a2p didn't handle {foo = (bar == 123)}
   * 
***************
*** 219,224 ****
--- 223,230 ----
  		{ $$ = oper2(OSUBSTR,$3,$5); }
  	| SPLIT '(' expr ',' VAR ',' expr ')'
  		{ $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),$7); }
+ 	| SPLIT '(' expr ',' VAR ',' REGEX ')'
+ 		{ $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),oper1(OREGEX,$7));}
  	| SPLIT '(' expr ',' VAR ')'
  		{ $$ = oper2(OSPLIT,$3,aryrefarg(numary($5))); }
  	| INDEX '(' expr ',' expr ')'
***************
*** 371,377 ****
  	;
  
  redir	: '>'	%prec FIELD
! 		{ $$ = oper1(OREDIR,$1); }
  	| GRGR
  		{ $$ = oper1(OREDIR,string(">>",2)); }
  	| '|'
--- 377,383 ----
  	;
  
  redir	: '>'	%prec FIELD
! 		{ $$ = oper1(OREDIR,string(">",1)); }
  	| GRGR
  		{ $$ = oper1(OREDIR,string(">>",2)); }
  	| '|'

Index: lib/complete.pl
*** lib/complete.pl.old	Fri Jan 11 18:42:08 1991
--- lib/complete.pl	Fri Jan 11 18:42:10 1991
***************
*** 7,12 ****
--- 7,13 ----
  ;#     This routine provides word completion.
  ;#     (TAB) attempts word completion.
  ;#     (^D)  prints completion list.
+ ;#	(These may be changed by setting $Complete'complete, etc.)
  ;#
  ;# Diagnostics:
  ;#     Bell when word completion fails.
***************
*** 15,27 ****
  ;#     The tty driver is put into raw mode.
  ;#
  ;# Bugs:
- ;#     The erase and kill characters are hard coded.
  ;#
  ;# Usage:
  ;#     $input = do Complete('prompt_string', @completion_list);
  ;#
  
  sub Complete {
      local ($prompt) = shift (@_);
      local ($c, $cmp, $l, $r, $ret, $return, $test);
      @_cmp_lst = sort @_;
--- 16,38 ----
  ;#     The tty driver is put into raw mode.
  ;#
  ;# Bugs:
  ;#
  ;# Usage:
  ;#     $input = do Complete('prompt_string', @completion_list);
  ;#
  
+ CONFIG: {
+     package Complete;
+ 
+     $complete =	"\004";
+     $kill =	"\025";
+     $erase1 =	"\177";
+     $erase2 =	"\010";
+ }
+ 
  sub Complete {
+     package Complete;
+ 
      local ($prompt) = shift (@_);
      local ($c, $cmp, $l, $r, $ret, $return, $test);
      @_cmp_lst = sort @_;
***************
*** 49,55 ****
      	    	print $test = substr ($test, $r, $l - $r);
      	    	$r = length ($return .= $test);
  	    }
! 	    elsif ($c eq "\004") {		# (^D) completion list
  		print "\r\n";
  		foreach $cmp (@_cmp_lst) {
  		    print "$cmp\r\n" if $cmp =~ /^$return/;
--- 60,66 ----
      	    	print $test = substr ($test, $r, $l - $r);
      	    	$r = length ($return .= $test);
  	    }
! 	    elsif ($c eq $complete) {		# (^D) completion list
  		print "\r\n";
  		foreach $cmp (@_cmp_lst) {
  		    print "$cmp\r\n" if $cmp =~ /^$return/;
***************
*** 56,62 ****
  		}
  		redo loop;
  	    }
!     	    elsif ($c eq "\025" && $r) {	# (^U) kill
      	    	$return = '';
      	    	$r = 0;
      	    	print "\r\n";
--- 67,73 ----
  		}
  		redo loop;
  	    }
!     	    elsif ($c eq $kill && $r) {	# (^U) kill
      	    	$return = '';
      	    	$r = 0;
      	    	print "\r\n";
***************
*** 63,69 ****
      	    	redo loop;
      	    }
  	    	    	    	    	    	# (DEL) || (BS) erase
! 	    elsif ($c eq "\177" || $c eq "\010") {
  		if($r) {
  		    print "\b \b";
  		    chop ($return);
--- 74,80 ----
      	    	redo loop;
      	    }
  	    	    	    	    	    	# (DEL) || (BS) erase
! 	    elsif ($c eq $erase1 || $c eq $erase2) {
  		if($r) {
  		    print "\b \b";
  		    chop ($return);

Index: config_h.SH
*** config_h.SH.old	Fri Jan 11 18:38:55 1991
--- config_h.SH	Fri Jan 11 18:39:02 1991
***************
*** 37,42 ****
--- 37,48 ----
  #$d_eunice	EUNICE		/**/
  #$d_eunice	VMS		/**/
  
+ /* ALIGNBYTES:
+  *	This symbol contains the number of bytes required to align a double.
+  *	Usual values are 2, 4, and 8.
+  */
+ #define ALIGNBYTES $alignbytes		/**/
+ 
  /* BIN:
   *	This symbol holds the name of the directory in which the user wants
   *	to put publicly executable images for the package in question.  It
***************
*** 87,93 ****
--- 93,106 ----
   *	This symbol, if defined, indicates that this C compiler knows how to
   *	cast negative numbers to unsigned longs, ints and shorts.
   */
+ /* CASTFLAGS:
+  *	This symbol contains flags that say what difficulties the compiler
+  *	has casting odd floating values to unsigned long:
+  *		1 = couldn't cast < 0
+  *		2 = couldn't cast >= 0x80000000
+  */
  #$d_castneg	CASTNEGFLOAT	/**/
+ #define	CASTFLAGS $castflags	/**/
  
  /* CHARSPRINTF:
   *	This symbol is defined if this system declares "char *sprintf()" in
***************
*** 153,158 ****
--- 166,177 ----
   *	include fcntl.h.
   */
  #$d_fcntl	FCNTL		/**/
+ 
+ /* FLEXFILENAMES:
+  *	This symbol, if defined, indicates that the system supports filenames
+  *	longer than 14 characters.
+  */
+ #$d_flexfnam	FLEXFILENAMES		/**/
  
  /* FLOCK:
   *	This symbol, if defined, indicates that the flock() routine is

Index: cons.c
Prereq: 3.0.1.9
*** cons.c.old	Fri Jan 11 18:39:22 1991
--- cons.c	Fri Jan 11 18:39:30 1991
***************
*** 1,4 ****
! /* $Header: cons.c,v 3.0.1.9 90/11/10 01:10:50 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: cons.c,v 3.0.1.10 91/01/11 17:33:33 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,16 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	cons.c,v $
+  * Revision 3.0.1.10  91/01/11  17:33:33  lwall
+  * patch42: the perl debugger was dumping core frequently
+  * patch42: the postincrement to preincrement optimizer was overzealous
+  * patch42: foreach didn't localize its temp array properly
+  * 
   * Revision 3.0.1.9  90/11/10  01:10:50  lwall
   * patch38: random cleanup
   * 
***************
*** 469,475 ****
      cmd->c_type = C_EXPR;
      cmd->ucmd.acmd.ac_stab = Nullstab;
      cmd->ucmd.acmd.ac_expr = Nullarg;
!     cmd->c_expr = make_op(O_SUBR, 1,
  	stab2arg(A_WORD,DBstab),
  	Nullarg,
  	Nullarg);
--- 474,480 ----
      cmd->c_type = C_EXPR;
      cmd->ucmd.acmd.ac_stab = Nullstab;
      cmd->ucmd.acmd.ac_expr = Nullarg;
!     cmd->c_expr = make_op(O_SUBR, 2,
  	stab2arg(A_WORD,DBstab),
  	Nullarg,
  	Nullarg);
***************
*** 675,681 ****
  
      if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
  	cmd->c_flags |= opt;
! 	if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)) {
  	    arg[flp].arg_flags &= ~AF_POST;	/* prefer ++$foo to $foo++ */
  	    arg[flp].arg_flags |= AF_PRE;	/*  if value not wanted */
  	}
--- 680,687 ----
  
      if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
  	cmd->c_flags |= opt;
! 	if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
! 	  && cmd->c_expr->arg_type == O_ITEM) {
  	    arg[flp].arg_flags &= ~AF_POST;	/* prefer ++$foo to $foo++ */
  	    arg[flp].arg_flags |= AF_PRE;	/*  if value not wanted */
  	}
***************
*** 1305,1312 ****
  		if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
  		    if (lastcmd &&
  		      lastcmd->c_type == C_EXPR &&
! 		      lastcmd->ucmd.acmd.ac_expr) {
! 			ARG *arg = lastcmd->ucmd.acmd.ac_expr;
  
  			if (arg->arg_type == O_ASSIGN &&
  			    arg[1].arg_type == A_LEXPR &&
--- 1311,1318 ----
  		if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
  		    if (lastcmd &&
  		      lastcmd->c_type == C_EXPR &&
! 		      lastcmd->c_expr) {
! 			ARG *arg = lastcmd->c_expr;
  
  			if (arg->arg_type == O_ASSIGN &&
  			    arg[1].arg_type == A_LEXPR &&
***************
*** 1315,1321 ****
  			      stab_name(
  				arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
  			      5)) {	/* array generated for foreach */
! 			    (void)localize(arg[1].arg_ptr.arg_arg);
  			}
  		    }
  
--- 1321,1327 ----
  			      stab_name(
  				arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
  			      5)) {	/* array generated for foreach */
! 			    (void)localize(arg);
  			}
  		    }
  

Index: consarg.c
Prereq: 3.0.1.7
*** consarg.c.old	Fri Jan 11 18:39:43 1991
--- consarg.c	Fri Jan 11 18:39:48 1991
***************
*** 1,4 ****
! /* $Header: consarg.c,v 3.0.1.7 90/10/15 15:55:28 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: consarg.c,v 3.0.1.8 91/01/11 17:37:31 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,15 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	consarg.c,v $
+  * Revision 3.0.1.8  91/01/11  17:37:31  lwall
+  * patch42: assignment to a slice didn't supply an array context to RHS
+  * patch42: suppressed variable suicide on local($a,$b) = @_
+  * 
   * Revision 3.0.1.7  90/10/15  15:55:28  lwall
   * patch29: defined @foo was behaving inconsistently
   * patch29: -5 % 5 was wrong
***************
*** 721,726 ****
--- 725,731 ----
  	else if (arg1->arg_type == O_ASLICE) {
  	    arg1->arg_type = O_LASLICE;
  	    if (arg->arg_type == O_ASSIGN) {
+ 		dehoist(arg,2);
  		arg[1].arg_flags |= AF_ARYOK;
  		arg[2].arg_flags |= AF_ARYOK;
  	    }
***************
*** 728,733 ****
--- 733,739 ----
  	else if (arg1->arg_type == O_HSLICE) {
  	    arg1->arg_type = O_LHSLICE;
  	    if (arg->arg_type == O_ASSIGN) {
+ 		dehoist(arg,2);
  		arg[1].arg_flags |= AF_ARYOK;
  		arg[2].arg_flags |= AF_ARYOK;
  	    }
***************
*** 1066,1071 ****
--- 1072,1078 ----
      thisexpr++;
      if (arg_common(arg1,thisexpr,1))
  	return 0;	/* hit eval or do {} */
+     stab_lastexpr(defstab) = thisexpr;		/* pretend to hit @_ */
      if (arg_common(arg2,thisexpr,0))
  	return 0;	/* hit identifier again */
      return 1;

Index: lib/ctime.pl
*** lib/ctime.pl.old	Fri Jan 11 18:42:15 1991
--- lib/ctime.pl	Fri Jan 11 18:42:16 1991
***************
*** 10,22 ****
  ;# usage:
  ;#
  ;#     #include <ctime.pl>          # see the -P and -I option in perl.man
! ;#     $Date = do ctime(time);
  
! @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
! @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
!         'Jul','Aug','Sep','Oct','Nov','Dec');
  
  sub ctime {
      local($time) = @_;
      local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
  
--- 10,28 ----
  ;# usage:
  ;#
  ;#     #include <ctime.pl>          # see the -P and -I option in perl.man
! ;#     $Date = &ctime(time);
  
! CONFIG: {
!     package ctime;
  
+     @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
+     @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
+ 	    'Jul','Aug','Sep','Oct','Nov','Dec');
+ }
+ 
  sub ctime {
+     package ctime;
+ 
      local($time) = @_;
      local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
  

Index: doarg.c
Prereq: 3.0.1.9
*** doarg.c.old	Fri Jan 11 18:40:02 1991
--- doarg.c	Fri Jan 11 18:40:06 1991
***************
*** 1,4 ****
! /* $Header: doarg.c,v 3.0.1.9 90/11/10 01:14:31 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: doarg.c,v 3.0.1.10 91/01/11 17:41:39 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:	doarg.c,v $
+  * Revision 3.0.1.10  91/01/11  17:41:39  lwall
+  * patch42: added binary and hex pack/unpack options
+  * patch42: fixed casting problem with n and N pack options
+  * patch42: fixed printf("%c", 0)
+  * patch42: the perl debugger was dumping core frequently
+  * 
   * Revision 3.0.1.9  90/11/10  01:14:31  lwall
   * patch38: random cleanup
   * patch38: optimized join('',...)
***************
*** 516,521 ****
--- 522,641 ----
  		}
  	    }
  	    break;
+ 	case 'B':
+ 	case 'b':
+ 	    {
+ 		char *savepat = pat;
+ 		int saveitems = items;
+ 
+ 		fromstr = NEXTFROM;
+ 		aptr = str_get(fromstr);
+ 		if (pat[-1] == '*')
+ 		    len = fromstr->str_cur;
+ 		pat = aptr;
+ 		aint = str->str_cur;
+ 		str->str_cur += (len+7)/8;
+ 		STR_GROW(str, str->str_cur + 1);
+ 		aptr = str->str_ptr + aint;
+ 		if (len > fromstr->str_cur)
+ 		    len = fromstr->str_cur;
+ 		aint = len;
+ 		items = 0;
+ 		if (datumtype == 'B') {
+ 		    for (len = 0; len++ < aint;) {
+ 			items |= *pat++ & 1;
+ 			if (len & 7)
+ 			    items <<= 1;
+ 			else {
+ 			    *aptr++ = items & 0xff;
+ 			    items = 0;
+ 			}
+ 		    }
+ 		}
+ 		else {
+ 		    for (len = 0; len++ < aint;) {
+ 			if (*pat++ & 1)
+ 			    items |= 128;
+ 			if (len & 7)
+ 			    items >>= 1;
+ 			else {
+ 			    *aptr++ = items & 0xff;
+ 			    items = 0;
+ 			}
+ 		    }
+ 		}
+ 		if (aint & 7) {
+ 		    if (datumtype == 'B')
+ 			items <<= 7 - (aint & 7);
+ 		    else
+ 			items >>= 7 - (aint & 7);
+ 		    *aptr++ = items & 0xff;
+ 		}
+ 		pat = str->str_ptr + str->str_cur;
+ 		while (aptr <= pat)
+ 		    *aptr++ = '\0';
+ 
+ 		pat = savepat;
+ 		items = saveitems;
+ 	    }
+ 	    break;
+ 	case 'H':
+ 	case 'h':
+ 	    {
+ 		char *savepat = pat;
+ 		int saveitems = items;
+ 
+ 		fromstr = NEXTFROM;
+ 		aptr = str_get(fromstr);
+ 		if (pat[-1] == '*')
+ 		    len = fromstr->str_cur;
+ 		pat = aptr;
+ 		aint = str->str_cur;
+ 		str->str_cur += (len+1)/2;
+ 		STR_GROW(str, str->str_cur + 1);
+ 		aptr = str->str_ptr + aint;
+ 		if (len > fromstr->str_cur)
+ 		    len = fromstr->str_cur;
+ 		aint = len;
+ 		items = 0;
+ 		if (datumtype == 'H') {
+ 		    for (len = 0; len++ < aint;) {
+ 			if (isalpha(*pat))
+ 			    items |= ((*pat++ & 15) + 9) & 15;
+ 			else
+ 			    items |= *pat++ & 15;
+ 			if (len & 1)
+ 			    items <<= 4;
+ 			else {
+ 			    *aptr++ = items & 0xff;
+ 			    items = 0;
+ 			}
+ 		    }
+ 		}
+ 		else {
+ 		    for (len = 0; len++ < aint;) {
+ 			if (isalpha(*pat))
+ 			    items |= (((*pat++ & 15) + 9) & 15) << 4;
+ 			else
+ 			    items |= (*pat++ & 15) << 4;
+ 			if (len & 1)
+ 			    items >>= 4;
+ 			else {
+ 			    *aptr++ = items & 0xff;
+ 			    items = 0;
+ 			}
+ 		    }
+ 		}
+ 		if (aint & 1)
+ 		    *aptr++ = items & 0xff;
+ 		pat = str->str_ptr + str->str_cur;
+ 		while (aptr <= pat)
+ 		    *aptr++ = '\0';
+ 
+ 		pat = savepat;
+ 		items = saveitems;
+ 	    }
+ 	    break;
  	case 'C':
  	case 'c':
  	    while (len-- > 0) {
***************
*** 577,587 ****
  	case 'N':
  	    while (len-- > 0) {
  		fromstr = NEXTFROM;
! 		along = (long)str_gnum(fromstr);
  #ifdef HTONL
! 		along = htonl(along);
  #endif
! 		str_ncat(str,(char*)&along,sizeof(long));
  	    }
  	    break;
  	case 'L':
--- 697,707 ----
  	case 'N':
  	    while (len-- > 0) {
  		fromstr = NEXTFROM;
! 		aulong = U_L(str_gnum(fromstr));
  #ifdef HTONL
! 		aulong = htonl(aulong);
  #endif
! 		str_ncat(str,(char*)&aulong,sizeof(unsigned long));
  	    }
  	    break;
  	case 'L':
***************
*** 696,701 ****
--- 816,822 ----
  		*t = '\0';
  		(void)sprintf(xs,f);
  		len++;
+ 		xlen = strlen(xs);
  		break;
  	    case '0': case '1': case '2': case '3': case '4':
  	    case '5': case '6': case '7': case '8': case '9': 
***************
*** 711,719 ****
  		if (strEQ(f,"%c")) { /* some printfs fail on null chars */
  		    *xs = xlen;
  		    xs[1] = '\0';
  		}
! 		else
  		    (void)sprintf(xs,f,xlen);
  		break;
  	    case 'D':
  		dolong = TRUE;
--- 832,843 ----
  		if (strEQ(f,"%c")) { /* some printfs fail on null chars */
  		    *xs = xlen;
  		    xs[1] = '\0';
+ 		    xlen = 1;
  		}
! 		else {
  		    (void)sprintf(xs,f,xlen);
+ 		    xlen = strlen(xs);
+ 		}
  		break;
  	    case 'D':
  		dolong = TRUE;
***************
*** 725,730 ****
--- 849,855 ----
  		    (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
  		else
  		    (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
+ 		xlen = strlen(xs);
  		break;
  	    case 'X': case 'O':
  		dolong = TRUE;
***************
*** 737,747 ****
--- 862,874 ----
  		    (void)sprintf(xs,f,U_L(value));
  		else
  		    (void)sprintf(xs,f,U_I(value));
+ 		xlen = strlen(xs);
  		break;
  	    case 'E': case 'e': case 'f': case 'G': case 'g':
  		ch = *(++t);
  		*t = '\0';
  		(void)sprintf(xs,f,str_gnum(*(sarg++)));
+ 		xlen = strlen(xs);
  		break;
  	    case 's':
  		ch = *(++t);
***************
*** 767,777 ****
  		*t = ch;
  		(void)sprintf(buf,tokenbuf+64,xs);
  		xs = buf;
  		break;
  	    }
  	    /* end of switch, copy results */
  	    *t = ch;
- 	    xlen = strlen(xs);
  	    STR_GROW(str, str->str_cur + (f - s) + len + 1);
  	    str_ncat(str, s, f - s);
  	    str_ncat(str, xs, xlen);
--- 894,904 ----
  		*t = ch;
  		(void)sprintf(buf,tokenbuf+64,xs);
  		xs = buf;
+ 		xlen = strlen(xs);
  		break;
  	    }
  	    /* end of switch, copy results */
  	    *t = ch;
  	    STR_GROW(str, str->str_cur + (f - s) + len + 1);
  	    str_ncat(str, s, f - s);
  	    str_ncat(str, xs, xlen);
***************
*** 880,885 ****
--- 1007,1015 ----
      csv->hasargs = hasargs;
      curcsv = csv;
      if (sub->usersub) {
+ 	csv->hasargs = 0;
+ 	csv->savearray = Null(ARRAY*);;
+ 	csv->argarray = Null(ARRAY*);
  	st[sp] = arg->arg_ptr.arg_str;
  	if (!hasargs)
  	    items = 0;

*** End of Patch 42 ***
