core: commands that take an index now use integer expressions

This means that instead of just [list index 2+1], we can now do
[list index end-$n*2+1]

This applies to:

    lindex, linsert, lreplace, lset, lrange, lsort, regexp, regsub
    string index,first,last,range

Also add tests for both direct integer expressions and indexes.

Still needs doc update.

Signed-off-by: Steve Bennett <steveb@workware.net.au>

11 files changed, 189 insertions, 54 deletions

diff --git a/jim.c b/jim.c
index 4124a4d..bd5a819 100644
--- a/jim.c
+++ b/jim.c
@@ -6088,7 +6088,7 @@ int Jim_GetWideExpr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr)
         if (ret == JIM_OK) {
             ret = Jim_GetWide(interp, Jim_GetResult(interp), widePtr);
         }
-        else {
+        if (ret != JIM_OK) {
             /* XXX By doing this we throw away any more detailed message,
              * but typical integer expressions won't be very complex
              */
@@ -7828,9 +7828,12 @@ static void UpdateStringOfIndex(struct Jim_Obj *objPtr)
 
 static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
 {
-    int idx, end = 0;
+    jim_wide idx;
+    int end = 0;
     const char *str;
-    char *endptr;
+    Jim_Obj *exprObj = objPtr;
+
+    JimPanic((objPtr->refCount == 0, "SetIndexFromAny() called with zero refcount object"));
 
     /* Get the string representation */
     str = Jim_String(objPtr);
@@ -7840,34 +7843,33 @@ static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
         end = 1;
         str += 3;
         idx = 0;
-    }
-    else {
-        idx = jim_strtol(str, &endptr);
+        switch (*str) {
+            case '\0':
+                exprObj = NULL;
+                break;
 
-        if (endptr == str) {
-            goto badindex;
+            case '-':
+            case '+':
+                /* Create a temp object here for evaluation, but this only happens
+                 * once unless the index object shimmers since the result is kept
+                 */
+                exprObj = Jim_NewStringObj(interp, str, -1);
+                break;
+
+            default:
+                goto badindex;
         }
-        str = endptr;
     }
-
-    /* Now str may include any number of +<num> or -<num> */
-    while (*str == '+' || *str == '-') {
-        int sign = (*str == '+' ? 1 : -1);
-
-        idx += sign * jim_strtol(++str, &endptr);
-        if (endptr == str) {
+    if (exprObj) {
+        int ret;
+        Jim_IncrRefCount(exprObj);
+        ret = Jim_GetWideExpr(interp, exprObj, &idx);
+        Jim_DecrRefCount(interp, exprObj);
+        if (ret != JIM_OK) {
             goto badindex;
         }
-        str = endptr;
     }
 
-    /* The only thing left should be spaces */
-    while (isspace(UCHAR(*str))) {
-        str++;
-    }
-    if (*str) {
-        goto badindex;
-    }
     if (end) {
         if (idx > 0) {
             idx = INT_MAX;
@@ -7889,7 +7891,7 @@ static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
 
   badindex:
     Jim_SetResultFormatted(interp,
-        "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
+        "bad index \"%#s\": must be intexpr or end?[+-]intexpr?", objPtr);
     return JIM_ERR;
 }
 
diff --git a/tcltest.tcl b/tcltest.tcl
index f93a35b..a95f665 100644
--- a/tcltest.tcl
+++ b/tcltest.tcl
@@ -152,7 +152,7 @@ if {![exists -proc puts]} {
 proc script_source {script} {
 	lassign [info source $script] f l
 	if {$f ne ""} {
-		puts "At      : $f:$l"
+		puts "$f:$l:Error test failure"
 		return \t$f:$l
 	}
 }
@@ -160,7 +160,7 @@ proc script_source {script} {
 proc error_source {} {
 	lassign [info stacktrace] p f l
 	if {$f ne ""} {
-		puts "At      : $f:$l"
+		puts "$f:$l:Error test failure"
 		return \t$f:$l
 	}
 }
diff --git a/tests/intexpr.test b/tests/intexpr.test
new file mode 100644
index 0000000..9ad6632
--- /dev/null
+++ b/tests/intexpr.test
@@ -0,0 +1,133 @@
+source [file dirname [info script]]/testing.tcl
+
+needs constraint jim
+
+# There are two kinds of commands that use (safe) integer expressions:
+# direct: loop, range, incr, string repeat, lrepeat, pack, unpack, rand
+# index: lindex, linsert, lreplace, lset, lrange, lsort, regexp, regsub, string index,first,last,range
+#
+# Since they are all identical under the covers, we only test one from each group here,
+# string repeat and string index
+
+test intexpr-1.1 {string repeat} {
+	string repeat a 2+1
+} {aaa}
+
+test intexpr-1.2 {string repeat} {
+	string repeat a 2-1
+} {a}
+
+test intexpr-1.3 {string repeat} {
+	string repeat a 2*3
+} {aaaaaa}
+
+test intexpr-1.4 {string repeat - function calls} {
+	string repeat a int(abs(-2))
+} {aa}
+
+test intexpr-1.4 {string repeat - expanded var} {
+	set n 3
+	string repeat a $n+1
+} {aaaa}
+
+test intexpr-1.5 {string repeat - no subst var} -body {
+	set n 3
+	string repeat a {$n+1}
+} -returnCodes error -result {expected integer expression but got "$n+1"}
+
+test intexpr-1.6 {string repeat - no subst cmd} -body {
+	string repeat a {[string length xy]+1}
+} -returnCodes error -result {expected integer expression but got "[string length xy]+1"}
+
+test intexpr-1.6 {string repeat - no subst dictvar} -body {
+	set b(3) 4
+	string repeat a {$b(4)}
+} -returnCodes error -result {expected integer expression but got "$b(4)"}
+
+test intexpr-1.7 {string repeat - no subst dictvar} -body {
+	set b(3) 4
+	string repeat a {$b(4)+2}
+} -returnCodes error -result {expected integer expression but got "$b(4)+2"}
+
+set str abcdefghi
+test intexpr-2.1 {string index} {
+	string index $str 2+1
+} {d}
+
+test intexpr-2.2 {string index} {
+	string index $str 2-1
+} {b}
+
+test intexpr-2.3 {string index} {
+	string index $str 2*3
+} {g}
+
+test intexpr-2.4 {string index - function calls} {
+	string index $str int(abs(-2))
+} {c}
+
+test intexpr-2.4 {string index - expanded var} {
+	set n 3
+	string index $str $n+1
+} {e}
+
+test intexpr-2.5 {string index - no subst var} -body {
+	set n 3
+	string index $str {$n+1}
+} -returnCodes error -result {bad index "$n+1": must be intexpr or end?[+-]intexpr?}
+
+test intexpr-2.6 {string index - no subst cmd} -body {
+	string index $str {[string length xy]+1}
+} -returnCodes error -result {bad index "[string length xy]+1": must be intexpr or end?[+-]intexpr?}
+
+test intexpr-2.6 {string index - no subst dictvar} -body {
+	set b(3) 4
+	string index $str {$b(4)}
+} -returnCodes error -result {bad index "$b(4)": must be intexpr or end?[+-]intexpr?}
+
+test intexpr-2.7 {string index - no subst dictvar} -body {
+	set b(3) 4
+	string index $str {$b(4)+2}
+} -returnCodes error -result {bad index "$b(4)+2": must be intexpr or end?[+-]intexpr?}
+
+test intexpr-3.1 {string index} {
+	string index $str end-2+1
+} {h}
+
+test intexpr-3.2 {string index} {
+	string index $str end-2-1
+} {f}
+
+test intexpr-3.3 {string index} {
+	string index $str end-2*3
+} {c}
+
+test intexpr-3.4 {string index - function calls} {
+	string index $str end+int(-2)
+} {g}
+
+test intexpr-3.4 {string index - expanded var} {
+	set n 3
+	string index $str end-($n+1)
+} {e}
+
+test intexpr-3.5 {string index - no subst var} -body {
+	set n 3
+	string index $str {end-($n+1)}
+} -returnCodes error -result {bad index "end-($n+1)": must be intexpr or end?[+-]intexpr?}
+
+test intexpr-3.6 {string index - no subst cmd} -body {
+	string index $str {end-[string length xy]+1}
+} -returnCodes error -result {bad index "end-[string length xy]+1": must be intexpr or end?[+-]intexpr?}
+
+test intexpr-3.6 {string index - no subst dictvar} -body {
+	set b(3) 4
+	string index $str {end-$b(4)}
+} -returnCodes error -result {bad index "end-$b(4)": must be intexpr or end?[+-]intexpr?}
+
+test intexpr-3.7 {string index - no subst dictvar} -body {
+	set b(3) -4
+	string index $str {end+$b(4)-2}
+} -returnCodes error -result {bad index "end+$b(4)-2": must be intexpr or end?[+-]intexpr?}
+
+testreport
diff --git a/tests/jim.test b/tests/jim.test
index 79cbd8d..3c0f953 100644
--- a/tests/jim.test
+++ b/tests/jim.test
@@ -371,7 +371,7 @@ test lset-4.2 {lset, not compiled, 3 args, bad index} {
     list [catch {
 	eval [list $lset a [list 2a2] w]
     } msg] $msg
-} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}}
 
 test lset-4.3 {lset, not compiled, 3 args, index out of range} {
     set a {x y z}
@@ -406,7 +406,7 @@ test lset-4.8 {lset, not compiled, 3 args, bad index} {
     list [catch {
 	eval [list $lset a 2a2 w]
     } msg] $msg
-} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}}
 
 test lset-4.9 {lset, not compiled, 3 args, index out of range} {
     set a {x y z}
@@ -542,7 +542,7 @@ test lset-7.10 {lset, not compiled, data sharing} {
 test lset-8.3 {lset, not compiled, bad second index} {
     set a {{b c} {d e}}
     list [catch {eval [list $lset a 0 2a2 f]} msg] $msg
-} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}}
 
 test lset-8.5 {lset, not compiled, second index out of range} {
     set a {{b c} {d e} {f g}}
@@ -1555,7 +1555,7 @@ test lindex-2.2 {singleton index list} {
 test lindex-2.4 {malformed index list} {
     set x \{
     list [catch { eval [list $lindex {a b c} $x] } result] $result
-} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
+} {1 bad\ index\ \"\{\":\ must\ be\ intexpr\ or\ end?\[+-\]intexpr?}
 
 # Indices that are integers or convertible to integers
 
@@ -1614,7 +1614,7 @@ test lindex-4.5 {index = end-3} {
 test lindex-4.8 {bad integer, not octal} {
     set x end-0a2
     list [catch { eval [list $lindex {a b c} $x] } result] $result
-} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "end-0a2": must be intexpr or end?[+-]intexpr?}}
 
 #test lindex-4.9 {incomplete end} {
 #    set x en
@@ -1624,11 +1624,11 @@ test lindex-4.8 {bad integer, not octal} {
 test lindex-4.10 {incomplete end-} {
     set x end-
     list [catch { eval [list $lindex {a b c} $x] } result] $result
-} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "end-": must be intexpr or end?[+-]intexpr?}}
 
 test lindex-5.1 {bad second index} {
     list [catch { eval [list $lindex {a b c} 0 0a2] } result] $result
-} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "0a2": must be intexpr or end?[+-]intexpr?}}
 
 test lindex-5.2 {good second index} {
     eval [list $lindex {{a b c} {d e f} {g h i}} 1 2]
@@ -1678,7 +1678,7 @@ test lindex-10.2 {singleton index list} {
 test lindex-10.4 {malformed index list} {
     set x \{
     list [catch { lindex {a b c} $x } result] $result
-} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
+} {1 bad\ index\ \"\{\":\ must\ be\ intexpr\ or\ end?\[+-\]intexpr?}
 
 # Indices that are integers or convertible to integers
 
@@ -1758,16 +1758,16 @@ test lindex-12.5 {index = end-3} {
 test lindex-12.8 {bad integer, not octal} {
     set x end-0a2
     list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "end-0a2": must be intexpr or end?[+-]intexpr?}}
 
 test lindex-12.10 {incomplete end-} {
     set x end-
     list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "end-": must be intexpr or end?[+-]intexpr?}}
 
 test lindex-13.1 {bad second index} {
     list [catch { lindex {a b c} 0 0a2 } result] $result
-} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "0a2": must be intexpr or end?[+-]intexpr?}}
 
 test lindex-13.2 {good second index} {
     catch {
@@ -2050,7 +2050,7 @@ test string-7.1 {string last, too few args} {
 } {1 {wrong # args: should be "string last subString string ?index?"}}
 test string-7.2 {string last, bad args} {
     list [catch {string last a b c} msg] $msg
-} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "c": must be intexpr or end?[+-]intexpr?}}
 test string-7.3 {string last, too many args} {
     list [catch {string last a b c d} msg] $msg
 } {1 {wrong # args: should be "string last subString string ?index?"}}
diff --git a/tests/linsert.test b/tests/linsert.test
index b528d11..98a2e0a 100644
--- a/tests/linsert.test
+++ b/tests/linsert.test
@@ -82,10 +82,10 @@ test linsert-2.1 {linsert errors} {
 } {1 {wrong # args: should be "linsert list index ?element ...?"}}
 test linsert-2.2 {linsert errors} {
     list [catch {linsert a b} msg] $msg
-} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "b": must be intexpr or end?[+-]intexpr?}}
 test linsert-2.3 {linsert errors} {
     list [catch {linsert a 12x 2} msg] $msg
-} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "12x": must be intexpr or end?[+-]intexpr?}}
 test linsert-2.4 {linsert errors} tcl {
     list [catch {linsert \{ 12 2} msg] $msg
 } {1 {unmatched open brace in list}}
diff --git a/tests/lrange.test b/tests/lrange.test
index e72421c..3b8d094 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -69,10 +69,10 @@ test lrange-2.2 {error conditions} {
 } {1 {wrong # args: should be "lrange list first last"}}
 test lrange-2.3 {error conditions} {
     list [catch {lrange a b 6} msg] $msg
-} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "b": must be intexpr or end?[+-]intexpr?}}
 test lrange-2.4 {error conditions} {
     list [catch {lrange a 0 enigma} msg] $msg
-} {1 {bad index "enigma": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "enigma": must be intexpr or end?[+-]intexpr?}}
 test lrange-2.5 {error conditions} tcl {
     list [catch {lrange "a \{b c" 3 4} msg] $msg
 } {1 {unmatched open brace in list}}
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 32a2111..03ba859 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -116,13 +116,13 @@ test lreplace-2.2 {lreplace errors} {
 } {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
 test lreplace-2.3 {lreplace errors} {
     list [catch {lreplace x a 10} msg] $msg
-} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "a": must be intexpr or end?[+-]intexpr?}}
 test lreplace-2.4 {lreplace errors} {
     list [catch {lreplace x 10 x} msg] $msg
-} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "x": must be intexpr or end?[+-]intexpr?}}
 test lreplace-2.5 {lreplace errors} {
     list [catch {lreplace x 10 1x} msg] $msg
-} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "1x": must be intexpr or end?[+-]intexpr?}}
 test lreplace-2.6 {lreplace errors} {
     list [catch {lreplace x 3 2} msg] $msg
 } {0 x}
diff --git a/tests/lsort.test b/tests/lsort.test
index 5808b89..dd5a019 100644
--- a/tests/lsort.test
+++ b/tests/lsort.test
@@ -51,7 +51,7 @@ test lsort-1.11 {Tcl_LsortObjCmd procedure, -index option} {
 } {1 {"-index" option must be followed by list index}}
 test lsort-1.12 {Tcl_LsortObjCmd procedure, -index option} {
     list [catch {lsort -index foo {1 3 2 5}} msg] $msg
-} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "foo": must be intexpr or end?[+-]intexpr?}}
 test lsort-1.13 {Tcl_LsortObjCmd procedure, -index option} {
     lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
 } {1 {2 25} {3 16 42} {10 20 50 100}}
