From d7c85201a2c700cb43554d1e6871a09e98d01dd2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 20 Jan 2017 14:37:27 +0000 Subject: Smarter initialization of doubleTypePtr/intTypePtr without hash-table lookup or creating complete Tcl_Obj's. In Windows tests, allow up to 64 bits for HWND. Check stubs for "8.6-" in stead of "8.6", for better interoperability with "novem". --- generic/tkConsole.c | 2 +- generic/tkIntXlibDecls.h | 4 ++++ generic/tkMain.c | 2 +- generic/tkObj.c | 15 +++++++++++++-- generic/tkTest.c | 2 +- generic/tkWindow.c | 2 +- win/tkWinTest.c | 18 +++++++++--------- 7 files changed, 30 insertions(+), 15 deletions(-) diff --git a/generic/tkConsole.c b/generic/tkConsole.c index fc60d5f..57e8364 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -223,7 +223,7 @@ Tk_InitConsoleChannels( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return; } diff --git a/generic/tkIntXlibDecls.h b/generic/tkIntXlibDecls.h index de44068..ce9752f 100644 --- a/generic/tkIntXlibDecls.h +++ b/generic/tkIntXlibDecls.h @@ -23,6 +23,10 @@ # include #endif +#ifndef EXTERN +# define EXTERN extern TCL_STORAGE_CLASS +#endif + /* Some (older) versions of X11/Xutil.h have a wrong signature of those two functions, so move them out of the way temporarly. */ #define XOffsetRegion _XOffsetRegion diff --git a/generic/tkMain.c b/generic/tkMain.c index 1b21223..87a3cf7 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -196,7 +196,7 @@ Tk_MainEx( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { abort(); } else { diff --git a/generic/tkObj.c b/generic/tkObj.c index 7c09656..90fedbc 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -153,8 +153,19 @@ GetTypeCache(void) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->doubleTypePtr == NULL) { - tsdPtr->doubleTypePtr = Tcl_GetObjType("double"); - tsdPtr->intTypePtr = Tcl_GetObjType("int"); + /* Smart initialization of doubleTypePtr/intTypePtr without + * hash-table lookup or creating complete Tcl_Obj's */ + Tcl_Obj obj; + obj.length = 3; + obj.bytes = (char *)"0.0"; + obj.typePtr = NULL; + Tcl_GetDoubleFromObj(NULL, &obj, &obj.internalRep.doubleValue); + tsdPtr->doubleTypePtr = obj.typePtr; + obj.bytes += 2; + obj.length = 1; + obj.typePtr = NULL; + Tcl_GetLongFromObj(NULL, &obj, &obj.internalRep.longValue); + tsdPtr->intTypePtr = obj.typePtr; } return tsdPtr; } diff --git a/generic/tkTest.c b/generic/tkTest.c index faba89d..e23be36 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -227,7 +227,7 @@ Tktest_Init( { static int initialized = 0; - if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) { diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 20b4f20..f02db35 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -3040,7 +3040,7 @@ Initialize( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } diff --git a/win/tkWinTest.c b/win/tkWinTest.c index d824ee4..095358d 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -483,7 +483,7 @@ TestfindwindowObjCmd( AppendSystemError(interp, GetLastError()); r = TCL_ERROR; } else { - Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd))); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((size_t)hwnd)); } Tcl_DStringFree(&titleString); @@ -499,7 +499,7 @@ EnumChildrenProc( { Tcl_Obj *listObj = (Tcl_Obj *) lParam; - Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj(PTR2INT(hwnd))); + Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewWideIntObj((size_t)hwnd)); return TRUE; } @@ -510,7 +510,7 @@ TestgetwindowinfoObjCmd( int objc, Tcl_Obj *const objv[]) { - long hwnd; + Tcl_WideInt hwnd; Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL; Tcl_Obj *childrenObj = NULL; TCHAR buf[512]; @@ -521,10 +521,10 @@ TestgetwindowinfoObjCmd( return TCL_ERROR; } - if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK) + if (Tcl_GetWideIntFromObj(interp, objv[1], &hwnd) != TCL_OK) return TCL_ERROR; - cch = GetClassName(INT2PTR(hwnd), buf, cchBuf); + cch = GetClassName((HWND)(size_t)hwnd, buf, cchBuf); if (cch == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to get class name: ", -1)); AppendSystemError(interp, GetLastError()); @@ -539,17 +539,17 @@ TestgetwindowinfoObjCmd( dictObj = Tcl_NewDictObj(); Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj); Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2), - Tcl_NewLongObj(GetWindowLongA(INT2PTR(hwnd), GWL_ID))); + Tcl_NewWideIntObj(GetWindowLongPtr((HWND)(size_t)hwnd, GWL_ID))); - cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf); + cch = GetWindowText((HWND)(size_t)hwnd, (LPTSTR)buf, cchBuf); textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch); Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj); Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6), - Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd)))))); + Tcl_NewWideIntObj((size_t)(GetParent((HWND)(size_t)hwnd)))); childrenObj = Tcl_NewListObj(0, NULL); - EnumChildWindows(INT2PTR(hwnd), EnumChildrenProc, (LPARAM)childrenObj); + EnumChildWindows((HWND)(size_t)hwnd, EnumChildrenProc, (LPARAM)childrenObj); Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj); Tcl_SetObjResult(interp, dictObj); -- cgit v0.12