Add test constaints "debug", "purify", and "debugpurify"

2 files changed, 84 insertions, 0 deletions

diff --git a/generic/tclTest.c b/generic/tclTest.c
index 39bd392..99fe92f 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -227,6 +227,7 @@ static Tcl_CmdProc	TestcreatecommandCmd;
 static Tcl_CmdProc	TestdcallCmd;
 static Tcl_CmdProc	TestdelCmd;
 static Tcl_CmdProc	TestdelassocdataCmd;
+static Tcl_ObjCmdProc	TestdebugObjCmd;
 static Tcl_ObjCmdProc	TestdoubledigitsObjCmd;
 static Tcl_CmdProc	TestdstringCmd;
 static Tcl_ObjCmdProc	TestencodingObjCmd;
@@ -265,6 +266,7 @@ static Tcl_ObjCmdProc	TestparsevarObjCmd;
 static Tcl_ObjCmdProc	TestparsevarnameObjCmd;
 static Tcl_ObjCmdProc	TestpreferstableObjCmd;
 static Tcl_ObjCmdProc	TestprintObjCmd;
+static Tcl_ObjCmdProc	TestpurifyObjCmd;
 static Tcl_ObjCmdProc	TestregexpObjCmd;
 static Tcl_ObjCmdProc	TestreturnObjCmd;
 static void		TestregexpXflags(const char *string,
@@ -504,6 +506,8 @@ Tcltest_Init(
     Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testdebug", TestdebugObjCmd,
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
     Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
 	    NULL, NULL);
@@ -568,6 +572,8 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
 	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testpurify", TestpurifyObjCmd,
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
@@ -3364,6 +3370,40 @@ TestlocaleCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestdebugObjCmd --
+ *
+ *	Implements the "testdebug" command, to detect whether Tcl was built with
+ *	--enabble-symbols.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestdebugObjCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,		/* Current interpreter. */
+    TCL_UNUSED(int) /*objc*/,
+    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
+{
+
+#if defined(NDEBUG) && NDEBUG == 1
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+#else
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+#endif
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * CleanupTestSetassocdataTests --
  *
  *	This function is called when an interpreter is deleted to clean
@@ -3765,6 +3805,40 @@ TestprintObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestpurifyObjCmd --
+ *
+ *	Implements the "testpurify" command, to detect whether Tcl was built with
+ *	-DPURIFY.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestpurifyObjCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,		/* Current interpreter. */
+    TCL_UNUSED(int) /*objc*/,
+    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
+{
+
+#ifdef PURIFY
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+#else
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+#endif
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestregexpObjCmd --
  *
  *	This procedure implements the "testregexp" command. It is used to give
diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl
index 193ba0a..09c8b28 100644
--- a/tests/tcltests.tcl
+++ b/tests/tcltests.tcl
@@ -3,6 +3,16 @@
 package require tcltest 2.5
 namespace import ::tcltest::*
 testConstraint exec          [llength [info commands exec]]
+testConstraint debug         [testdebug]
+testConstraint purify        [testpurify]
+testConstraint debugpurify   [
+    expr {
+	![stestConstraint memory]
+	&&
+	[testConstraint debug]
+	&&
+	[testConstraint purify]
+}]
 testConstraint fcopy         [llength [info commands fcopy]]
 testConstraint fileevent     [llength [info commands fileevent]]
 testConstraint thread        [