perl 3.0 patch #14 patch #13, continued

See patch #13.

19 files changed, 277 insertions, 67 deletions

diff --git a/eg/g/gsh b/eg/g/gsh
index 5ac8a4b4aa..9de82a8df9 100644
--- a/eg/g/gsh
+++ b/eg/g/gsh
@@ -1,6 +1,6 @@
 #! /usr/bin/perl
 
-# $Header: gsh,v 3.0.1.1 90/02/28 17:14:10 lwall Locked $
+# $Header: gsh,v 3.0.1.2 90/03/12 16:34:11 lwall Locked $
 
 # Do rsh globally--see man page
 
@@ -75,16 +75,16 @@ line: while (<>) {		# for each line of ghosts
     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
+	if (open(PIPE,"rsh $host$l$n '$cmd'$dist 2>&1|")) {	# start an rsh
 	    $SIG{'INT'} = 'cont';
-	    for ($iter=0; <pipe>; $iter++) {
+	    for ($iter=0; <PIPE>; $iter++) {
 		unless ($iter) {
 		    $remainder .= "$host+"
 			if /Connection timed out|Permission denied/;
 		}
 		print $showhost,$_;
 	    }
-	    close(pipe);
+	    close(PIPE);
 	} else {
 	    print "(Can't execute rsh: $!)\n";
 	    $SIG{'INT'} = 'cont';
diff --git a/eg/scan/scanner b/eg/scan/scanner
index 8ef7fe8f5d..70d2af80c1 100644
--- a/eg/scan/scanner
+++ b/eg/scan/scanner
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-# $Header: scanner,v 3.0 89/10/18 15:16:02 lwall Locked $
+# $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,15 +68,15 @@ scan: while ($scan = shift(@scanlist)) {
 		    $cmd = '/usr/bin/perl';
 		}
 		close(scan);
-		if (open(pipe,"exec rsh $host '$cmd' <.x|")) {
+		if (open(PIPE,"exec rsh $host '$cmd' <.x|")) {
 		    sleep(5);
 		    unlink '.x';
-		    while (<pipe>) {
+		    while (<PIPE>) {
 			last if $iter++ > 1000;		# must be looping
 			next if /^[0-9.]+u [0-9.]+s/;
 			print $showhost,$_;
 		    }
-		    close(pipe);
+		    close(PIPE);
 		} else {
 		    print "(Can't execute rsh: $!)\n";
 		}
diff --git a/eval.c b/eval.c
index 03518a8bb4..18ce86e55e 100644
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $
+/* $Header: eval.c,v 3.0.1.5 90/03/12 16:37:40 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    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,7 +64,7 @@ STR str_args;
 static STAB *stab2;
 static STIO *stio;
 static struct lstring *lstr;
-static char old_record_separator;
+static int old_record_separator;
 extern int wantarray;
 
 double sin(), cos(), atan2(), pow();
@@ -159,7 +164,8 @@ register int sp;
 	    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';
+	    str->str_cur *= anum;
+	    str->str_ptr[str->str_cur] = '\0';
 	}
 	else
 	    str_sset(str,&str_no);
@@ -642,25 +648,32 @@ register int sp;
 	    str_magic(str, tmpstab, 'D', tmps, anum);
 #endif
 	break;
+    case O_LSLICE:
+	anum = 2;
+	argtype = FALSE;
+	goto do_slice_already;
     case O_ASLICE:
-	anum = TRUE;
+	anum = 1;
 	argtype = FALSE;
 	goto do_slice_already;
     case O_HSLICE:
-	anum = FALSE;
+	anum = 0;
 	argtype = FALSE;
 	goto do_slice_already;
     case O_LASLICE:
-	anum = TRUE;
+	anum = 1;
 	argtype = TRUE;
 	goto do_slice_already;
     case O_LHSLICE:
-	anum = FALSE;
+	anum = 0;
 	argtype = TRUE;
       do_slice_already:
-	sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype,
+	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)
 	    str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
diff --git a/lib/perldb.pl b/lib/perldb.pl
index 7b3e0aad7a..84543dfc76 100644
--- a/lib/perldb.pl
+++ b/lib/perldb.pl
@@ -1,6 +1,6 @@
 package DB;
 
-$header = '$Header: perldb.pl,v 3.0.1.1 89/10/26 23:14:02 lwall Locked $';
+$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,6 +10,10 @@ $header = '$Header: perldb.pl,v 3.0.1.1 89/10/26 23:14:02 lwall Locked $';
 # 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,9 +389,8 @@ sub sub {
     $single |= 4 if $#stack == $deep;
     local(@args) = @_;
     for (@args) {
-	if (/^Stab/ && length($_) == length($_main{'_main'})) {
+	if (/^StB\000/ && length($_) == length($_main{'_main'})) {
 	    $_ = sprintf("%s",$_);
-	    print "ARG: $_\n";
 	}
 	else {
 	    s/'/\\'/g;
@@ -397,14 +400,16 @@ sub sub {
     push(@sub, $sub . '(' . join(', ', @args) . ') from ' . $line);
     if (wantarray) {
 	@i = &$sub;
+	--$#sub;
+	$single |= pop(@stack);
+	@i;
     }
     else {
 	$i = &$sub;
-	@i = $i;
+	--$#sub;
+	$single |= pop(@stack);
+	$i;
     }
-    --$#sub;
-    $single |= pop(@stack);
-    @i;
 }
 
 $single = 1;			# so it stops on first executable statement
diff --git a/patchlevel.h b/patchlevel.h
index 910cae8f16..f95be0eb07 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 13
+#define PATCHLEVEL 14
diff --git a/perl.h b/perl.h
index ff95c2680b..0828407c67 100644
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $Header: perl.h,v 3.0.1.5 90/02/28 17:52:28 lwall Locked $
+/* $Header: perl.h,v 3.0.1.6 90/03/12 16:40:43 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    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,20 +200,20 @@ EXT int dbmlen;
 #define ntohi ntohl
 #endif
 
-#if defined(I_DIRENT) && !defined(xenix)
+#if defined(I_DIRENT) && !defined(M_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
+#   ifdef I_SYSNDIR
+#	include <sys/ndir.h>
 #	define DIRENT direct
 #   else
-#	ifdef I_SYSNDIR
-#	    include <sys/ndir.h>
+#	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
diff --git a/perl.man.1 b/perl.man.1
index ec50d5f062..dea4da6cfe 100644
--- a/perl.man.1
+++ b/perl.man.1
@@ -1,7 +1,12 @@
 .rn '' }`
-''' $Header: perl.man.1,v 3.0.1.3 90/02/28 17:54:32 lwall Locked $
+''' $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,7 +635,12 @@ bar
 
 .fi
 Array literals are denoted by separating individual values by commas, and
-enclosing the list in parentheses.
+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,6 +655,46 @@ assigns the entire array value to array foo, but
 
 .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,11 +1129,11 @@ or even
 
 .ne 8
 	if (/^abc/)
-		{ $abc = 1; last foo; }
+		{ $abc = 1; }
 	elsif (/^def/)
-		{ $def = 1; last foo; }
+		{ $def = 1; }
 	elsif (/^xyz/)
-		{ $xyz = 1; last foo; }
+		{ $xyz = 1; }
 	else
 		{$nothing = 1;}
 
diff --git a/perl.man.2 b/perl.man.2
index 7fc67f80a0..722dc8adb0 100644
--- a/perl.man.2
+++ b/perl.man.2
@@ -1,7 +1,10 @@
 ''' Beginning of part 2
-''' $Header: perl.man.2,v 3.0.1.3 90/02/28 17:55:58 lwall Locked $
+''' $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,6 +1064,8 @@ i.e. ($1, $2, $3.\|.\|.).
 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
diff --git a/perl.man.3 b/perl.man.3
index 7d3972c8d7..35a9c02270 100644
--- a/perl.man.3
+++ b/perl.man.3
@@ -1,7 +1,11 @@
 ''' Beginning of part 3
-''' $Header: perl.man.3,v 3.0.1.4 90/02/28 18:00:09 lwall Locked $
+''' $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,6 +323,9 @@ Prints a string or a comma-separated list of strings.
 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,6 +336,9 @@ use the select operation.
 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
@@ -717,6 +727,37 @@ Examples:
 		# 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
 .Ip "split(/PATTERN/,EXPR)" 8 8
 .Ip "split(/PATTERN/)" 8
diff --git a/perl.man.4 b/perl.man.4
index 2843c20215..0fd5983c4b 100644
--- a/perl.man.4
+++ b/perl.man.4
@@ -1,7 +1,10 @@
 ''' Beginning of part 4
-''' $Header: perl.man.4,v 3.0.1.5 90/02/28 18:01:52 lwall Locked $
+''' $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,7 +214,7 @@ of it rather than working with a local copy.
 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.
+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,6 +246,11 @@ The * mechanism will probably be more efficient in any case.
 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,7 +1229,7 @@ For example:
 
 .ne 4
 	system "echo $foo";		# Insecure
-	system "echo", $foo;	# Secure (doesn't use sh)
+	system "/bin/echo", $foo;	# Secure (doesn't use sh)
 	system "echo $bar";		# Insecure
 	system "echo $abc";		# Insecure until PATH set
 
diff --git a/perl.y b/perl.y
index 4e79d0619f..96ef414c43 100644
--- a/perl.y
+++ b/perl.y
@@ -1,4 +1,4 @@
-/* $Header: perl.y,v 3.0.1.4 90/02/28 18:03:23 lwall Locked $
+/* $Header: perl.y,v 3.0.1.5 90/03/12 16:55:56 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    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,6 +448,8 @@ term	:	'-' term %prec UMINUS
 			{ $$ = 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,6 +480,11 @@ term	:	'-' term %prec UMINUS
 				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)),
diff --git a/regcomp.c b/regcomp.c
index 1333de2f7b..9a7be67aad 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7,9 +7,12 @@
  * 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 $
+/* $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,7 +642,7 @@ int *flagp;
 			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]))
+			if (isdigit(regparse[1]) || *regparse == '0')
 				goto defchar;
 			else {
 				ret = regnode(REF + *regparse++ - '0');
@@ -708,10 +711,10 @@ int *flagp;
 					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]) || *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;
diff --git a/stab.c b/stab.c
index 1a561f47e9..9d252bb3b9 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $Header: stab.c,v 3.0.1.4 90/02/28 18:19:14 lwall Locked $
+/* $Header: stab.c,v 3.0.1.5 90/03/12 17:00:11 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    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,7 +312,7 @@ STR *str;
 	    multiline = (i != 0);
 	    break;
 	case '/':
-	    if (str->str_ptr) {
+	    if (str->str_pok) {
 		record_separator = *str_get(str);
 		rslen = str->str_cur;
 	    }
diff --git a/stab.h b/stab.h
index 3cf7e9c5b7..db2d60c36f 100644
--- a/stab.h
+++ b/stab.h
@@ -1,4 +1,4 @@
-/* $Header: stab.h,v 3.0.1.1 89/12/21 20:19:53 lwall Locked $
+/* $Header: stab.h,v 3.0.1.2 90/03/12 17:00:43 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    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,7 +66,7 @@ HASH *stab_hash();
 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)
+#ifdef READDIR
     DIR		*dirp;		/* for opendir, readdir, etc */
 #endif
     long	lines;		/* $. */
diff --git a/str.c b/str.c
index 498e7428f2..bbea53ef56 100644
--- a/str.c
+++ b/str.c
@@ -1,4 +1,4 @@
-/* $Header: str.c,v 3.0.1.5 90/02/28 18:30:38 lwall Locked $
+/* $Header: str.c,v 3.0.1.6 90/03/12 17:02:14 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    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,6 +462,9 @@ int littlelen;
     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);
@@ -486,8 +492,6 @@ int littlelen;
     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) {
 	    (void)bcopy(little, mid, littlelen);
diff --git a/t/op.array b/t/op.array
index ebfb5e8a4b..7129ee3e1d 100644
--- a/t/op.array
+++ b/t/op.array
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: op.array,v 3.0 89/10/18 15:26:55 lwall Locked $
+# $Header: op.array,v 3.0.1.1 90/03/12 17:03:03 lwall Locked $
 
-print "1..30\n";
+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,3 +98,23 @@ print join(' ',@foo) eq 'the time men come' ? "ok 29\n" : "not ok 29\n";
 
 @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";
diff --git a/t/op.mkdir b/t/op.mkdir
index 7c13e994dd..01dc6ca7b8 100644
--- a/t/op.mkdir
+++ b/t/op.mkdir
@@ -1,13 +1,13 @@
 #!./perl
 
-# $Header: op.mkdir,v 3.0.1.2 90/02/28 18:35:31 lwall Locked $
+# $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',0666) ? "ok 1\n" : "not ok 1\n");
-print (mkdir('blurfl',0666) ? "not ok 2\n" : "ok 2\n");
+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");
diff --git a/t/op.push b/t/op.push
index f2c5a7a931..ebadf5f6f4 100644
--- a/t/op.push
+++ b/t/op.push
@@ -1,11 +1,44 @@
 #!./perl
 
-# $Header: op.push,v 3.0 89/10/18 15:30:48 lwall Locked $
+# $Header: op.push,v 3.0.1.1 90/03/12 17:04:27 lwall Locked $
 
-print "1..2\n";
+@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";
+    }
+}
+
diff --git a/toke.c b/toke.c
index cf80f35d01..8cf0264d1d 100644
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $Header: toke.c,v 3.0.1.5 90/02/28 18:47:06 lwall Locked $
+/* $Header: toke.c,v 3.0.1.6 90/03/12 17:06:36 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    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,7 +220,7 @@ yylex()
 	    }
 	    oldoldbufptr = oldbufptr = s = str_get(linestr);
 	    str_set(linestr,"");
-	    RETURN(0);
+	    RETURN(';');	/* not infinite loop because rsfp is NULL now */
 	}
 	oldoldbufptr = oldbufptr = bufptr = s;
 	if (perldb) {
@@ -1008,6 +1012,10 @@ yylex()
 		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"))