tests: debug.test

Also requires fixing 'debug' command so that the interpreter &
tcltest.tcl can tell it is not supported.

And the result of 'debug show' is now returned as the interpreter result
rather than being printed.

2 files changed, 128 insertions, 12 deletions

diff --git a/jim.c b/jim.c
index e109812..7989352 100644
--- a/jim.c
+++ b/jim.c
@@ -12653,9 +12653,9 @@ static Jim_Obj *JimGetExprAsList(Jim_Interp *interp, struct JimExprNode *node)
 #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
 
 /* [debug] */
+#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
 static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
-#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
     static const char * const options[] = {
         "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
         "exprbc", "show",
@@ -12711,6 +12711,11 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar
     else if (option == OPT_OBJECTS) {
         Jim_Obj *objPtr, *listObjPtr, *subListObjPtr;
 
+        if (argc != 2) {
+            Jim_WrongNumArgs(interp, 2, argv, "");
+            return JIM_ERR;
+        }
+
         /* Count the number of live objects. */
         objPtr = interp->liveList;
         listObjPtr = Jim_NewListObj(interp, NULL, 0);
@@ -12757,13 +12762,17 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar
 #else
         charlen = len;
 #endif
-        printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
-        printf("chars (%d): <<%s>>\n", charlen, s);
-        printf("bytes (%d):", len);
+        char buf[256];
+        snprintf(buf, sizeof(buf), "refcount: %d, type: %s\n"
+            "chars (%d):",
+            argv[2]->refCount, JimObjTypeName(argv[2]), charlen);
+        Jim_SetResultFormatted(interp, "%s <<%s>>\n", buf, s);
+        snprintf(buf, sizeof(buf), "bytes (%d):", len);
+        Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
         while (len--) {
-            printf(" %02x", (unsigned char)*s++);
+            snprintf(buf, sizeof(buf), " %02x", (unsigned char)*s++);
+            Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
         }
-        printf("\n");
         return JIM_OK;
     }
     else if (option == OPT_SCRIPTLEN) {
@@ -12811,12 +12820,8 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar
         return JIM_ERR;
     }
     /* unreached */
-#endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
-#if !defined(JIM_DEBUG_COMMAND)
-    Jim_SetResultString(interp, "unsupported", -1);
-    return JIM_ERR;
-#endif
 }
+#endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
 
 /* [eval] */
 static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
@@ -15240,7 +15245,9 @@ static const struct {
     {"lreplace", Jim_LreplaceCoreCommand},
     {"lsort", Jim_LsortCoreCommand},
     {"append", Jim_AppendCoreCommand},
-    {"debug", Jim_DebugCoreCommand},
+#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
+	{"debug", Jim_DebugCoreCommand},
+#endif
     {"eval", Jim_EvalCoreCommand},
     {"uplevel", Jim_UplevelCoreCommand},
     {"expr", Jim_ExprCoreCommand},
diff --git a/tests/debug.test b/tests/debug.test
new file mode 100644
index 0000000..edfead8
--- /dev/null
+++ b/tests/debug.test
@@ -0,0 +1,109 @@
+source [file dirname [info script]]/testing.tcl
+needs cmd debug
+
+set x 0
+
+test debug-0.1 {debug too few args} -body {
+    debug
+} -returnCodes error -result {wrong # args: should be "debug subcommand ?...?"}
+
+test debug-0.2 {debug bad option} -body {
+    debug badoption
+} -returnCodes error -result {bad subcommand "badoption": must be exprbc, exprlen, invstr, objcount, objects, refcount, scriptlen, or show}
+
+test debug-1.1 {debug refcount too few args} -body {
+    debug refcount
+} -returnCodes error -result {wrong # args: should be "debug refcount object"}
+
+test debug-1.2 {debug refcount test} -body {
+    debug refcount x
+}  -result {2}
+
+test debug-1.3 {debug refcount too many args} -body {
+    debug refcount a b c
+} -returnCodes error -result {wrong # args: should be "debug refcount object"}
+
+test debug-2.1 {debug objcount} -body {
+    regexp {free \d+ used \d+} [debug objcount]
+} -result {1}
+
+test debug-2.2 {debug objcount too many args} -body {
+    debug objcount a b c
+} -returnCodes error -result {wrong # args: should be "debug objcount"}
+
+test debug-3.1 {debug objects} -body {
+    expr [llength [debug objects]] > 1000
+} -result {1}
+
+# does not currently check for too many args
+test debug-3.2 {debug objects too many args} -body {
+    debug objects a b c
+} -returnCodes error -result {wrong # args: should be "debug objects"}
+
+test debug-4.1 {debug invstr too few args} -body {
+    debug invstr
+} -returnCodes error -result {wrong # args: should be "debug invstr object"}
+
+test debug-4.2 {debug invstr} -body {
+    debug invstr x
+} -result {}
+
+test debug-4.3 {debug invstr too many args} -body {
+    debug invstr a b c
+} -returnCodes error -result {wrong # args: should be "debug invstr object"}
+
+test debug-5.1 {debug scriptlen too few args} -body {
+    debug scriptlen
+} -returnCodes error -result {wrong # args: should be "debug scriptlen script"}
+
+test debug-5.2 {debug scriptlen} -body {
+    debug scriptlen {puts "hello world"}
+} -result {3}
+
+test debug-5.3 {debug scriptlen too many args} -body {
+    debug scriptlen a b c
+} -returnCodes error -result {wrong # args: should be "debug scriptlen script"}
+
+test debug-6.1 {debug exprlen too few args} -body {
+    debug exprlen
+} -returnCodes error -result {wrong # args: should be "debug exprlen expression"}
+
+test debug-6.2 {debug exprlen} -body {
+    debug exprlen { $x + 10 }
+} -result {3}
+
+test debug-6.3 {debug exprlen too many args} -body {
+    debug exprlen a b c
+} -returnCodes error -result {wrong # args: should be "debug exprlen expression"}
+
+test debug-7.1 {debug exprbc too few args} -body {
+    debug exprbc
+} -returnCodes error -result {wrong # args: should be "debug exprbc expression"}
+
+test debug-7.2 {debug exprbc} -body {
+	set y [dict create]
+	dict set y z 1
+    debug exprbc { $x + 10 + 1.5 + true + [llength {{1} {2}}] + "5" + $y(z) + "\x33"}
+} -result {+ {+ {+ {+ {+ {+ {+ {VAR x} {INT 10}} {DBL 1.5}} {BOO true}} {CMD {llength {{1} {2}}}}} {STR 5}} {ARY y(z)}} {ESC {\x33}}}
+
+test debug-7.4 {debug exprbc too many args} -body {
+    debug exprbc a b c
+} -returnCodes error -result {wrong # args: should be "debug exprbc expression"}
+
+test debug-8.1 {debug show too few args} -body {
+    debug show
+} -returnCodes error -result {wrong # args: should be "debug show object"}
+
+test debug-8.1 {debug show} -body {
+	set x hello
+	lappend x there
+    debug show $x
+} -result {refcount: 2, type: list
+chars (11): <<hello there>>
+bytes (11): 68 65 6c 6c 6f 20 74 68 65 72 65}
+
+test debug-8.3 {debug show too many args} -body {
+    debug show a b c
+} -returnCodes error -result {wrong # args: should be "debug show object"}
+
+testreport