Bug fixes and features

Support end+<n> index
And generally simplify the index handling
Add support for 'info nameofexecutable'

6 files changed, 110 insertions, 74 deletions

diff --git a/doc/jim_tcl.txt b/doc/jim_tcl.txt
index 0a03234..fe2e96b 100644
--- a/doc/jim_tcl.txt
+++ b/doc/jim_tcl.txt
@@ -2107,6 +2107,10 @@ The legal *option*'s (which may be abbreviated) are:
     specified, only those names matching *pattern* are returned.
     Matching is determined using the same rules as for 'string match'.
 
++*info nameofexecutable*+::
+    Returns the name of the binary file from which the application was invoked, either
+	as a path relative to the current directory or as a full path.
+
 +*info procs* ?'pattern'?+::
     If *pattern* isn't specified, returns a list of all the
     names of Tcl command procedures.
@@ -3638,6 +3642,9 @@ The following global variables are set by jimsh.
     If jimsh is invoked to run a script, this variable contains a list
     of any arguments supplied to the script.
 
++*jim_argv0*+::
+    The value of argv[0] when jimsh was invoked.
+
 LICENCE
 -------
 
diff --git a/jim.c b/jim.c
index 0284202..602f071 100644
--- a/jim.c
+++ b/jim.c
@@ -335,27 +335,6 @@ int Jim_StringToWide(const char *str, jim_wide *widePtr, int base)
     return JIM_OK;
 }
 
-int Jim_StringToIndex(const char *str, int *intPtr)
-{
-    char *endptr;
-
-    *intPtr = strtol(str, &endptr, 10);
-    if (endptr != str && (*endptr == '+' || *endptr == '-')) {
-        /* Support num+num and num-num, and even num--num */
-        *intPtr += ((*endptr == '-') ? -1 : 1) * strtol(endptr + 1, &endptr, 10);
-    }
-    if ( (str[0] == '\0') || (str == endptr) )
-        return JIM_ERR;
-    if (endptr[0] != '\0') {
-        while(*endptr) {
-            if (!isspace(*endptr))
-                return JIM_ERR;
-            endptr++;
-        }
-    }
-    return JIM_OK;
-}
-
 int Jim_DoubleToString(char *buf, double doubleValue)
 {
     int len;
@@ -6229,38 +6208,67 @@ int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr)
 {
     int index, end = 0;
     const char *str;
+    char *endptr;
 
     /* Get the string representation */
     str = Jim_GetString(objPtr, NULL);
+
     /* Try to convert into an index */
-    if (strcmp(str, "end") == 0) {
-        index = 0;
+    if (strncmp(str, "end", 3) == 0) {
         end = 1;
-    } else {
-        if (strncmp(str, "end-", 4) == 0) {
-            str += 4;
-            end = 1;
+        str += 3;
+        index = 0;
+    }
+    else {
+        index = strtol(str, &endptr, 10);
+
+        if (endptr == str) {
+            goto badindex;
         }
-        if (Jim_StringToIndex(str, &index) != JIM_OK) {
-            Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
-            Jim_AppendStrings(interp, Jim_GetResult(interp),
-                    "bad index \"", Jim_GetString(objPtr, NULL), "\": "
-                    "must be integer?[+-]integer? or end?-integer?", NULL);
-            return JIM_ERR;
+        str = endptr;
+    }
+
+    /* Now str may include or +<num> or -<num> */
+    if (*str == '+' || *str == '-') {
+        int sign = (*str == '+' ? 1 : -1);
+        index += sign * strtol(++str, &endptr, 10);
+        if (str == endptr || *endptr) {
+            goto badindex;
         }
+        str = endptr;
+    }
+    /* The only thing left should be spaces */
+    while (isspace(*str)) {
+        str++;
+    }
+    if (*str) {
+        goto badindex;
     }
     if (end) {
-        if (index < 0)
+        if (index > 0) {
             index = INT_MAX;
-        else
-            index = -(index+1);
-    } else if (!end && index < 0)
+        }
+        else {
+            /* end-1 is repesented as -2 */
+            index--;
+        }
+    }
+    else if (index < 0) {
         index = -INT_MAX;
+    }
+
     /* Free the old internal repr and set the new one. */
     Jim_FreeIntRep(interp, objPtr);
     objPtr->typePtr = &indexObjType;
     objPtr->internalRep.indexValue = index;
     return JIM_OK;
+
+badindex:
+    Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
+    Jim_AppendStrings(interp, Jim_GetResult(interp),
+            "bad index \"", Jim_GetString(objPtr, NULL), "\": "
+            "must be integer?[+-]integer? or end?[+-]integer?", NULL);
+    return JIM_ERR;
 }
 
 int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr)
@@ -12069,11 +12077,11 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
     static const char *commands[] = {
         "body", "commands", "procs", "exists", "globals", "level", "locals",
         "vars", "version", "patchlevel", "complete", "args", "hostname",
-        "script", "source", "stacktrace", NULL
+        "script", "source", "stacktrace", "nameofexecutable", NULL
     };
     enum {INFO_BODY, INFO_COMMANDS, INFO_PROCS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL,
           INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS,
-          INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE};
+          INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE};
     
     if (argc < 2) {
         Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?");
@@ -12201,9 +12209,11 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc,
         Jim_SetResult(interp,
                 Jim_NewIntObj(interp, Jim_ScriptIsComplete(s, len, NULL)));
     } else if (cmd == INFO_HOSTNAME) {
-        /* Redirect to os.hostname if it exists */
-        Jim_Obj *command = Jim_NewStringObj(interp, "os.gethostname", -1);
-        result = Jim_EvalObjVector(interp, 1, &command);
+        /* Redirect to os.gethostname if it exists */
+        return Jim_Eval(interp, "os.gethostname");
+    } else if (cmd == INFO_NAMEOFEXECUTABLE) {
+        /* Redirect to Tcl proc */
+        return Jim_Eval(interp, "info_nameofexecutable");
     }
     return result;
 }
