perl 3.0 patch #14 patch #13, continued

See patch #13.

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';

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";
 		}

eval.c

@@ -1,11 +1,16 @@
-/* $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
  *
  *    You may distribute under the terms of the GNU General Public License
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	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);

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 @@ package DB;
 # 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

patchlevel.h

@@ -1 +1 @@
-#define PATCHLEVEL 13
+#define PATCHLEVEL 14

perl.h

@@ -1,11 +1,14 @@
-/* $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
  *
  *    You may distribute under the terms of the GNU General Public License
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	perl.h,v $
+ * Revision 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

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;}
 

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