diff options
| -rw-r--r-- | generic/tkTest.c | 58 | ||||
| -rw-r--r-- | tests/tk.test | 6 |
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 |