diff options
| -rw-r--r-- | jim-eventloop.c | 6 | ||||
| -rw-r--r-- | jim-interactive.c | 16 | ||||
| -rw-r--r-- | jim.c | 34 | ||||
| -rw-r--r-- | jim.h | 2 | ||||
| -rw-r--r-- | jimsh.c | 9 | ||||
| -rw-r--r-- | stdlib.tcl | 25 | ||||
| -rw-r--r-- | tclcompat.tcl | 22 |
7 files changed, 48 insertions, 66 deletions
diff --git a/jim-eventloop.c b/jim-eventloop.c index 9c1bd7c..7192745 100644 --- a/jim-eventloop.c +++ b/jim-eventloop.c @@ -116,8 +116,10 @@ int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr) } else { /* Report the error to stderr. */ - fprintf(stderr, "Background error:" JIM_NL); - Jim_PrintErrorMessage(interp); + Jim_MakeErrorMessage(interp); + fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL)); + /* And reset the result */ + Jim_SetResultString(interp, "", -1); } } Jim_DecrRefCount(interp, objv[0]); diff --git a/jim-interactive.c b/jim-interactive.c index 4aa2923..15b4cba 100644 --- a/jim-interactive.c +++ b/jim-interactive.c @@ -53,18 +53,16 @@ int Jim_InteractivePrompt(Jim_Interp *interp) } retcode = Jim_EvalObj(interp, scriptObjPtr); Jim_DecrRefCount(interp, scriptObjPtr); - result = Jim_GetString(Jim_GetResult(interp), &reslen); - if (retcode == JIM_ERR) { - Jim_PrintErrorMessage(interp); - } - else if (retcode == JIM_EXIT) { + if (retcode == JIM_EXIT) { Jim_Free(buf); exit(Jim_GetExitCode(interp)); } - else { - if (reslen) { - printf("%s\n", result); - } + if (retcode == JIM_ERR) { + Jim_MakeErrorMessage(interp); + } + result = Jim_GetString(Jim_GetResult(interp), &reslen); + if (reslen) { + printf("%s\n", result); } } out: @@ -13437,38 +13437,14 @@ void Jim_RegisterCoreCommands(Jim_Interp *interp) /* ----------------------------------------------------------------------------- * Interactive prompt * ---------------------------------------------------------------------------*/ -void Jim_PrintErrorMessage(Jim_Interp *interp) +void Jim_MakeErrorMessage(Jim_Interp *interp) { - int len, i; + Jim_Obj *argv[2]; - if (*interp->errorFileName) { - fprintf(stderr, "%s:%d: Runtime Error: ", interp->errorFileName, interp->errorLine); - } - fprintf(stderr, "%s" JIM_NL, Jim_GetString(interp->result, NULL)); - len = Jim_ListLength(interp, interp->stackTrace); - for (i = len - 3; i >= 0; i -= 3) { - Jim_Obj *objPtr = 0; - const char *proc, *file, *line; + argv[0] = Jim_NewStringObj(interp, "errorInfo", -1); + argv[1] = interp->result; - Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE); - proc = Jim_GetString(objPtr, NULL); - Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr, JIM_NONE); - file = Jim_GetString(objPtr, NULL); - Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr, JIM_NONE); - line = Jim_GetString(objPtr, NULL); - if (*proc) { - fprintf(stderr, "in procedure '%s' ", proc); - if (*file) { - fprintf(stderr, "called "); - } - } - if (*file) { - fprintf(stderr, "at file \"%s\", line %s", file, line); - } - if (*file || *proc) { - fprintf(stderr, JIM_NL); - } - } + Jim_EvalObjVector(interp, 2, argv); } static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype, @@ -863,7 +863,7 @@ JIM_EXPORT int Jim_PackageRequire (Jim_Interp *interp, const char *name, int flags); /* error messages */ -JIM_EXPORT void Jim_PrintErrorMessage (Jim_Interp *interp); +JIM_EXPORT void Jim_MakeErrorMessage (Jim_Interp *interp); /* interactive mode */ JIM_EXPORT int Jim_InteractivePrompt (Jim_Interp *interp); @@ -112,7 +112,8 @@ static int JimLoadJimRc(Jim_Interp *interp) fclose(fp); retcode = Jim_EvalFile(interp, buf); if (retcode == JIM_ERR) { - Jim_PrintErrorMessage(interp); + Jim_MakeErrorMessage(interp); + fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL)); } return retcode; } @@ -147,7 +148,8 @@ int main(int argc, char *const argv[]) /* Register static extensions */ if (Jim_InitStaticExtensions(interp) != JIM_OK) { - Jim_PrintErrorMessage(interp); + Jim_MakeErrorMessage(interp); + fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL)); } /* Append the path where the executed Jim binary is contained @@ -180,7 +182,8 @@ int main(int argc, char *const argv[]) retcode = Jim_EvalFile(interp, argv[1]); } if (retcode == JIM_ERR) { - Jim_PrintErrorMessage(interp); + Jim_MakeErrorMessage(interp); + fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL)); } } if (retcode == JIM_OK) { @@ -38,6 +38,14 @@ proc function {value} { return $value } +# Tcl 8.5 lassign +proc lassign {list args} { + # in case the list is empty... + lappend list {} + uplevel 1 [list foreach $args $list break] + lrange $list [llength $args] end-1 +} + # Returns a list of proc filename line ... # with 3 entries for each stack frame (proc), # (deepest level first) @@ -71,3 +79,20 @@ proc stackdump {stacktrace} { } return $result } + +# Sort of replacement for $::errorInfo +# Usage: errorInfo error ?stacktrace? +proc errorInfo {msg {stacktrace ""}} { + if {$stacktrace eq ""} { + set stacktrace [info stacktrace] + } + lassign $stacktrace p f l + if {$f ne ""} { + set result "$f:$l " + } + append result "Runtime Error: $msg\n" + append result [stackdump $stacktrace] + + # Remove the trailing newline + string trim $result +} diff --git a/tclcompat.tcl b/tclcompat.tcl index c632103..398a916 100644 --- a/tclcompat.tcl +++ b/tclcompat.tcl @@ -36,14 +36,6 @@ proc read {{-nonewline {}} chan} { } -# Tcl 8.5 lassign -proc lassign {list args} { - # in case the list is empty... - lappend list {} - uplevel 1 [list foreach $args $list break] - lrange $list [llength $args] end-1 -} - # case var ?in? pattern action ?pattern action ...? proc case {var args} { # Skip dummy parameter @@ -109,20 +101,6 @@ proc parray {arrayname {pattern *} {puts puts}} { } } -# Sort of replacement for $::errorInfo -# Usage: errorInfo error ?stacktrace? -proc errorInfo {error {stacktrace ""}} { - if {$stacktrace eq ""} { - set stacktrace [info stacktrace] - } - lassign $stacktrace p f l - if {$f ne ""} { - set result "$f:$l " - } - append result "Runtime Error: $error\n" - append result [stackdump $stacktrace] -} - proc {info nameofexecutable} {} { if {[info exists ::jim_argv0]} { if {[string first "/" $::jim_argv0] >= 0} { |