summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tkTest.c58
-rw-r--r--tests/tk.test6
2 files changed, 64 insertions, 0 deletions
diff --git a/generic/tkTest.c b/generic/tkTest.c
index 1f801be..61153e5 100644
--- a/generic/tkTest.c
+++ b/generic/tkTest.c
@@ -192,6 +192,9 @@ static void CustomOptionFree(ClientData clientData,
static int TestpropObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj * const objv[]);
+static int TestprintfObjCmd(ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * const objv[]);
#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
static int TestwrapperObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
@@ -263,6 +266,7 @@ Tktest_Init(
(ClientData) Tk_MainWindow(interp), NULL);
Tcl_CreateObjCommand(interp, "testprop", TestpropObjCmd,
(ClientData) Tk_MainWindow(interp), NULL);
+ Tcl_CreateObjCommand(interp, "testprintf", TestprintfObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd,
(ClientData) Tk_MainWindow(interp), NULL);
@@ -1896,6 +1900,60 @@ TestpropObjCmd(
return TCL_OK;
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestpropObjCmd --
+ *
+ * This function implements the "testprop" command. It fetches and prints
+ * the value of a property on a window.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestprintfObjCmd(
+ ClientData clientData, /* Not used */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument strings. */
+{
+ char buffer[256];
+ Tcl_WideInt wideInt;
+#ifdef _WIN32
+ __int64 longLongInt;
+#else
+ long long longLongInt;
+#endif
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "wideint");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &wideInt) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ longLongInt = wideInt;
+
+ /* Just add a lot of arguments to sprintf. Reason: on AMD64, the first
+ * 4 or 6 arguments (we assume 8, just in case) might be put in registers,
+ * which still woudn't tell if the assumed size is correct: We want this
+ * test-case to fail if the 64-bit value is printed as truncated to 32-bit.
+ */
+ sprintf(buffer, "%s%s%s%s%s%s%s%s%" TCL_LL_MODIFIER "d %"
+ TCL_LL_MODIFIER "u", "", "", "", "", "", "", "", "",
+ (Tcl_WideInt)longLongInt, (Tcl_WideUInt)longLongInt);
+ Tcl_AppendResult(interp, buffer, NULL);
+ return TCL_OK;
+}
+
#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
/*
*----------------------------------------------------------------------
diff --git a/tests/tk.test b/tests/tk.test
index 748a6cf..c5c475e 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -10,6 +10,8 @@ eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test
+testConstraint testprintf [llength [info command testprintf]]
+
test tk-1.1 {tk command: general} -body {
tk
} -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"}
@@ -177,6 +179,10 @@ test tk-7.2 {tk inactive reset in a safe interpreter} -body {
::safe::interpDelete foo
} -returnCodes 1 -result {resetting the user inactivity timer is not allowed in a safe interpreter}
+test tk-8.1 {Test for ticket [1cc44617e2], see if TCL_LL_MODIFIER works as expected on all platforms} -constraints testprintf -body {
+ testprintf -21474836480
+} -result {-21474836480 18446744052234715136}
+
# tests of [tk busy] in busy.test
# cleanup