diff --git a/jimsh.c b/jimsh.c
index 46c4110..6868b5b 100644
--- a/jimsh.c
+++ b/jimsh.c
@@ -135,6 +135,8 @@ int main(int argc, char *const argv[])
     Jim_ListAppendElement(interp, listObj, JimGetExePath(interp, argv[0]));
     Jim_SetVariableStr(interp, JIM_LIBPATH, listObj);
 
+    Jim_SetVariableStrWithStr(interp, "jim_argv0", argv[0]);
+
     if (argc == 1) {
         Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, "1");
         JimSetArgv(interp, 0, NULL);
diff --git a/tclcompat.tcl b/tclcompat.tcl
index bb59f38..e899278 100644
--- a/tclcompat.tcl
+++ b/tclcompat.tcl
@@ -94,4 +94,17 @@ proc errorInfo {error {stacktrace ""}} {
 	return $result
 }
 
+proc info_nameofexecutable {} {
+	if {[string first "/" $::jim_argv0] >= 0} {
+		return $::jim_argv0
+	}
+	foreach path [split [env PATH ""] :] {
+		set exec [file join $path $::jim_argv0]
+		if {[file executable $exec]} {
+			return $exec
+		}
+	}
+	return ""
+}
+
 set ::tcl_platform(platform) unix
diff --git a/test.tcl b/test.tcl
index 614c3ac..c4d287f 100644
--- a/test.tcl
+++ b/test.tcl
@@ -392,7 +392,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 integer?[+-]integer? or end?[+-]integer?}}
 
 test lset-4.3 {lset, not compiled, 3 args, index out of range} {
     set a {x y z}
@@ -427,7 +427,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 integer?[+-]integer? or end?[+-]integer?}}
 
 test lset-4.9 {lset, not compiled, 3 args, index out of range} {
     set a {x y z}
@@ -563,7 +563,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 integer?[+-]integer? or end?[+-]integer?}}
 
 test lset-8.5 {lset, not compiled, second index out of range} {
     set a {{b c} {d e} {f g}}
@@ -1578,7 +1578,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\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
 
 # Indices that are integers or convertible to integers
 
@@ -1637,7 +1637,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 integer?[+-]integer? or end?[+-]integer?}}
 
 #test lindex-4.9 {incomplete end} {
 #    set x en
