Tk Source Code

Check-in [dd4d4f82]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add test-case for 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.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: dd4d4f822dd767de4aa7a85bdcd45d0ed594c409
User & Date: jan.nijtmans 2017-03-24 13:26:52
Context
2017-03-26
15:22
Merged tip-464 following positive vote by the TCT. check-in: 0a78ed7d user: fvogel tags: trunk
12:37
merge trunk Leaf check-in: 23723457 user: fvogel tags: bug-434d294df
12:21
merge trunk check-in: c44d9b24 user: fvogel tags: tip-166
2017-03-24
13:26
Add test-case for 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. check-in: dd4d4f82 user: jan.nijtmans tags: trunk
2017-03-22
10:56
Fix test-case safe-1.2. Failure introduced by commit b13eeffcd1 in Tcl check-in: 9720ad3f user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkTest.c.

187
188
189
190
191
192
193



194
195
196
197
198
199
200
static void		CustomOptionRestore(ClientData clientData,
			    Tk_Window tkwin, char *internalPtr,
			    char *saveInternalPtr);
static void		CustomOptionFree(ClientData clientData,
			    Tk_Window tkwin, char *internalPtr);
static int		TestpropObjCmd(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,
			    Tcl_Obj * const objv[]);
#endif
static void		TrivialCmdDeletedProc(ClientData clientData);







>
>
>







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
static void		CustomOptionRestore(ClientData clientData,
			    Tk_Window tkwin, char *internalPtr,
			    char *saveInternalPtr);
static void		CustomOptionFree(ClientData clientData,
			    Tk_Window tkwin, char *internalPtr);
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,
			    Tcl_Obj * const objv[]);
#endif
static void		TrivialCmdDeletedProc(ClientData clientData);
259
260
261
262
263
264
265

266
267
268
269
270
271
272
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testmakeexist", TestmakeexistObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testprop", TestpropObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);

    Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);

#if defined(_WIN32) || defined(MAC_OSX_TK)
    Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
#elif !defined(__CYGWIN__)







>







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testmakeexist", TestmakeexistObjCmd,
	    (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);

#if defined(_WIN32) || defined(MAC_OSX_TK)
    Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
#elif !defined(__CYGWIN__)
1891
1892
1893
1894
1895
1896
1897






















































1898
1899
1900
1901
1902
1903
1904
	}
    }
    if (property != NULL) {
	XFree(property);
    }
    return TCL_OK;
}























































#if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__))
/*
 *----------------------------------------------------------------------
 *
 * TestwrapperObjCmd --
 *







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
	}
    }
    if (property != NULL) {
	XFree(property);
    }
    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__))
/*
 *----------------------------------------------------------------------
 *
 * TestwrapperObjCmd --
 *

Changes to tests/tk.test.

1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17
18
19
# This file is a Tcl script to test the tk command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2002 ActiveState Corporation.

package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test



test tk-1.1 {tk command: general} -body {
    tk
} -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"}
test tk-1.2 {tk command: general} -body {
    tk xyz
} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, useinputmethods, or windowingsystem}













>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# This file is a Tcl script to test the tk command.
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2002 ActiveState Corporation.

package require tcltest 2.2
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 ...?"}
test tk-1.2 {tk command: general} -body {
    tk xyz
} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, useinputmethods, or windowingsystem}

172
173
174
175
176
177
178




179
180
181
182
183
184
# tk inactive in safe interpreters
    safe::interpCreate foo
    safe::loadTk foo
    foo eval {tk inactive reset}
} -cleanup {
    ::safe::interpDelete foo
} -returnCodes 1 -result {resetting the user inactivity timer is not allowed in a safe interpreter}





# tests of [tk busy] in busy.test

# cleanup
cleanupTests
return







>
>
>
>






174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
# tk inactive in safe interpreters
    safe::interpCreate foo
    safe::loadTk foo
    foo eval {tk inactive reset}
} -cleanup {
    ::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
cleanupTests
return