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 #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; ; $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; ; $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/, < # define DIRENT dirent #else ! # ifdef I_SYSDIR ! # ifdef hp9000s500 ! # include /* may be wrong in the future */ ! # else ! # include ! # endif # define DIRENT direct # else ! # ifdef I_SYSNDIR ! # include # define DIRENT direct # endif # endif --- 200,219 ---- #define ntohi ntohl #endif ! #if defined(I_DIRENT) && !defined(M_XENIX) # include # define DIRENT dirent #else ! # ifdef I_SYSNDIR ! # include # define DIRENT direct # else ! # ifdef I_SYSDIR ! # ifdef hp9000s500 ! # include /* may be wrong in the future */ ! # else ! # include ! # 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 () { 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 () { 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 ***