Add test-case for [http://core.tcl.tk/tcl/tktview/1cc44617e2b4ed0a29f75762d45fe46388260f74|1cc44617e2]: Mechanism with 64 bit support in tcl.h does not work outside of core

This test-case passes on all platforms I know of.

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