aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--jim-eventloop.c6
-rw-r--r--jim-interactive.c16
-rw-r--r--jim.c34
-rw-r--r--jim.h2
-rw-r--r--jimsh.c9
-rw-r--r--stdlib.tcl25
-rw-r--r--tclcompat.tcl22
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:
diff --git a/jim.c b/jim.c
index 2a058d6..d0dc110 100644
--- a/jim.c
+++ b/jim.c
@@ -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,
diff --git a/jim.h b/jim.h
index 6c7a8e8..7325eb2 100644
--- a/jim.h
+++ b/jim.h
@@ -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);
diff --git a/jimsh.c b/jimsh.c
index 32f16b7..d5ad678 100644
--- a/jimsh.c
+++ b/jimsh.c
@@ -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) {
diff --git a/stdlib.tcl b/stdlib.tcl
index b4a9a69..3f3a6e5 100644
--- a/stdlib.tcl
+++ b/stdlib.tcl
@@ -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} {