From: Larry Wall Date: Mon, 12 Mar 1990 04:13:22 +0000 (+0000) Subject: perl 3.0 patch #14 patch #13, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=79a0689e17f959bdb246dc37bbbbfeba4c2b3b56;p=p5sagit%2Fp5-mst-13.2.git perl 3.0 patch #14 patch #13, continued See patch #13. --- diff --git a/eg/g/gsh b/eg/g/gsh index 5ac8a4b..9de82a8 100644 --- a/eg/g/gsh +++ b/eg/g/gsh @@ -1,6 +1,6 @@ #! /usr/bin/perl -# $Header: gsh,v 3.0.1.1 90/02/28 17:14:10 lwall Locked $ +# $Header: gsh,v 3.0.1.2 90/03/12 16:34:11 lwall Locked $ # Do rsh globally--see man page @@ -75,16 +75,16 @@ line: while (<>) { # for each line of ghosts if ($wanted > 0) { print "rsh $host$l$n '$cmd'\n" unless $silent; $SIG{'INT'} = 'DEFAULT'; - if (open(pipe,"rsh $host$l$n '$cmd'$dist 2>&1|")) { # start an rsh + if (open(PIPE,"rsh $host$l$n '$cmd'$dist 2>&1|")) { # start an rsh $SIG{'INT'} = 'cont'; - for ($iter=0; ; $iter++) { + for ($iter=0; ; $iter++) { unless ($iter) { $remainder .= "$host+" if /Connection timed out|Permission denied/; } print $showhost,$_; } - close(pipe); + close(PIPE); } else { print "(Can't execute rsh: $!)\n"; $SIG{'INT'} = 'cont'; diff --git a/eg/scan/scanner b/eg/scan/scanner index 8ef7fe8..70d2af8 100644 --- a/eg/scan/scanner +++ b/eg/scan/scanner @@ -1,6 +1,6 @@ #!/usr/bin/perl -# $Header: scanner,v 3.0 89/10/18 15:16:02 lwall Locked $ +# $Header: scanner,v 3.0.1.1 90/03/12 16:35:15 lwall Locked $ # This runs all the scan_* routines on all the machines in /etc/ghosts. # We run this every morning at about 6 am: @@ -68,15 +68,15 @@ scan: while ($scan = shift(@scanlist)) { $cmd = '/usr/bin/perl'; } close(scan); - if (open(pipe,"exec rsh $host '$cmd' <.x|")) { + if (open(PIPE,"exec rsh $host '$cmd' <.x|")) { sleep(5); unlink '.x'; - while () { + while () { 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 --- a/eval.c +++ b/eval.c @@ -1,4 +1,4 @@ -/* $Header: eval.c,v 3.0.1.4 90/02/28 17:36:59 lwall Locked $ +/* $Header: eval.c,v 3.0.1.5 90/03/12 16:37:40 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: eval.c,v $ + * Revision 3.0.1.5 90/03/12 16:37:40 lwall + * patch13: undef $/ didn't work as advertised + * patch13: added list slice operator (LIST)[LIST] + * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST) + * * Revision 3.0.1.4 90/02/28 17:36:59 lwall * patch9: added pipe function * patch9: a return in scalar context wouldn't return array @@ -59,7 +64,7 @@ STR str_args; static STAB *stab2; static STIO *stio; static struct lstring *lstr; -static char old_record_separator; +static int old_record_separator; extern int wantarray; double sin(), cos(), atan2(), pow(); @@ -159,7 +164,8 @@ register int sp; tmps = str_get(tmpstr); /* force to be string */ STR_GROW(str, (anum * str->str_cur) + 1); repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum); - str->str_cur *= anum; str->str_ptr[str->str_cur] = '\0'; + str->str_cur *= anum; + str->str_ptr[str->str_cur] = '\0'; } else str_sset(str,&str_no); @@ -642,25 +648,32 @@ register int sp; str_magic(str, tmpstab, 'D', tmps, anum); #endif break; + case O_LSLICE: + anum = 2; + argtype = FALSE; + goto do_slice_already; case O_ASLICE: - anum = TRUE; + anum = 1; argtype = FALSE; goto do_slice_already; case O_HSLICE: - anum = FALSE; + anum = 0; argtype = FALSE; goto do_slice_already; case O_LASLICE: - anum = TRUE; + anum = 1; argtype = TRUE; goto do_slice_already; case O_LHSLICE: - anum = FALSE; + anum = 0; argtype = TRUE; do_slice_already: - sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype, + sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype, gimme,arglast); goto array_return; + case O_SPLICE: + sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),str,gimme,arglast); + goto array_return; case O_PUSH: if (arglast[2] - arglast[1] != 1) str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast); diff --git a/lib/perldb.pl b/lib/perldb.pl index 7b3e0aa..84543df 100644 --- a/lib/perldb.pl +++ b/lib/perldb.pl @@ -1,6 +1,6 @@ package DB; -$header = '$Header: perldb.pl,v 3.0.1.1 89/10/26 23:14:02 lwall Locked $'; +$header = '$Header: perldb.pl,v 3.0.1.2 90/03/12 16:39:39 lwall Locked $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. @@ -10,6 +10,10 @@ $header = '$Header: perldb.pl,v 3.0.1.1 89/10/26 23:14:02 lwall Locked $'; # have a breakpoint. It also inserts a do 'perldb.pl' before the first line. # # $Log: perldb.pl,v $ +# Revision 3.0.1.2 90/03/12 16:39:39 lwall +# patch13: perl -d didn't format stack traces of *foo right +# patch13: perl -d wiped out scalar return values of subroutines +# # Revision 3.0.1.1 89/10/26 23:14:02 lwall # patch1: RCS expanded an unintended $Header in lib/perldb.pl # @@ -385,9 +389,8 @@ sub sub { $single |= 4 if $#stack == $deep; local(@args) = @_; for (@args) { - if (/^Stab/ && length($_) == length($_main{'_main'})) { + if (/^StB\000/ && length($_) == length($_main{'_main'})) { $_ = sprintf("%s",$_); - print "ARG: $_\n"; } else { s/'/\\'/g; @@ -397,14 +400,16 @@ sub sub { push(@sub, $sub . '(' . join(', ', @args) . ') from ' . $line); if (wantarray) { @i = &$sub; + --$#sub; + $single |= pop(@stack); + @i; } else { $i = &$sub; - @i = $i; + --$#sub; + $single |= pop(@stack); + $i; } - --$#sub; - $single |= pop(@stack); - @i; } $single = 1; # so it stops on first executable statement diff --git a/patchlevel.h b/patchlevel.h index 910cae8..f95be0e 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 13 +#define PATCHLEVEL 14 diff --git a/perl.h b/perl.h index ff95c26..0828407 100644 --- a/perl.h +++ b/perl.h @@ -1,4 +1,4 @@ -/* $Header: perl.h,v 3.0.1.5 90/02/28 17:52:28 lwall Locked $ +/* $Header: perl.h,v 3.0.1.6 90/03/12 16:40:43 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.h,v $ + * Revision 3.0.1.6 90/03/12 16:40:43 lwall + * patch13: did some ndir straightening up for Xenix + * * Revision 3.0.1.5 90/02/28 17:52:28 lwall * patch9: Configure now determines whether volatile is supported * patch9: volatilized some more variables for super-optimizing compilers @@ -197,20 +200,20 @@ EXT int dbmlen; #define ntohi ntohl #endif -#if defined(I_DIRENT) && !defined(xenix) +#if defined(I_DIRENT) && !defined(M_XENIX) # include # define DIRENT dirent #else -# ifdef I_SYSDIR -# ifdef hp9000s500 -# include /* may be wrong in the future */ -# else -# include -# endif +# ifdef I_SYSNDIR +# include # define DIRENT direct # else -# ifdef I_SYSNDIR -# include +# ifdef I_SYSDIR +# ifdef hp9000s500 +# include /* may be wrong in the future */ +# else +# include +# endif # define DIRENT direct # endif # endif diff --git a/perl.man.1 b/perl.man.1 index ec50d5f..dea4da6 100644 --- a/perl.man.1 +++ b/perl.man.1 @@ -1,7 +1,12 @@ .rn '' }` -''' $Header: perl.man.1,v 3.0.1.3 90/02/28 17:54:32 lwall Locked $ +''' $Header: perl.man.1,v 3.0.1.4 90/03/12 16:44:33 lwall Locked $ ''' ''' $Log: perl.man.1,v $ +''' Revision 3.0.1.4 90/03/12 16:44:33 lwall +''' patch13: (LIST,) now legal +''' patch13: improved LIST documentation +''' patch13: example of if-elsif switch was wrong +''' ''' Revision 3.0.1.3 90/02/28 17:54:32 lwall ''' patch9: @array in scalar context now returns length of array ''' patch9: in manual, example of open and ?: was backwards @@ -630,7 +635,12 @@ bar .fi Array literals are denoted by separating individual values by commas, and -enclosing the list in parentheses. +enclosing the list in parentheses: +.nf + + (LIST) + +.fi In a context not requiring an array value, the value of the array literal is the value of the final element, as in the C comma operator. For example, @@ -645,6 +655,46 @@ assigns the entire array value to array foo, but .fi assigns the value of variable bar to variable foo. +Note that the value of an actual array in a scalar context is the length +of the array; the following assigns to $foo the value 3: +.nf + +.ne 2 + @foo = (\'cc\', \'\-E\', $bar); + $foo = @foo; # $foo gets 3 + +.fi +You may have an optional comma before the closing parenthesis of an +array literal, so that you can say: +.nf + + @foo = ( + 1, + 2, + 3, + ); + +.fi +When a LIST is evaluated, each element of the list is evaluated in +an array context, and the resulting array value is interpolated into LIST +just as if each individual element were a member of LIST. Thus arrays +lose their identity in a LIST\*(--the list + + (@foo,@bar,&SomeSub) + +contains all the elements of @foo followed by all the elements of @bar, +followed by all the elements returned by the subroutine named SomeSub. +.PP +A list value may also be subscripted like a normal array. +Examples: +.nf + + $time = (stat($file))[8]; # stat returns array value + $digit = ('a','b','c','d','e','f')[$digit-10]; + return (pop(@foo),pop(@foo))[0]; + +.fi +.PP Array lists may be assigned to if and only if each element of the list is an lvalue: .nf @@ -1079,11 +1129,11 @@ or even .ne 8 if (/^abc/) - { $abc = 1; last foo; } + { $abc = 1; } elsif (/^def/) - { $def = 1; last foo; } + { $def = 1; } elsif (/^xyz/) - { $xyz = 1; last foo; } + { $xyz = 1; } else {$nothing = 1;} diff --git a/perl.man.2 b/perl.man.2 index 7fc67f8..722dc8a 100644 --- a/perl.man.2 +++ b/perl.man.2 @@ -1,7 +1,10 @@ ''' Beginning of part 2 -''' $Header: perl.man.2,v 3.0.1.3 90/02/28 17:55:58 lwall Locked $ +''' $Header: perl.man.2,v 3.0.1.4 90/03/12 16:46:02 lwall Locked $ ''' ''' $Log: perl.man.2,v $ +''' Revision 3.0.1.4 90/03/12 16:46:02 lwall +''' patch13: documented behavior of @array = /noparens/ +''' ''' Revision 3.0.1.3 90/02/28 17:55:58 lwall ''' patch9: grep now returns number of items matched in scalar context ''' patch9: documented in-place modification capabilites of grep @@ -1061,6 +1064,8 @@ i.e. ($1, $2, $3.\|.\|.). It does NOT actually set $1, $2, etc. in this case, nor does it set $+, $`, $& or $'. If the match fails, a null array is returned. +If the match succeeds, but there were no parentheses, an array value of (1) +is returned. .Sp Examples: .nf diff --git a/perl.man.3 b/perl.man.3 index 7d3972c..35a9c02 100644 --- a/perl.man.3 +++ b/perl.man.3 @@ -1,7 +1,11 @@ ''' Beginning of part 3 -''' $Header: perl.man.3,v 3.0.1.4 90/02/28 18:00:09 lwall Locked $ +''' $Header: perl.man.3,v 3.0.1.5 90/03/12 16:52:21 lwall Locked $ ''' ''' $Log: perl.man.3,v $ +''' Revision 3.0.1.5 90/03/12 16:52:21 lwall +''' patch13: documented that print $filehandle &foo is ambiguous +''' patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST) +''' ''' Revision 3.0.1.4 90/02/28 18:00:09 lwall ''' patch9: added pipe function ''' patch9: documented how to handle arbitrary weird characters in filenames @@ -319,6 +323,9 @@ Prints a string or a comma-separated list of strings. Returns non-zero if successful. FILEHANDLE may be a scalar variable name, in which case the variable contains the name of the filehandle, thus introducing one level of indirection. +(NOTE: If FILEHANDLE is a variable and the next token is a term, it may be +misinterpreted as an operator unless you interpose a + or put parens around +the arguments.) If FILEHANDLE is omitted, prints by default to standard output (or to the last selected output channel\*(--see select()). If LIST is also omitted, prints $_ to @@ -329,6 +336,9 @@ use the select operation. Note that, because print takes a LIST, anything in the LIST is evaluated in an array context, and any subroutine that you call will have one or more of its expressions evaluated in an array context. +Also be careful not to follow the print keyword with a left parenthesis +unless you want the corresponding right parenthesis to terminate the +arguments to the print--interpose a + or put parens around all the arguments. .Ip "printf(FILEHANDLE LIST)" 8 10 .Ip "printf(LIST)" 8 .Ip "printf FILEHANDLE LIST" 8 @@ -717,6 +727,37 @@ Examples: # prints AbelAxedCainPunishedcatchaseddoggonetoxyz .fi +.Ip "splice(ARRAY,OFFSET,LENGTH,LIST)" 8 8 +.Ip "splice(ARRAY,OFFSET,LENGTH)" 8 +.Ip "splice(ARRAY,OFFSET)" 8 +Removes the elements designated by OFFSET and LENGTH from an array, and +replaces them with the elements of LIST, if any. +Returns the elements removed from the array. +The array grows or shrinks as necessary. +If LENGTH is omitted, removes everything from OFFSET onward. +The following equivalencies hold (assuming $[ == 0): +.nf + + push(@a,$x,$y)\h'|3.5i'splice(@a,$#x+1,0,$x,$y) + pop(@a)\h'|3.5i'splice(@a,-1) + shift(@a)\h'|3.5i'splice(@a,0,1) + unshift(@a,$x,$y)\h'|3.5i'splice(@a,0,0,$x,$y) + $a[$x] = $y\h'|3.5i'splice(@a,$x,1,$y); + +Example, assuming array lengths are passed before arrays: + + sub aeq { # compare two array values + local(@a) = splice(@_,0,shift); + local(@b) = splice(@_,0,shift); + return 0 unless @a == @b; # same len? + while (@a) { + return 0 if pop(@a) ne pop(@b); + } + return 1; + } + if (&aeq($len,@foo[1..$len],0+@bar,@bar)) { ... } + +.fi .Ip "split(/PATTERN/,EXPR,LIMIT)" 8 8 .Ip "split(/PATTERN/,EXPR)" 8 8 .Ip "split(/PATTERN/)" 8 diff --git a/perl.man.4 b/perl.man.4 index 2843c20..0fd5983 100644 --- a/perl.man.4 +++ b/perl.man.4 @@ -1,7 +1,10 @@ ''' Beginning of part 4 -''' $Header: perl.man.4,v 3.0.1.5 90/02/28 18:01:52 lwall Locked $ +''' $Header: perl.man.4,v 3.0.1.6 90/03/12 16:54:04 lwall Locked $ ''' ''' $Log: perl.man.4,v $ +''' Revision 3.0.1.6 90/03/12 16:54:04 lwall +''' patch13: improved documentation of *name +''' ''' Revision 3.0.1.5 90/02/28 18:01:52 lwall ''' patch9: $0 is now always the command name ''' @@ -211,7 +214,7 @@ of it rather than working with a local copy. In perl you can refer to all the objects of a particular name by prefixing the name with a star: *foo. When evaluated, it produces a scalar value that represents all the objects -of that name. +of that name, including any filehandle, format or subroutine. When assigned to within a local() operation, it causes the name mentioned to refer to whatever * value was assigned to it. Example: @@ -243,6 +246,11 @@ The * mechanism will probably be more efficient in any case. Since a *name value contains unprintable binary data, if it is used as an argument in a print, or as a %s argument in a printf or sprintf, it then has the value '*name', just so it prints out pretty. +.Sp +Even if you don't want to modify an array, this mechanism is useful for +passing multiple arrays in a single LIST, since normally the LIST mechanism +will merge all the array values so that you can't extract out the +individual arrays. .Sh "Regular Expressions" The patterns used in pattern matching are regular expressions such as those supplied in the Version 8 regexp routines. @@ -1221,7 +1229,7 @@ For example: .ne 4 system "echo $foo"; # Insecure - system "echo", $foo; # Secure (doesn't use sh) + system "/bin/echo", $foo; # Secure (doesn't use sh) system "echo $bar"; # Insecure system "echo $abc"; # Insecure until PATH set diff --git a/perl.y b/perl.y index 4e79d06..96ef414 100644 --- a/perl.y +++ b/perl.y @@ -1,4 +1,4 @@ -/* $Header: perl.y,v 3.0.1.4 90/02/28 18:03:23 lwall Locked $ +/* $Header: perl.y,v 3.0.1.5 90/03/12 16:55:56 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.y,v $ + * Revision 3.0.1.5 90/03/12 16:55:56 lwall + * patch13: added list slice operator (LIST)[LIST] + * patch13: (LIST,) now legal + * * Revision 3.0.1.4 90/02/28 18:03:23 lwall * patch9: line numbers were bogus during certain portions of foreach evaluation * @@ -444,6 +448,8 @@ term : '-' term %prec UMINUS { $$ = l(localize(make_op(O_ASSIGN, 1, localize(listish(make_list($3))), Nullarg,Nullarg))); } + | '(' expr ',' ')' + { $$ = make_list(hide_ary($2)); } | '(' expr ')' { $$ = make_list(hide_ary($2)); } | '(' ')' @@ -474,6 +480,11 @@ term : '-' term %prec UMINUS stab2arg(A_STAB,hadd($1)), jmaybe($3), Nullarg); } + | '(' expr ')' '[' expr ']' %prec '(' + { $$ = make_op(O_LSLICE, 3, + Nullarg, + listish(make_list($5)), + listish(make_list($2))); } | ARY '[' expr ']' %prec '(' { $$ = make_op(O_ASLICE, 2, stab2arg(A_STAB,aadd($1)), diff --git a/regcomp.c b/regcomp.c index 1333de2..9a7be67 100644 --- a/regcomp.c +++ b/regcomp.c @@ -7,9 +7,12 @@ * blame Henry for some of the lack of readability. */ -/* $Header: regcomp.c,v 3.0.1.2 90/02/28 18:08:35 lwall Locked $ +/* $Header: regcomp.c,v 3.0.1.3 90/03/12 16:59:22 lwall Locked $ * * $Log: regcomp.c,v $ + * Revision 3.0.1.3 90/03/12 16:59:22 lwall + * patch13: pattern matches can now use \0 to mean \000 + * * Revision 3.0.1.2 90/02/28 18:08:35 lwall * patch9: /[\200-\377]/ didn't work on machines with signed chars * @@ -639,7 +642,7 @@ int *flagp; goto defchar; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': - if (isdigit(regparse[1])) + if (isdigit(regparse[1]) || *regparse == '0') goto defchar; else { ret = regnode(REF + *regparse++ - '0'); @@ -708,10 +711,10 @@ int *flagp; break; case '0': case '1': case '2': case '3':case '4': case '5': case '6': case '7': case '8':case '9': - if (isdigit(p[1])) { - foo = *p++ - '0'; - foo <<= 3; - foo += *p - '0'; + if (isdigit(p[1]) || *p == '0') { + foo = *p - '0'; + if (isdigit(p[1])) + foo = (foo<<3) + *++p - '0'; if (isdigit(p[1])) foo = (foo<<3) + *++p - '0'; ender = foo; diff --git a/stab.c b/stab.c index 1a561f4..9d252bb 100644 --- a/stab.c +++ b/stab.c @@ -1,4 +1,4 @@ -/* $Header: stab.c,v 3.0.1.4 90/02/28 18:19:14 lwall Locked $ +/* $Header: stab.c,v 3.0.1.5 90/03/12 17:00:11 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.c,v $ + * Revision 3.0.1.5 90/03/12 17:00:11 lwall + * patch13: undef $/ didn't work as advertised + * * Revision 3.0.1.4 90/02/28 18:19:14 lwall * patch9: $0 is now always the command name * patch9: you may now undef $/ to have no input record separator @@ -309,7 +312,7 @@ STR *str; multiline = (i != 0); break; case '/': - if (str->str_ptr) { + if (str->str_pok) { record_separator = *str_get(str); rslen = str->str_cur; } diff --git a/stab.h b/stab.h index 3cf7e9c..db2d60c 100644 --- a/stab.h +++ b/stab.h @@ -1,4 +1,4 @@ -/* $Header: stab.h,v 3.0.1.1 89/12/21 20:19:53 lwall Locked $ +/* $Header: stab.h,v 3.0.1.2 90/03/12 17:00:43 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.h,v $ + * Revision 3.0.1.2 90/03/12 17:00:43 lwall + * patch13: did some ndir straightening up for Xenix + * * Revision 3.0.1.1 89/12/21 20:19:53 lwall * patch7: in stab.h, added some CRIPPLED_CC support for Microport * @@ -63,7 +66,7 @@ HASH *stab_hash(); struct stio { FILE *ifp; /* ifp and ofp are normally the same */ FILE *ofp; /* but sockets need separate streams */ -#if defined(I_DIRENT) || defined(I_SYSDIR) +#ifdef READDIR DIR *dirp; /* for opendir, readdir, etc */ #endif long lines; /* $. */ diff --git a/str.c b/str.c index 498e742..bbea53e 100644 --- a/str.c +++ b/str.c @@ -1,4 +1,4 @@ -/* $Header: str.c,v 3.0.1.5 90/02/28 18:30:38 lwall Locked $ +/* $Header: str.c,v 3.0.1.6 90/03/12 17:02:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ + * Revision 3.0.1.6 90/03/12 17:02:14 lwall + * patch13: substr as lvalue didn't invalidate old numeric value + * * Revision 3.0.1.5 90/02/28 18:30:38 lwall * patch9: you may now undef $/ to have no input record separator * patch9: nested evals clobbered their longjmp environment @@ -459,6 +462,9 @@ int littlelen; register char *bigend; register int i; + bigstr->str_nok = 0; + bigstr->str_pok = SP_VALID; /* disable possible screamer */ + i = littlelen - len; if (i > 0) { /* string might grow */ STR_GROW(bigstr, bigstr->str_cur + i + 1); @@ -486,8 +492,6 @@ int littlelen; if (midend > bigend) fatal("panic: str_insert"); - bigstr->str_pok = SP_VALID; /* disable possible screamer */ - if (mid - big > bigend - midend) { /* faster to shorten from end */ if (littlelen) { (void)bcopy(little, mid, littlelen); diff --git a/t/op.array b/t/op.array index ebfb5e8..7129ee3 100644 --- a/t/op.array +++ b/t/op.array @@ -1,8 +1,8 @@ #!./perl -# $Header: op.array,v 3.0 89/10/18 15:26:55 lwall Locked $ +# $Header: op.array,v 3.0.1.1 90/03/12 17:03:03 lwall Locked $ -print "1..30\n"; +print "1..36\n"; @ary = (1,2,3,4,5); if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";} @@ -98,3 +98,23 @@ print join(' ',@foo) eq 'the time men come' ? "ok 29\n" : "not ok 29\n"; @foo = grep(!/e/,split(' ','now is the time for all good men to come to')); print join(' ',@foo) eq 'now is for all good to to' ? "ok 30\n" : "not ok 30\n"; + +$foo = join('',('a','b','c','d','e','f')[0..5]); +print $foo eq 'abcdef' ? "ok 31\n" : "not ok 31\n"; + +$foo = join('',('a','b','c','d','e','f')[0..1]); +print $foo eq 'ab' ? "ok 32\n" : "not ok 32\n"; + +$foo = join('',('a','b','c','d','e','f')[6]); +print $foo eq '' ? "ok 33\n" : "not ok 33\n"; + +@foo = ('a','b','c','d','e','f')[0,2,4]; +@bar = ('a','b','c','d','e','f')[1,3,5]; +$foo = join('',(@foo,@bar)[0..5]); +print $foo eq 'acebdf' ? "ok 34\n" : "not ok 34\n"; + +$foo = ('a','b','c','d','e','f')[0,2,4]; +print $foo eq 'e' ? "ok 35\n" : "not ok 35\n"; + +$foo = ('a','b','c','d','e','f')[1]; +print $foo eq 'b' ? "ok 36\n" : "not ok 36\n"; diff --git a/t/op.mkdir b/t/op.mkdir index 7c13e99..01dc6ca 100644 --- a/t/op.mkdir +++ b/t/op.mkdir @@ -1,13 +1,13 @@ #!./perl -# $Header: op.mkdir,v 3.0.1.2 90/02/28 18:35:31 lwall Locked $ +# $Header: op.mkdir,v 3.0.1.3 90/03/12 17:03:57 lwall Locked $ print "1..7\n"; `rm -rf blurfl`; -print (mkdir('blurfl',0666) ? "ok 1\n" : "not ok 1\n"); -print (mkdir('blurfl',0666) ? "not ok 2\n" : "ok 2\n"); +print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n"); +print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n"); print ($! =~ /exists/ ? "ok 3\n" : "not ok 3\n"); print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n"); print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n"); diff --git a/t/op.push b/t/op.push index f2c5a7a..ebadf5f 100644 --- a/t/op.push +++ b/t/op.push @@ -1,11 +1,44 @@ #!./perl -# $Header: op.push,v 3.0 89/10/18 15:30:48 lwall Locked $ +# $Header: op.push,v 3.0.1.1 90/03/12 17:04:27 lwall Locked $ -print "1..2\n"; +@tests = split(/\n/, <