From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall)
Newsgroups: comp.sources.bugs,comp.lang.perl
Subject: perl 3.0 patch #14
Message-ID: <7391@jpl-devvax.JPL.NASA.GOV>
Date: 13 Mar 90 02:21:07 GMT

System: perl version 3.0
Patch #: 14
Priority: HIGH
Subject: patch #13, continued

Description:
	See patch #13.

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:
		Configure -d
		make depend
		make
		make test
		make install

	If patch indicates that patchlevel is the wrong version, you may need
	to apply one or more previous patches, or the patch may already
	have been applied.  See the patchlevel.h file to find out what has or
	has not been applied.  In any event, don't continue with the patch.

	If you are missing previous patches they can be obtained from me:

	Larry Wall
	lwall@jpl-devvax.jpl.nasa.gov

	If you send a mail message of the following form it will greatly speed
	processing:

	Subject: Command
	@SH mailpatch PATH perl 3.0 LIST
		   ^ note the c

	where PATH is a return path FROM ME TO YOU either in Internet notation,
	or in bang notation from some well-known host, and LIST is the number
	of one or more patches you need, separated by spaces, commas, and/or
	hyphens.  Saying 35- says everything from 35 to the end.


	You can also get the patches via anonymous FTP from
	jpl-devvax.jpl.nasa.gov (128.149.1.143).

Index: patchlevel.h
Prereq: 13
1c1
< #define PATCHLEVEL 13
---
> #define PATCHLEVEL 14

Index: eval.c
Prereq: 3.0.1.4
*** eval.c.old	Mon Mar 12 17:09:57 1990
--- eval.c	Mon Mar 12 17:10:05 1990
***************
*** 1,4 ****
! /* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: eval.c,v 3.0.1.5 90/03/12 16:37:40 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,16 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	eval.c,v $
+  * Revision 3.0.1.5  90/03/12  16:37:40  lwall
+  * patch13: undef $/ didn't work as advertised
+  * patch13: added list slice operator (LIST)[LIST]
+  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
+  * 
   * Revision 3.0.1.4  90/02/28  17:36:59  lwall
   * patch9: added pipe function
   * patch9: a return in scalar context wouldn't return array
***************
*** 59,65 ****
  static STAB *stab2;
  static STIO *stio;
  static struct lstring *lstr;
! static char old_record_separator;
  extern int wantarray;
  
  double sin(), cos(), atan2(), pow();
--- 64,70 ----
  static STAB *stab2;
  static STIO *stio;
  static struct lstring *lstr;
! static int old_record_separator;
  extern int wantarray;
  
  double sin(), cos(), atan2(), pow();
***************
*** 159,165 ****
  	    tmps = str_get(tmpstr);	/* force to be string */
  	    STR_GROW(str, (anum * str->str_cur) + 1);
  	    repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
! 	    str->str_cur *= anum; str->str_ptr[str->str_cur] = '\0';
  	}
  	else
  	    str_sset(str,&str_no);
--- 164,171 ----
  	    tmps = str_get(tmpstr);	/* force to be string */
  	    STR_GROW(str, (anum * str->str_cur) + 1);
  	    repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
! 	    str->str_cur *= anum;
! 	    str->str_ptr[str->str_cur] = '\0';
  	}
  	else
  	    str_sset(str,&str_no);
***************
*** 642,665 ****
  	    str_magic(str, tmpstab, 'D', tmps, anum);
  #endif
  	break;
      case O_ASLICE:
! 	anum = TRUE;
  	argtype = FALSE;
  	goto do_slice_already;
      case O_HSLICE:
! 	anum = FALSE;
  	argtype = FALSE;
  	goto do_slice_already;
      case O_LASLICE:
! 	anum = TRUE;
  	argtype = TRUE;
  	goto do_slice_already;
      case O_LHSLICE:
! 	anum = FALSE;
  	argtype = TRUE;
        do_slice_already:
! 	sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype,
  	    gimme,arglast);
  	goto array_return;
      case O_PUSH:
  	if (arglast[2] - arglast[1] != 1)
--- 648,678 ----
  	    str_magic(str, tmpstab, 'D', tmps, anum);
  #endif
  	break;
+     case O_LSLICE:
+ 	anum = 2;
+ 	argtype = FALSE;
+ 	goto do_slice_already;
      case O_ASLICE:
! 	anum = 1;
  	argtype = FALSE;
  	goto do_slice_already;
      case O_HSLICE:
! 	anum = 0;
  	argtype = FALSE;
  	goto do_slice_already;
      case O_LASLICE:
! 	anum = 1;
  	argtype = TRUE;
  	goto do_slice_already;
      case O_LHSLICE:
! 	anum = 0;
  	argtype = TRUE;
        do_slice_already:
! 	sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
  	    gimme,arglast);
+ 	goto array_return;
+     case O_SPLICE:
+ 	sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),str,gimme,arglast);
  	goto array_return;
      case O_PUSH:
  	if (arglast[2] - arglast[1] != 1)