diff --git a/tests/regexp.test b/tests/regexp.test
index 45eddbb..356fa66 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -221,7 +221,7 @@ test regexp-6.8 {regexp errors} jim {
 } {1 {can't set "f1(f2)": variable isn't array}}
 test regexp-6.9 {regexp errors, -start bad int check} {
     list [catch {regexp -start bogus {^$} {}} msg] $msg
-} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}}
 test regexp-6.10 {regexp errors, -start too few args} {
     list [catch {regexp -all -start} msg] $msg
 } {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
@@ -378,7 +378,7 @@ test regexp-11.7 {regsub errors} jim {
 } {1 {can't set "f1(f2)": variable isn't array}}
 test regexp-11.8 {regsub errors, -start bad int check} {
     list [catch {regsub -start bogus pattern string rep var} msg] $msg
-} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}}
 test regexp-11.9 {regsub without final variable name returns value} {
     regsub b abaca X
 } {aXaca}
diff --git a/tests/regexp2.test b/tests/regexp2.test
index 936224d..9b6cdcf 100644
--- a/tests/regexp2.test
+++ b/tests/regexp2.test
@@ -287,7 +287,7 @@ test regexpComp-6.9 {regexp errors, -start bad int check} {
     evalInProc {
 	list [catch {regexp -start bogus {^$} {}} msg] $msg
     }
-} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}}
 
 test regexpComp-7.1 {basic regsub operation} {
     evalInProc {
@@ -545,7 +545,7 @@ test regexpComp-11.8 {regsub errors, -start bad int check} {
     evalInProc {
 	list [catch {regsub -start bogus pattern string rep var} msg] $msg
     }
-} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}}
 
 # This test crashes on the Mac unless you increase the Stack Space to about 1
 # Meg.  This is probably bigger than most users want... 
diff --git a/tests/string.test b/tests/string.test
index 3624565..086e470 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -837,10 +837,10 @@ test string-14.12 {string replace} {
 } {}
 test string-14.13 {string replace} {
     list [catch {string replace abc abc 1} msg] $msg
-} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "abc": must be intexpr or end?[+-]intexpr?}}
 test string-14.14 {string replace} {
     list [catch {string replace abc 1 eof} msg] $msg
-} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
+} {1 {bad index "eof": must be intexpr or end?[+-]intexpr?}}
 test string-14.15 {string replace} {
     string replace abcdefghijklmnop end-10 end-2 NEW
 } {abcdeNEWop}
@@ -1029,6 +1029,6 @@ test string-24.12 {string byterange, full range} {
 } abcdef
 test string-24.13 {string byterange, invalid range} -body {
     string byterange abcdef foo bar
-} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
+} -returnCodes error -result {bad index "foo": must be intexpr or end?[+-]intexpr?}
 
 testreport