@@ -1647,11 +1647,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 integer?[+-]integer? or end?[+-]integer?}}
 
 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 integer?[+-]integer? or end?[+-]integer?}}
 
 test lindex-5.2 {good second index} {
     eval [list $lindex {{a b c} {d e f} {g h i}} 1 2]
@@ -1701,7 +1701,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\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
 
 # Indices that are integers or convertible to integers
 
@@ -1781,16 +1781,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 integer?[+-]integer? or end?[+-]integer?}}
 
 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 integer?[+-]integer? or end?[+-]integer?}}
 
 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 integer?[+-]integer? or end?[+-]integer?}}
 
 test lindex-13.2 {good second index} {
     catch {
@@ -2041,7 +2041,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 integer?[+-]integer? or end?[+-]integer?}}
 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?"}}
@@ -3387,7 +3387,7 @@ test linsert-2.2 {linsert errors} {
 } {1 {wrong # args: should be "linsert list index element ?element ...?"}}
 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 integer?[+-]integer? or end?[+-]integer?}}
 
 test linsert-3.1 {linsert won't modify shared argument objects} {
     proc p {} {
@@ -3498,13 +3498,13 @@ test lreplace-2.2 {lreplace errors} {
 } {1 {wrong # args: should be "lreplace list first last ?element 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 integer?[+-]integer? or end?[+-]integer?}}
 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 integer?[+-]integer? or end?[+-]integer?}}
 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 integer?[+-]integer? or end?[+-]integer?}}
 test lreplace-2.6 {lreplace errors} {
     list [catch {lreplace x 3 2} msg] $msg
 } {1 {list doesn't contain element 3}}
@@ -3581,10 +3581,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 integer?[+-]integer? or end?[+-]integer?}}
 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 integer?[+-]integer? or end?[+-]integer?}}
 #test lrange-2.5 {error conditions} {
 #    list [catch {lrange "a \{b c" 3 4} msg] $msg
 #} {1 {unmatched open brace in list}}
diff --git a/tests/misc.test b/tests/misc.test
index 7f70bc3..3fffbf3 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -153,21 +153,21 @@ test lindex-1.7 "end" {
 	lindex {a b c} end-4
 } {}
 
-test lindex-1.8 "end - errors" {
-	catch {lindex {a b c} end-}
-} 1
+test lindex-1.8 "end + " {
+	lindex {a b c} end+1
+} {}
 
-test lindex-1.9 "end - errors" {
-	catch {lindex {a b c} end-blah}
-} 1
+test lindex-1.9 "end + " {
+	lindex {a b c} end+-1
+} b
 
 test lindex-1.10 "end - errors" {
-	catch {lindex {a b c} end+1}
+	catch {lindex {a b c} end-}
 } 1
 
-test lindex-1.11 "int+int, int-int" {
-	lindex {a b c} 0+1
-} b
+test lindex-1.11 "end - errors" {
+	catch {lindex {a b c} end-blah}
+} 1
 
 test lindex-1.12 "int+int, int-int" {
 	lindex {a b c} 0+4
@@ -186,9 +186,9 @@ test lindex-1.15 "int+int, int-int" {
 	lindex $l [lsearch $l b]-1
 } a
 
-test lindex-1.16 "int+int - errors" {
-	catch {lindex {a b c} 5+blah}
-} 1
+test lindex-1.16 "int+int, int-int" {
+	lindex {a b c} 0+1
+} b
 
 test lindex-1.17 "int+int - errors" {
 	catch {lindex {a b c} 5-blah}
@@ -198,7 +198,11 @@ test lindex-1.18 "int+int - errors" {
 	catch {lindex {a b c} blah-2}
 } 1
 
-test lindex-1.19 "unary plus" {
+test lindex-1.19 "int+int - errors" {
+	catch {lindex {a b c} 5+blah}
+} 1
+
+test lindex-1.20 "unary plus" {
 	lindex {a b c} +2
 } c