Index: eg/g/gsh
Prereq: 3.0.1.1
*** eg/g/gsh.old	Mon Mar 12 17:09:36 1990
--- eg/g/gsh	Mon Mar 12 17:09:38 1990
***************
*** 1,6 ****
  #! /usr/bin/perl
  
! # $Header: gsh,v 3.0.1.1 90/02/28 17:14:10 lwall Locked $
  
  # Do rsh globally--see man page
  
--- 1,6 ----
  #! /usr/bin/perl
  
! # $Header: gsh,v 3.0.1.2 90/03/12 16:34:11 lwall Locked $
  
  # Do rsh globally--see man page
  
***************
*** 75,83 ****
      if ($wanted > 0) {
  	print "rsh $host$l$n '$cmd'\n" unless $silent;
  	$SIG{'INT'} = 'DEFAULT';
! 	if (open(pipe,"rsh $host$l$n '$cmd'$dist 2>&1|")) {	# start an rsh
  	    $SIG{'INT'} = 'cont';
! 	    for ($iter=0; <pipe>; $iter++) {
  		unless ($iter) {
  		    $remainder .= "$host+"
  			if /Connection timed out|Permission denied/;
--- 75,83 ----
      if ($wanted > 0) {
  	print "rsh $host$l$n '$cmd'\n" unless $silent;
  	$SIG{'INT'} = 'DEFAULT';
! 	if (open(PIPE,"rsh $host$l$n '$cmd'$dist 2>&1|")) {	# start an rsh
  	    $SIG{'INT'} = 'cont';
! 	    for ($iter=0; <PIPE>; $iter++) {
  		unless ($iter) {
  		    $remainder .= "$host+"
  			if /Connection timed out|Permission denied/;
***************
*** 84,90 ****
  		}
  		print $showhost,$_;
  	    }
! 	    close(pipe);
  	} else {
  	    print "(Can't execute rsh: $!)\n";
  	    $SIG{'INT'} = 'cont';
--- 84,90 ----
  		}
  		print $showhost,$_;
  	    }
! 	    close(PIPE);
  	} else {
  	    print "(Can't execute rsh: $!)\n";
  	    $SIG{'INT'} = 'cont';

Index: t/op.array
Prereq: 3.0
*** t/op.array.old	Mon Mar 12 17:12:54 1990
--- t/op.array	Mon Mar 12 17:12:55 1990
***************
*** 1,8 ****
  #!./perl
  
! # $Header: op.array,v 3.0 89/10/18 15:26:55 lwall Locked $
  
! print "1..30\n";
  
  @ary = (1,2,3,4,5);
  if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";}
--- 1,8 ----
  #!./perl
  
! # $Header: op.array,v 3.0.1.1 90/03/12 17:03:03 lwall Locked $
  
! print "1..36\n";
  
  @ary = (1,2,3,4,5);
  if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";}
***************
*** 98,100 ****
--- 98,120 ----
  
  @foo = grep(!/e/,split(' ','now is the time for all good men to come to'));
  print join(' ',@foo) eq 'now is for all good to to' ? "ok 30\n" : "not ok 30\n";
+ 
+ $foo = join('',('a','b','c','d','e','f')[0..5]);
+ print $foo eq 'abcdef' ? "ok 31\n" : "not ok 31\n";
+ 
+ $foo = join('',('a','b','c','d','e','f')[0..1]);
+ print $foo eq 'ab' ? "ok 32\n" : "not ok 32\n";
+ 
+ $foo = join('',('a','b','c','d','e','f')[6]);
+ print $foo eq '' ? "ok 33\n" : "not ok 33\n";
+ 
+ @foo = ('a','b','c','d','e','f')[0,2,4];
+ @bar = ('a','b','c','d','e','f')[1,3,5];
+ $foo = join('',(@foo,@bar)[0..5]);
+ print $foo eq 'acebdf' ? "ok 34\n" : "not ok 34\n";
+ 
+ $foo = ('a','b','c','d','e','f')[0,2,4];
+ print $foo eq 'e' ? "ok 35\n" : "not ok 35\n";
+ 
+ $foo = ('a','b','c','d','e','f')[1];
+ print $foo eq 'b' ? "ok 36\n" : "not ok 36\n";

Index: t/op.mkdir
Prereq: 3.0.1.2
*** t/op.mkdir.old	Mon Mar 12 17:12:59 1990
--- t/op.mkdir	Mon Mar 12 17:13:00 1990
***************
*** 1,13 ****
  #!./perl
  
! # $Header: op.mkdir,v 3.0.1.2 90/02/28 18:35:31 lwall Locked $
  
  print "1..7\n";
  
  `rm -rf blurfl`;
  
! print (mkdir('blurfl',0666) ? "ok 1\n" : "not ok 1\n");
! print (mkdir('blurfl',0666) ? "not ok 2\n" : "ok 2\n");
  print ($! =~ /exists/ ? "ok 3\n" : "not ok 3\n");
  print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
  print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
--- 1,13 ----
  #!./perl
  
! # $Header: op.mkdir,v 3.0.1.3 90/03/12 17:03:57 lwall Locked $
  
  print "1..7\n";
  
  `rm -rf blurfl`;
  
! print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
! print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
  print ($! =~ /exists/ ? "ok 3\n" : "not ok 3\n");
  print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
  print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");

Index: t/op.push
Prereq: 3.0
*** t/op.push.old	Mon Mar 12 17:13:05 1990
--- t/op.push	Mon Mar 12 17:13:05 1990
***************
*** 1,11 ****
  #!./perl
  
! # $Header: op.push,v 3.0 89/10/18 15:30:48 lwall Locked $
  
! print "1..2\n";
  
  @x = (1,2,3);
  push(@x,@x);
  if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
  push(x,4);
  if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
--- 1,44 ----
  #!./perl
  
! # $Header: op.push,v 3.0.1.1 90/03/12 17:04:27 lwall Locked $
  
! @tests = split(/\n/, <<EOF);
! 0 3,			0 1 2,		3 4 5 6 7
! 0 0 a b c,		,		a b c 0 1 2 3 4 5 6 7
! 8 0 a b c,		,		0 1 2 3 4 5 6 7 a b c
! 7 0 6.5,		,		0 1 2 3 4 5 6 6.5 7
! 1 0 a b c d e f g h i j,,		0 a b c d e f g h i j 1 2 3 4 5 6 7
! 0 1 a,			0,		a 1 2 3 4 5 6 7
! 1 6 x y z,		1 2 3 4 5 6,	0 x y z 7
! 0 7 x y z,		0 1 2 3 4 5 6,	x y z 7
! 1 7 x y z,		1 2 3 4 5 6 7,	0 x y z
! 4,			4 5 6 7,	0 1 2 3
! -4,			4 5 6 7,	0 1 2 3
! EOF
  
+ print "1..", 2 + @tests, "\n";
+ die "blech" unless @tests;
+ 
  @x = (1,2,3);
  push(@x,@x);
  if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
  push(x,4);
  if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
+ 
+ $test = 3;
+ foreach $line (@tests) {
+     ($list,$get,$leave) = split(/,\t*/,$line);
+     @list = split(' ',$list);
+     @get = split(' ',$get);
+     @leave = split(' ',$leave);
+     @x = (0,1,2,3,4,5,6,7);
+     @got = splice(@x,@list);
+     if (join(':',@got) eq join(':',@get) &&
+ 	join(':',@x) eq join(':',@leave)) {
+ 	print "ok ",$test++,"\n";
+     }
+     else {
+ 	print "not ok ",$test++," got: @got == @get left: @x == @leave\n";
+     }
+ }
+ 

Index: perl.h
Prereq: 3.0.1.5
*** perl.h.old	Mon Mar 12 17:10:32 1990
--- perl.h	Mon Mar 12 17:10:35 1990
***************
*** 1,4 ****
! /* $Header: perl.h,v 3.0.1.5 90/02/28 17:52:28 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: perl.h,v 3.0.1.6 90/03/12 16:40:43 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:	perl.h,v $
+  * Revision 3.0.1.6  90/03/12  16:40:43  lwall
+  * patch13: did some ndir straightening up for Xenix
+  * 
   * Revision 3.0.1.5  90/02/28  17:52:28  lwall
   * patch9: Configure now determines whether volatile is supported
   * patch9: volatilized some more variables for super-optimizing compilers
***************
*** 197,216 ****
  #define ntohi ntohl
  #endif
  
! #if defined(I_DIRENT) && !defined(xenix)
  #   include <dirent.h>
  #   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
  #   else
! #	ifdef I_SYSNDIR
! #	    include <sys/ndir.h>
  #	    define DIRENT direct
  #	endif
  #   endif
--- 200,219 ----
  #define ntohi ntohl
  #endif
  
! #if defined(I_DIRENT) && !defined(M_XENIX)
  #   include <dirent.h>
  #   define DIRENT dirent
  #else
! #   ifdef I_SYSNDIR
! #	include <sys/ndir.h>
  #	define DIRENT direct
  #   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

Index: perl.man.1
Prereq: 3.0.1.3
*** perl.man.1.old	Mon Mar 12 17:10:48 1990
--- perl.man.1	Mon Mar 12 17:10:52 1990
***************
*** 1,7 ****
  .rn '' }`
! ''' $Header: perl.man.1,v 3.0.1.3 90/02/28 17:54:32 lwall Locked $
  ''' 
  ''' $Log:	perl.man.1,v $
  ''' Revision 3.0.1.3  90/02/28  17:54:32  lwall
  ''' patch9: @array in scalar context now returns length of array
  ''' patch9: in manual, example of open and ?: was backwards
--- 1,12 ----
  .rn '' }`
! ''' $Header: perl.man.1,v 3.0.1.4 90/03/12 16:44:33 lwall Locked $
  ''' 
  ''' $Log:	perl.man.1,v $
+ ''' Revision 3.0.1.4  90/03/12  16:44:33  lwall
+ ''' patch13: (LIST,) now legal
+ ''' patch13: improved LIST documentation
+ ''' patch13: example of if-elsif switch was wrong  
+ ''' 
  ''' Revision 3.0.1.3  90/02/28  17:54:32  lwall
  ''' patch9: @array in scalar context now returns length of array
  ''' patch9: in manual, example of open and ?: was backwards
***************
*** 630,636 ****
  
  .fi
  Array literals are denoted by separating individual values by commas, and
! enclosing the list in parentheses.
  In a context not requiring an array value, the value of the array literal
  is the value of the final element, as in the C comma operator.
  For example,
--- 635,646 ----
  
  .fi
  Array literals are denoted by separating individual values by commas, and
! enclosing the list in parentheses:
! .nf
! 
! 	(LIST)
! 
! .fi
  In a context not requiring an array value, the value of the array literal
  is the value of the final element, as in the C comma operator.
  For example,
***************
*** 645,650 ****
--- 655,700 ----
  
  .fi
  assigns the value of variable bar to variable foo.
+ Note that the value of an actual array in a scalar context is the length
+ of the array; the following assigns to $foo the value 3:
+ .nf
+ 
+ .ne 2
+     @foo = (\'cc\', \'\-E\', $bar);
+     $foo = @foo;		# $foo gets 3
+ 
+ .fi
+ You may have an optional comma before the closing parenthesis of an
+ array literal, so that you can say:
+ .nf
+ 
+     @foo = (
+ 	1,
+ 	2,
+ 	3,
+     );
+ 
+ .fi
+ When a LIST is evaluated, each element of the list is evaluated in
+ an array context, and the resulting array value is interpolated into LIST
+ just as if each individual element were a member of LIST.  Thus arrays
+ lose their identity in a LIST\*(--the list
+ 
+ 	(@foo,@bar,&SomeSub)
+ 
+ contains all the elements of @foo followed by all the elements of @bar,
+ followed by all the elements returned by the subroutine named SomeSub.
+ .PP
+ A list value may also be subscripted like a normal array.
+ Examples:
+ .nf
+ 
+ 	$time = (stat($file))[8];	# stat returns array value
+ 	$digit = ('a','b','c','d','e','f')[$digit-10];
+ 	return (pop(@foo),pop(@foo))[0];
+ 
+ .fi
+ .PP
  Array lists may be assigned to if and only if each element of the list
  is an lvalue:
  .nf
***************
*** 1079,1089 ****
  
  .ne 8
  	if (/^abc/)
! 		{ $abc = 1; last foo; }
  	elsif (/^def/)
! 		{ $def = 1; last foo; }
  	elsif (/^xyz/)
! 		{ $xyz = 1; last foo; }
  	else
  		{$nothing = 1;}
  
--- 1129,1139 ----
  
  .ne 8
  	if (/^abc/)
! 		{ $abc = 1; }
  	elsif (/^def/)
! 		{ $def = 1; }
  	elsif (/^xyz/)
! 		{ $xyz = 1; }
  	else
  		{$nothing = 1;}
  

Index: perl.man.2
Prereq: 3.0.1.3
*** perl.man.2.old	Mon Mar 12 17:11:04 1990
--- perl.man.2	Mon Mar 12 17:11:08 1990
***************
*** 1,7 ****
  ''' Beginning of part 2
! ''' $Header: perl.man.2,v 3.0.1.3 90/02/28 17:55:58 lwall Locked $
  '''
  ''' $Log:	perl.man.2,v $
  ''' 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
--- 1,10 ----
  ''' Beginning of part 2
! ''' $Header: perl.man.2,v 3.0.1.4 90/03/12 16:46:02 lwall Locked $
  '''
  ''' $Log:	perl.man.2,v $
+ ''' 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
***************
*** 1061,1066 ****
--- 1064,1071 ----
  It does NOT actually set $1, $2, etc. in this case, nor does it set $+, $`, $&
  or $'.
  If the match fails, a null array is returned.
+ If the match succeeds, but there were no parentheses, an array value of (1)
+ is returned.
  .Sp
  Examples:
  .nf

Index: perl.man.3
Prereq: 3.0.1.4
*** perl.man.3.old	Mon Mar 12 17:11:22 1990
--- perl.man.3	Mon Mar 12 17:11:26 1990
***************
*** 1,7 ****
  ''' Beginning of part 3
! ''' $Header: perl.man.3,v 3.0.1.4 90/02/28 18:00:09 lwall Locked $
  '''
  ''' $Log:	perl.man.3,v $
  ''' 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
--- 1,11 ----
  ''' Beginning of part 3
! ''' $Header: perl.man.3,v 3.0.1.5 90/03/12 16:52:21 lwall Locked $
  '''
  ''' $Log:	perl.man.3,v $
+ ''' 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
***************
*** 319,324 ****
--- 323,331 ----
  Returns non-zero if successful.
  FILEHANDLE may be a scalar variable name, in which case the variable contains
  the name of the filehandle, thus introducing one level of indirection.
+ (NOTE: If FILEHANDLE is a variable and the next token is a term, it may be
+ misinterpreted as an operator unless you interpose a + or put parens around
+ the arguments.)
  If FILEHANDLE is omitted, prints by default to standard output (or to the
  last selected output channel\*(--see select()).
  If LIST is also omitted, prints $_ to
***************
*** 329,334 ****
--- 336,344 ----
  Note that, because print takes a LIST, anything in the LIST is evaluated
  in an array context, and any subroutine that you call will have one or more
  of its expressions evaluated in an array context.
+ Also be careful not to follow the print keyword with a left parenthesis
+ unless you want the corresponding right parenthesis to terminate the
+ arguments to the print--interpose a + or put parens around all the arguments.
  .Ip "printf(FILEHANDLE LIST)" 8 10
  .Ip "printf(LIST)" 8
  .Ip "printf FILEHANDLE LIST" 8
***************
*** 715,720 ****
--- 725,761 ----
  		# prints xdogcatCainAbel
  	print sort @george, \'to\', @harry;
  		# prints AbelAxedCainPunishedcatchaseddoggonetoxyz
+ 
+ .fi
+ .Ip "splice(ARRAY,OFFSET,LENGTH,LIST)" 8 8
+ .Ip "splice(ARRAY,OFFSET,LENGTH)" 8
+ .Ip "splice(ARRAY,OFFSET)" 8
+ Removes the elements designated by OFFSET and LENGTH from an array, and
+ replaces them with the elements of LIST, if any.
+ Returns the elements removed from the array.
+ The array grows or shrinks as necessary.
+ If LENGTH is omitted, removes everything from OFFSET onward.
+ The following equivalencies hold (assuming $[ == 0):
+ .nf
+ 
+ 	push(@a,$x,$y)\h'|3.5i'splice(@a,$#x+1,0,$x,$y)
+ 	pop(@a)\h'|3.5i'splice(@a,-1)
+ 	shift(@a)\h'|3.5i'splice(@a,0,1)
+ 	unshift(@a,$x,$y)\h'|3.5i'splice(@a,0,0,$x,$y)
+ 	$a[$x] = $y\h'|3.5i'splice(@a,$x,1,$y);
+ 
+ Example, assuming array lengths are passed before arrays:
+ 	
+ 	sub aeq {	# compare two array values
+ 		local(@a) = splice(@_,0,shift);
+ 		local(@b) = splice(@_,0,shift);
+ 		return 0 unless @a == @b;	# same len?
+ 		while (@a) {
+ 		    return 0 if pop(@a) ne pop(@b);
+ 		}
+ 		return 1;
+ 	}
+ 	if (&aeq($len,@foo[1..$len],0+@bar,@bar)) { ... }
  
  .fi
  .Ip "split(/PATTERN/,EXPR,LIMIT)" 8 8

Index: perl.man.4
Prereq: 3.0.1.5
*** perl.man.4.old	Mon Mar 12 17:11:40 1990
--- perl.man.4	Mon Mar 12 17:11:46 1990
***************
*** 1,7 ****
  ''' Beginning of part 4
! ''' $Header: perl.man.4,v 3.0.1.5 90/02/28 18:01:52 lwall Locked $
  '''
  ''' $Log:	perl.man.4,v $
  ''' Revision 3.0.1.5  90/02/28  18:01:52  lwall
  ''' patch9: $0 is now always the command name
  ''' 
--- 1,10 ----
  ''' Beginning of part 4
! ''' $Header: perl.man.4,v 3.0.1.6 90/03/12 16:54:04 lwall Locked $
  '''
  ''' $Log:	perl.man.4,v $
+ ''' 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
  ''' 
***************
*** 211,217 ****
  In perl you can refer to all the objects of a particular name by prefixing
  the name with a star: *foo.
  When evaluated, it produces a scalar value that represents all the objects
! of that name.
  When assigned to within a local() operation, it causes the name mentioned
  to refer to whatever * value was assigned to it.
  Example:
--- 214,220 ----
  In perl you can refer to all the objects of a particular name by prefixing
  the name with a star: *foo.
  When evaluated, it produces a scalar value that represents all the objects
! of that name, including any filehandle, format or subroutine.
  When assigned to within a local() operation, it causes the name mentioned
  to refer to whatever * value was assigned to it.
  Example:
***************
*** 243,248 ****
--- 246,256 ----
  Since a *name value contains unprintable binary data, if it is used as
  an argument in a print, or as a %s argument in a printf or sprintf, it
  then has the value '*name', just so it prints out pretty.
+ .Sp
+ Even if you don't want to modify an array, this mechanism is useful for
+ passing multiple arrays in a single LIST, since normally the LIST mechanism
+ will merge all the array values so that you can't extract out the
+ individual arrays.
  .Sh "Regular Expressions"
  The patterns used in pattern matching are regular expressions such as
  those supplied in the Version 8 regexp routines.
***************
*** 1221,1227 ****
  
  .ne 4
  	system "echo $foo";		# Insecure
! 	system "echo", $foo;	# Secure (doesn't use sh)
  	system "echo $bar";		# Insecure
  	system "echo $abc";		# Insecure until PATH set
  
--- 1229,1235 ----
  
  .ne 4
  	system "echo $foo";		# Insecure
! 	system "/bin/echo", $foo;	# Secure (doesn't use sh)
  	system "echo $bar";		# Insecure
  	system "echo $abc";		# Insecure until PATH set
  

Index: perl.y
Prereq: 3.0.1.4
*** perl.y.old	Mon Mar 12 17:12:03 1990
--- perl.y	Mon Mar 12 17:12:08 1990
***************
*** 1,4 ****
! /* $Header: perl.y,v 3.0.1.4 90/02/28 18:03:23 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: perl.y,v 3.0.1.5 90/03/12 16:55:56 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
***************
*** 6,11 ****
--- 6,15 ----
   *    as specified in the README file that comes with the perl 3.0 kit.
   *
   * $Log:	perl.y,v $
+  * Revision 3.0.1.5  90/03/12  16:55:56  lwall
+  * patch13: added list slice operator (LIST)[LIST]
+  * patch13: (LIST,) now legal
+  * 
   * Revision 3.0.1.4  90/02/28  18:03:23  lwall
   * patch9: line numbers were bogus during certain portions of foreach evaluation
   * 
***************
*** 444,449 ****
--- 448,455 ----
  			{ $$ = l(localize(make_op(O_ASSIGN, 1,
  				localize(listish(make_list($3))),
  				Nullarg,Nullarg))); }
+ 	|	'(' expr ',' ')'
+ 			{ $$ = make_list(hide_ary($2)); }
  	|	'(' expr ')'
  			{ $$ = make_list(hide_ary($2)); }
  	|	'(' ')'
***************
*** 474,479 ****
--- 480,490 ----
  				stab2arg(A_STAB,hadd($1)),
  				jmaybe($3),
  				Nullarg); }
+ 	|	'(' expr ')' '[' expr ']'	%prec '('
+ 			{ $$ = make_op(O_LSLICE, 3,
+ 				Nullarg,
+ 				listish(make_list($5)),
+ 				listish(make_list($2))); }
  	|	ARY '[' expr ']'	%prec '('
  			{ $$ = make_op(O_ASLICE, 2,
  				stab2arg(A_STAB,aadd($1)),

Index: lib/perldb.pl
Prereq: 3.0.1.1
*** lib/perldb.pl.old	Mon Mar 12 17:10:18 1990
--- lib/perldb.pl	Mon Mar 12 17:10:20 1990
***************
*** 1,6 ****
  package DB;
  
! $header = '$Header: perldb.pl,v 3.0.1.1 89/10/26 23:14:02 lwall Locked $';
  #
  # This file is automatically included if you do perl -d.
  # It's probably not useful to include this yourself.
--- 1,6 ----
  package DB;
  
! $header = '$Header: perldb.pl,v 3.0.1.2 90/03/12 16:39:39 lwall Locked $';
  #
  # This file is automatically included if you do perl -d.
  # It's probably not useful to include this yourself.
***************
*** 10,15 ****
--- 10,19 ----
  # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
  #
  # $Log:	perldb.pl,v $
+ # Revision 3.0.1.2  90/03/12  16:39:39  lwall
+ # patch13: perl -d didn't format stack traces of *foo right
+ # patch13: perl -d wiped out scalar return values of subroutines
+ # 
  # Revision 3.0.1.1  89/10/26  23:14:02  lwall
  # patch1: RCS expanded an unintended $Header in lib/perldb.pl
  # 
***************
*** 385,393 ****
      $single |= 4 if $#stack == $deep;
      local(@args) = @_;
      for (@args) {
! 	if (/^Stab/ && length($_) == length($_main{'_main'})) {
  	    $_ = sprintf("%s",$_);
- 	    print "ARG: $_\n";
  	}
  	else {
  	    s/'/\\'/g;
--- 389,396 ----
      $single |= 4 if $#stack == $deep;
      local(@args) = @_;
      for (@args) {
! 	if (/^StB\000/ && length($_) == length($_main{'_main'})) {
  	    $_ = sprintf("%s",$_);
  	}
  	else {
  	    s/'/\\'/g;
***************
*** 397,410 ****
      push(@sub, $sub . '(' . join(', ', @args) . ') from ' . $line);
      if (wantarray) {
  	@i = &$sub;
      }
      else {
  	$i = &$sub;
! 	@i = $i;
      }
-     --$#sub;
-     $single |= pop(@stack);
-     @i;
  }
  
  $single = 1;			# so it stops on first executable statement
--- 400,415 ----
      push(@sub, $sub . '(' . join(', ', @args) . ') from ' . $line);
      if (wantarray) {
  	@i = &$sub;
+ 	--$#sub;
+ 	$single |= pop(@stack);
+ 	@i;
      }
      else {
  	$i = &$sub;
! 	--$#sub;
! 	$single |= pop(@stack);
! 	$i;
      }
  }
  
  $single = 1;			# so it stops on first executable statement

Index: regcomp.c
Prereq: 3.0.1.2
*** regcomp.c.old	Mon Mar 12 17:12:17 1990
--- regcomp.c	Mon Mar 12 17:12:20 1990
***************
*** 7,15 ****
   * blame Henry for some of the lack of readability.
   */
  
! /* $Header: regcomp.c,v 3.0.1.2 90/02/28 18:08:35 lwall Locked $
   *
   * $Log:	regcomp.c,v $
   * Revision 3.0.1.2  90/02/28  18:08:35  lwall
   * patch9: /[\200-\377]/ didn't work on machines with signed chars
   * 
--- 7,18 ----
   * blame Henry for some of the lack of readability.
   */
  
! /* $Header: regcomp.c,v 3.0.1.3 90/03/12 16:59:22 lwall Locked $
   *
   * $Log:	regcomp.c,v $
+  * Revision 3.0.1.3  90/03/12  16:59:22  lwall
+  * patch13: pattern matches can now use \0 to mean \000
+  * 
   * Revision 3.0.1.2  90/02/28  18:08:35  lwall
   * patch9: /[\200-\377]/ didn't work on machines with signed chars
   * 
***************
*** 639,645 ****
  			goto defchar;
  		case '0': case '1': case '2': case '3': case '4':
  		case '5': case '6': case '7': case '8': case '9':
! 			if (isdigit(regparse[1]))
  				goto defchar;
  			else {
  				ret = regnode(REF + *regparse++ - '0');
--- 642,648 ----
  			goto defchar;
  		case '0': case '1': case '2': case '3': case '4':
  		case '5': case '6': case '7': case '8': case '9':
! 			if (isdigit(regparse[1]) || *regparse == '0')
  				goto defchar;
  			else {
  				ret = regnode(REF + *regparse++ - '0');
***************
*** 708,717 ****
  					break;
  				case '0': case '1': case '2': case '3':case '4':
  				case '5': case '6': case '7': case '8':case '9':
! 				    if (isdigit(p[1])) {
! 					foo = *p++ - '0';
! 					foo <<= 3;
! 					foo += *p - '0';
  					if (isdigit(p[1]))
  					    foo = (foo<<3) + *++p - '0';
  					ender = foo;
--- 711,720 ----
  					break;
  				case '0': case '1': case '2': case '3':case '4':
  				case '5': case '6': case '7': case '8':case '9':
! 				    if (isdigit(p[1]) || *p == '0') {
! 					foo = *p - '0';
! 					if (isdigit(p[1]))
! 					    foo = (foo<<3) + *++p - '0';
  					if (isdigit(p[1]))
  					    foo = (foo<<3) + *++p - '0';
  					ender = foo;

Index: eg/scan/scanner
Prereq: 3.0
*** eg/scan/scanner.old	Mon Mar 12 17:09:44 1990
--- eg/scan/scanner	Mon Mar 12 17:09:45 1990
***************
*** 1,6 ****
  #!/usr/bin/perl
  
! # $Header: scanner,v 3.0 89/10/18 15:16:02 lwall Locked $
  
  # This runs all the scan_* routines on all the machines in /etc/ghosts.
  # We run this every morning at about 6 am:
--- 1,6 ----
  #!/usr/bin/perl
  
! # $Header: scanner,v 3.0.1.1 90/03/12 16:35:15 lwall Locked $
  
  # This runs all the scan_* routines on all the machines in /etc/ghosts.
  # We run this every morning at about 6 am:
***************
*** 68,82 ****
  		    $cmd = '/usr/bin/perl';
  		}
  		close(scan);
! 		if (open(pipe,"exec rsh $host '$cmd' <.x|")) {
  		    sleep(5);
  		    unlink '.x';
! 		    while (<pipe>) {
  			last if $iter++ > 1000;		# must be looping
  			next if /^[0-9.]+u [0-9.]+s/;
  			print $showhost,$_;
  		    }
! 		    close(pipe);
  		} else {
  		    print "(Can't execute rsh: $!)\n";
  		}
--- 68,82 ----
  		    $cmd = '/usr/bin/perl';
  		}
  		close(scan);
! 		if (open(PIPE,"exec rsh $host '$cmd' <.x|")) {
  		    sleep(5);
  		    unlink '.x';
! 		    while (<PIPE>) {
  			last if $iter++ > 1000;		# must be looping
  			next if /^[0-9.]+u [0-9.]+s/;
  			print $showhost,$_;
  		    }
! 		    close(PIPE);
  		} else {
  		    print "(Can't execute rsh: $!)\n";
  		}

Index: stab.c
Prereq: 3.0.1.4
*** stab.c.old	Mon Mar 12 17:12:33 1990
--- stab.c	Mon Mar 12 17:12:35 1990
***************
*** 1,4 ****
! /* $Header: stab.c,v 3.0.1.4 90/02/28 18:19:14 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: stab.c,v 3.0.1.5 90/03/12 17:00:11 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.5  90/03/12  17:00:11  lwall
+  * patch13: undef $/ didn't work as advertised
+  * 
   * Revision 3.0.1.4  90/02/28  18:19:14  lwall
   * patch9: $0 is now always the command name
   * patch9: you may now undef $/ to have no input record separator
***************
*** 309,315 ****
  	    multiline = (i != 0);
  	    break;
  	case '/':
! 	    if (str->str_ptr) {
  		record_separator = *str_get(str);
  		rslen = str->str_cur;
  	    }
--- 312,318 ----
  	    multiline = (i != 0);
  	    break;
  	case '/':
! 	    if (str->str_pok) {
  		record_separator = *str_get(str);
  		rslen = str->str_cur;
  	    }

Index: stab.h
Prereq: 3.0.1.1
*** stab.h.old	Mon Mar 12 17:12:38 1990
--- stab.h	Mon Mar 12 17:12:40 1990
***************
*** 1,4 ****
! /* $Header: stab.h,v 3.0.1.1 89/12/21 20:19:53 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: stab.h,v 3.0.1.2 90/03/12 17:00:43 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.h,v $
+  * Revision 3.0.1.2  90/03/12  17:00:43  lwall
+  * patch13: did some ndir straightening up for Xenix
+  * 
   * Revision 3.0.1.1  89/12/21  20:19:53  lwall
   * patch7: in stab.h, added some CRIPPLED_CC support for Microport
   * 
***************
*** 63,69 ****
  struct stio {
      FILE	*ifp;		/* ifp and ofp are normally the same */
      FILE	*ofp;		/* but sockets need separate streams */
! #if defined(I_DIRENT) || defined(I_SYSDIR)
      DIR		*dirp;		/* for opendir, readdir, etc */
  #endif
      long	lines;		/* $. */
--- 66,72 ----
  struct stio {
      FILE	*ifp;		/* ifp and ofp are normally the same */
      FILE	*ofp;		/* but sockets need separate streams */
! #ifdef READDIR
      DIR		*dirp;		/* for opendir, readdir, etc */
  #endif
      long	lines;		/* $. */

Index: str.c
Prereq: 3.0.1.5
*** str.c.old	Mon Mar 12 17:12:46 1990
--- str.c	Mon Mar 12 17:12:49 1990
***************
*** 1,4 ****
! /* $Header: str.c,v 3.0.1.5 90/02/28 18:30:38 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: str.c,v 3.0.1.6 90/03/12 17:02:14 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.6  90/03/12  17:02:14  lwall
+  * patch13: substr as lvalue didn't invalidate old numeric value
+  * 
   * Revision 3.0.1.5  90/02/28  18:30:38  lwall
   * patch9: you may now undef $/ to have no input record separator
   * patch9: nested evals clobbered their longjmp environment
***************
*** 459,464 ****
--- 462,470 ----
      register char *bigend;
      register int i;
  
+     bigstr->str_nok = 0;
+     bigstr->str_pok = SP_VALID;	/* disable possible screamer */
+ 
      i = littlelen - len;
      if (i > 0) {			/* string might grow */
  	STR_GROW(bigstr, bigstr->str_cur + i + 1);
***************
*** 485,492 ****
  
      if (midend > bigend)
  	fatal("panic: str_insert");
- 
-     bigstr->str_pok = SP_VALID;	/* disable possible screamer */
  
      if (mid - big > bigend - midend) {	/* faster to shorten from end */
  	if (littlelen) {
--- 491,496 ----

Index: toke.c
Prereq: 3.0.1.5
*** toke.c.old	Mon Mar 12 17:13:15 1990
--- toke.c	Mon Mar 12 17:13:22 1990
***************
*** 1,4 ****
! /* $Header: toke.c,v 3.0.1.5 90/02/28 18:47:06 lwall Locked $
   *
   *    Copyright (c) 1989, Larry Wall
   *
--- 1,4 ----
! /* $Header: toke.c,v 3.0.1.6 90/03/12 17:06:36 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:	toke.c,v $
+  * Revision 3.0.1.6  90/03/12  17:06:36  lwall
+  * patch13: last semicolon of program is now optional, just for Randal
+  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
+  * 
   * Revision 3.0.1.5  90/02/28  18:47:06  lwall
   * patch9: return grandfathered to never be function call
   * patch9: non-existent perldb.pl now gives reasonable error message
***************
*** 216,222 ****
  	    }
  	    oldoldbufptr = oldbufptr = s = str_get(linestr);
  	    str_set(linestr,"");
! 	    RETURN(0);
  	}
  	oldoldbufptr = oldbufptr = bufptr = s;
  	if (perldb) {
--- 220,226 ----
  	    }
  	    oldoldbufptr = oldbufptr = s = str_get(linestr);
  	    str_set(linestr,"");
! 	    RETURN(';');	/* not infinite loop because rsfp is NULL now */
  	}
  	oldoldbufptr = oldbufptr = bufptr = s;
  	if (perldb) {
***************
*** 1008,1013 ****
--- 1012,1021 ----
  		TERM(SPLIT);
  	    if (strEQ(d,"sprintf"))
  		FL(O_SPRINTF);
+ 	    if (strEQ(d,"splice")) {
+ 		yylval.ival = O_SPLICE;
+ 		OPERATOR(PUSH);
+ 	    }
  	    break;
  	case 'q':
  	    if (strEQ(d,"sqrt"))

*** End of Patch 14 ***
