diff options
| -rw-r--r-- | Todo | 1 | ||||
| -rw-r--r-- | cop.h | 3 | ||||
| -rw-r--r-- | op.c | 38 | ||||
| -rw-r--r-- | pod/perldiag.pod | 7 | ||||
| -rw-r--r-- | pod/perlop.pod | 9 | ||||
| -rw-r--r-- | pp_ctl.c | 25 | ||||
| -rw-r--r-- | pp_hot.c | 25 | ||||
| -rwxr-xr-x | t/op/range.t | 18 |
8 files changed, 109 insertions, 17 deletions
@@ -32,7 +32,6 @@ Optimizations constant function cache switch structures eval qw() at compile time - foreach (1..1000000) foreach(reverse...) Set KEEP on constant split Cache eval tree (unless lexical outer scope used (mark in &compiling?)) @@ -114,7 +114,8 @@ struct block_loop { SV * itersave; SV * iterlval; AV * iterary; - I32 iterix; + IV iterix; + IV itermax; }; #define PUSHLOOP(cx, ivar, s) \ @@ -3024,12 +3024,44 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont #endif } if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) { - expr = scalar(ref(expr, OP_ITER)); + expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART); iterflags |= OPf_STACKED; } + else if (expr->op_type == OP_NULL && + (expr->op_flags & OPf_KIDS) && + ((BINOP*)expr)->op_first->op_type == OP_FLOP) + { + /* Basically turn for($x..$y) into the same as for($x,$y), but we + * set the STACKED flag to indicate that these values are to be + * treated as min/max values by 'pp_iterinit'. + */ + UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; + CONDOP* range = (CONDOP*) flip->op_first; + OP* left = range->op_first; + OP* right = left->op_sibling; + LISTOP* list; + + range->op_flags &= ~OPf_KIDS; + range->op_first = Nullop; + + list = (LISTOP*)newLISTOP(OP_LIST, 0, left, right); + list->op_first->op_next = range->op_true; + left->op_next = range->op_false; + right->op_next = (OP*)list; + list->op_next = list->op_first; + + op_free(expr); + expr = (OP*)(list); + null(expr); + iterflags |= OPf_STACKED; + } + else { + expr = mod(force_list(expr), OP_GREPSTART); + } + + loop = (LOOP*)list(convert(OP_ENTERITER, iterflags, - append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART), - scalar(sv)))); + append_elem(OP_LIST, expr, scalar(sv)))); assert(!loop->op_next); Renew(loop, 1, LOOP); loop->op_targ = padoff; diff --git a/pod/perldiag.pod b/pod/perldiag.pod index d6d261bb44..d8323f2328 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2047,6 +2047,13 @@ last argument of the previous construct, for example: (S) The subroutine being declared or defined had previously been declared or defined with a different function prototype. +=item Range iterator outside integer range + +(F) One (or both) of the numeric arguments to the range operator ".." +are outside the range which can be represented by integers internally. +One possible workaround is to force Perl to use magical string +increment by prepending "0" to your numbers. + =item Read on closed filehandle E<lt>%sE<gt> (W) The filehandle you're reading from got itself closed sometime before now. diff --git a/pod/perlop.pod b/pod/perlop.pod index 0a081b56d1..5232278362 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -369,10 +369,11 @@ Use "or" for assignment is unlikely to do what you want; see below. Binary ".." is the range operator, which is really two different operators depending on the context. In list context, it returns an array of values counting (by ones) from the left value to the right -value. This is useful for writing C<for (1..10)> loops and for doing -slice operations on arrays. Be aware that under the current implementation, -a temporary array is created, so you'll burn a lot of memory if you -write something like this: +value. This is useful for writing C<foreach (1..10)> loops and for +doing slice operations on arrays. In the current implementation, no +temporary array is created when the range operator is used as the +expression in C<foreach> loops, but older versions of Perl might burn +a lot of memory when you write something like this: for (1 .. 1_000_000) { # code @@ -815,6 +815,8 @@ PP(pp_flop) if (SvNIOKp(left) || !SvPOKp(left) || (looks_like_number(left) && *SvPVX(left) != '0') ) { + if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX) + croak("Range iterator outside integer range"); i = SvIV(left); max = SvIV(right); if (max >= i) { @@ -832,14 +834,13 @@ PP(pp_flop) char *tmps = SvPV(final, len); sv = sv_mortalcopy(left); - while (!SvNIOKp(sv) && SvCUR(sv) <= len && - strNE(SvPVX(sv),tmps) ) { + while (!SvNIOKp(sv) && SvCUR(sv) <= len) { XPUSHs(sv); + if (strEQ(SvPVX(sv),tmps)) + break; sv = sv_2mortal(newSVsv(sv)); sv_inc(sv); } - if (strEQ(SvPVX(sv),tmps)) - XPUSHs(sv); } } else { @@ -1367,8 +1368,22 @@ PP(pp_enteriter) PUSHBLOCK(cx, CXt_LOOP, SP); PUSHLOOP(cx, svp, MARK); - if (op->op_flags & OPf_STACKED) + if (op->op_flags & OPf_STACKED) { cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); + if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) { + dPOPss; + if (SvNIOKp(sv) || !SvPOKp(sv) || + (looks_like_number(sv) && *SvPVX(sv) != '0')) { + if (SvNV(sv) < IV_MIN || + SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX) + croak("Range iterator outside integer range"); + cx->blk_loop.iterix = SvIV(sv); + cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary); + } + else + cx->blk_loop.iterlval = newSVsv(sv); + } + } else { cx->blk_loop.iterary = curstack; AvFILLp(curstack) = SP - stack_base; @@ -1403,6 +1403,31 @@ PP(pp_iter) DIE("panic: pp_iter"); av = cx->blk_loop.iterary; + if (SvTYPE(av) != SVt_PVAV) { + /* iterate ($min .. $max) */ + if (cx->blk_loop.iterlval) { + /* string increment */ + register SV* cur = cx->blk_loop.iterlval; + STRLEN maxlen; + char *max = SvPV((SV*)av, maxlen); + if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { + sv_setsv(*cx->blk_loop.itervar, cur); + if (strEQ(SvPVX(cur), max)) + sv_setiv(cur, 0); /* terminate next time */ + else + sv_inc(cur); + RETPUSHYES; + } + RETPUSHNO; + } + /* integer increment */ + if (cx->blk_loop.iterix > cx->blk_loop.itermax) + RETPUSHNO; + sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++); + RETPUSHYES; + } + + /* iterate array */ if (cx->blk_loop.iterix >= (av == curstack ? cx->blk_oldsp : AvFILL(av))) RETPUSHNO; diff --git a/t/op/range.t b/t/op/range.t index 746da46800..7999b869cb 100755 --- a/t/op/range.t +++ b/t/op/range.t @@ -1,8 +1,6 @@ #!./perl -# $RCSfile: range.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:14 $ - -print "1..8\n"; +print "1..10\n"; print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n"; @@ -34,3 +32,17 @@ print $x eq 'abcdefghijklmnopqrstuvwxyz' ? "ok 7\n" : "not ok 7 $x\n"; @x = 'A'..'ZZ'; print @x == 27 * 26 ? "ok 8\n" : "not ok 8\n"; + +@x = '09' .. '08'; # should produce '09', '10',... '99' (strange but true) +print "not " unless join(",", @x) eq + join(",", map {sprintf "%02d",$_} 9..99); +print "ok 9\n"; + +# same test with foreach (which is a separate implementation) +@y = (); +foreach ('09'..'08') { + push(@y, $_); +} +print "not " unless join(",", @y) eq join(",", @x); +print "ok 10\n"; + |