perl 3.0 patch #14 patch #13, continued
authorLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Mon, 12 Mar 1990 04:13:22 +0000 (04:13 +0000)
committerLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Mon, 12 Mar 1990 04:13:22 +0000 (04:13 +0000)
See patch #13.

19 files changed:
eg/g/gsh
eg/scan/scanner
eval.c
lib/perldb.pl
patchlevel.h
perl.h
perl.man.1
perl.man.2
perl.man.3
perl.man.4
perl.y
regcomp.c
stab.c
stab.h
str.c
t/op.array
t/op.mkdir
t/op.push
toke.c

index 5ac8a4b..9de82a8 100644 (file)
--- 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';
index 8ef7fe8..70d2af8 100644 (file)
@@ -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 03518a8..18ce86e 100644 (file)
--- 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);
index 7b3e0aa..84543df 100644 (file)
@@ -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
index 910cae8..f95be0e 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 13
+#define PATCHLEVEL 14
diff --git a/perl.h b/perl.h
index ff95c26..0828407 100644 (file)
--- 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
index ec50d5f..dea4da6 100644 (file)
@@ -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;}
 
index 7fc67f8..722dc8a 100644 (file)
@@ -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
index 7d3972c..35a9c02 100644 (file)
@@ -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
@@ -716,6 +726,37 @@ Examples:
        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
 .Ip "split(/PATTERN/,EXPR)" 8 8
index 2843c20..0fd5983 100644 (file)
@@ -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 4e79d06..96ef414 100644 (file)
--- 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)),
index 1333de2..9a7be67 100644 (file)
--- 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 1a561f4..9d252bb 100644 (file)
--- 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 3cf7e9c..db2d60c 100644 (file)
--- 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 498e742..bbea53e 100644 (file)
--- 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);
index ebfb5e8..7129ee3 100644 (file)
@@ -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";
index 7c13e99..01dc6ca 100644 (file)
@@ -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");
index f2c5a7a..ebadf5f 100644 (file)
--- 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 cf80f35..8cf0264 100644 (file)
--- 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"))