diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | jim.c | 59 | ||||
| -rw-r--r-- | test.tcl | 95 |
3 files changed, 156 insertions, 3 deletions
@@ -1,3 +1,8 @@ +2005-03-24 12:00 antirez + + * ChangeLog, Makefile, TODO, jim-sdl.c: A simple SDL extension for + Jim. + 2005-03-22 15:32 antirez * ChangeLog, jim.c: Fix for short circuit in expr. @@ -2,7 +2,7 @@ * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org> * Copyright 2005 Clemens Hintze <c.hintze@gmx.net> * - * $Id: jim.c,v 1.127 2005/03/22 14:32:50 antirez Exp $ + * $Id: jim.c,v 1.128 2005/03/24 13:58:05 antirez Exp $ * * Licensed under the Apache License, Version 2.0 (the "License"); * you may not use this file except in compliance with the License. @@ -10698,6 +10698,60 @@ static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, return JIM_OK; } +static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step) +{ + jim_wide len; + + if (step == 0) return -1; + if (start == end) return 0; + else if (step > 0 && start > end) return -1; + else if (step < 0 && end > start) return -1; + len = end-start; + if (len < 0) len = -len; /* abs(len) */ + if (step < 0) step = -step; /* abs(step) */ + len = 1 + ((len-1)/step); + /* We can truncate safely to INT_MAX, the range command + * will always return an error for a such long range + * because Tcl lists can't be so long. */ + if (len > INT_MAX) len = INT_MAX; + return (int)((len < 0) ? -1 : len); +} + +/* [range] */ +static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, + Jim_Obj *const *argv) +{ + jim_wide start = 0, end, step = 1; + int len, i; + Jim_Obj *objPtr; + + if (argc < 2 || argc > 4) { + Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?"); + return JIM_ERR; + } + if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &end) != JIM_OK) + return JIM_ERR; + } else { + if (Jim_GetWide(interp, argv[1], &start) != JIM_OK || + Jim_GetWide(interp, argv[2], &end) != JIM_OK) + return JIM_ERR; + if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK) + return JIM_ERR; + } + if ((len = JimRangeLen(start, end, step)) == -1) { + Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1); + return JIM_ERR; + } + objPtr = Jim_NewListObj(interp, NULL, 0); + for (i = 0; i < len; i++) + ListAppendElement(objPtr, Jim_NewIntObj(interp, start+i*step)); + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + +/* [lrange] */ + static struct { const char *name; Jim_CmdProc cmdProc; @@ -10758,6 +10812,7 @@ static struct { {"env", Jim_EnvCoreCommand}, {"source", Jim_SourceCoreCommand}, {"lreverse", Jim_LreverseCoreCommand}, + {"range", Jim_RangeCoreCommand}, {NULL, NULL}, }; @@ -10876,7 +10931,7 @@ int Jim_InteractivePrompt(Jim_Interp *interp) printf("Welcome to Jim version %d.%d, " "Copyright (c) 2005 Salvatore Sanfilippo\n", JIM_VERSION / 100, JIM_VERSION % 100); - printf("CVS ID: $Id: jim.c,v 1.127 2005/03/22 14:32:50 antirez Exp $\n"); + printf("CVS ID: $Id: jim.c,v 1.128 2005/03/24 13:58:05 antirez Exp $\n"); Jim_SetVariableStrWithStr(interp, "jim_interactive", "1"); while (1) { char buf[1024]; @@ -1,4 +1,4 @@ -# $Id: test.tcl,v 1.25 2005/03/21 12:39:36 antirez Exp $ +# $Id: test.tcl,v 1.26 2005/03/24 13:58:05 antirez Exp $ # # This are Tcl tests imported into Jim. Tests that will probably not be passed # in the long term are usually removed (for example all the tests about @@ -4045,6 +4045,99 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} { list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199] } {200 10 20 30} +################################################################################ +# RANGE +################################################################################ + +test range-1.1 {basic range tests} { + range 0 10 +} {0 1 2 3 4 5 6 7 8 9} + +test range-1.2 {basic range tests} { + range 10 0 -1 +} {10 9 8 7 6 5 4 3 2 1} + +test range-1.3 {basic range tests} { + range 1 10 11 +} {1} + +test range-1.4 {basic range tests} { + range 1 10 11 +} {1} + +test range-1.5 {basic range tests} { + range 10 10 +} {} + +test range-1.6 {basic range tests} { + range 10 10 2 +} {} + +test range-1.7 {basic range test} { + range 5 +} {0 1 2 3 4} + +test range-1.8 {basic range test} { + range -10 -20 -2 +} {-10 -12 -14 -16 -18} + +test range-1.9 {basic range test} { + range -20 -10 3 +} {-20 -17 -14 -11} + +test range-2.0 {foreach range test} { + set k 0 + foreach {x y} [range 100] { + incr k [expr {$x*$y}] + } + set k +} {164150} + +test range-2.1 {foreach range test without obj reuse} { + set k 0 + set trash {} + foreach {x y} [range 100] { + incr k [expr {$x*$y}] + lappend trash $x $y + } + set trash {} + set k +} {164150} + +test range-2.2 {range element shimmering test} { + set k {} + foreach x [range 0 10] { + append k [llength $x] + } + set k +} {1111111111} + +test range-3.0 {llength range test} { + llength [range 5000] +} {5000} + +test range-3.1 {llength range test} { + llength [range 5000 5000] +} {0} + +test range-4.0 {lindex range test} { + lindex [range 1000] 500 +} {500} + +test range-4.1 {lindex range test} { + lindex [range 1000] end-2 +} {997} + +test range-5.0 {lindex llength range test} { + set k 0 + set trash {} + set r [range 100] + for {set i 0} {$i < [llength $r]} {incr i 2} { + incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}] + } + set trash {} + set k +} {164150} ################################################################################ # JIM REGRESSION TESTS |