lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (03/13/90)
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 ***
tneff@bfmny0.UU.NET (Tom Neff) (03/14/90)
This version built completely successfully on my machine (AT&T Sys V/386 3.2). All tests passed. New features appear to work as advertised. Hours of family fun. ---------------------- Please NOTE: dumpvar.pl still doesn't have a terminating '1;' to assure success, so code of the form do 'dumpvar.pl' | die ... can still fail. I keep patching this myself on each release but forgetting to mention it, then bombing on new patchlevels. No more. ---------------------- I seriously suggest that the next release add t/op.japh which runs through some of the most interesting Randal one-liners and verifies they all generate 'Just another Perl hacker,'. It's amazing how useful apparently frivolous code can be for finding unexpected bugs. -- 1955-1975: 36 Elvis movies. | Tom Neff 1975-1989: nothing. | tneff@bfmny0.UU.NET