From ede64cf46755c12f156fa876124e4fc3269f99ab Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Mar 2021 10:39:32 +0000 Subject: One more failsOnQuarz mark. Extend ignore-glob --- .fossil-settings/ignore-glob | 3 +++ tests/tk.test | 4 +++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob index c62c87c..8100756 100644 --- a/.fossil-settings/ignore-glob +++ b/.fossil-settings/ignore-glob @@ -22,6 +22,9 @@ */wish* */tktest* */versions.vc +*/version.vc +*/libtk.vfs +*/libtk*.zip doc/man.macros html macosx/configure diff --git a/tests/tk.test b/tests/tk.test index 48f3d46..8f34f06 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 failsOnQuarz [expr {![info exists ::env(MAC_CI)]}] + test tk-1.1 {tk command: general} -body { tk } -returnCodes error -result {wrong # args: should be "tk option ?arg?"} @@ -152,7 +154,7 @@ test tk-6.3 {tk inactive wrong argument} -body { test tk-6.4 {tk inactive too many arguments} -body { tk inactive reset foo } -returnCodes error -result {wrong # args: should be "tk inactive ?-displayof window? ?reset?"} -test tk-6.5 {tk inactive} -body { +test tk-6.5 {tk inactive} -constraints failsOnQuarz -body { tk inactive reset update after 100 -- cgit v0.12 From f6708dbca5db2d4fd3514b156f8fd2ee059e6cb2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Mar 2021 11:03:19 +0000 Subject: Two more failsOnXQuarz marks. Fix possible compiler warning when HAVE_XKBKEYCODETOKEYSYM is not defined --- tests/send.test | 3 ++- tests/ttk/entry.test | 3 ++- unix/tkUnixEvent.c | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/tests/send.test b/tests/send.test index c75f428..ccf3eab 100644 --- a/tests/send.test +++ b/tests/send.test @@ -16,6 +16,7 @@ tcltest::loadTestedCommands testConstraint xhost [llength [auto_execok xhost]] testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] +testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] # Compute a script that will load Tk into a child interpreter. @@ -297,7 +298,7 @@ test send-8.15 {Tk_SendCmd procedure, local interp, error info} {secureserver te "if 1 {open bogus_file_name}" invoked from within "send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}} -test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend failsOnUbuntu} { +test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend failsOnUbuntu failsOnXQuarz} { testsend prop root InterpRegistry "10234 bogus\n" set result [list [catch {send bogus bogus command} msg] $msg] winfo interps diff --git a/tests/ttk/entry.test b/tests/ttk/entry.test index 293bfe1..384f297 100644 --- a/tests/ttk/entry.test +++ b/tests/ttk/entry.test @@ -8,6 +8,7 @@ namespace import -force tcltest::* loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] +testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] variable scrollInfo proc scroll args { @@ -77,7 +78,7 @@ test entry-2.1 "Create entry before scrollbar" -body { -expand false -fill x } -cleanup {destroy .te .tsb} -test entry-2.1.1 "Create entry before scrollbar - scrollbar catches up" -constraints failsOnUbuntu -body { +test entry-2.1.1 "Create entry before scrollbar - scrollbar catches up" -constraints {failsOnUbuntu failsOnXQuarz} -body { pack [ttk::entry .te -xscrollcommand [list .tsb set]] \ -expand true -fill both .te insert end [string repeat "abc" 50] diff --git a/unix/tkUnixEvent.c b/unix/tkUnixEvent.c index 4d0b9be..e424bb7 100644 --- a/unix/tkUnixEvent.c +++ b/unix/tkUnixEvent.c @@ -15,7 +15,7 @@ #ifdef HAVE_XKBKEYCODETOKEYSYM # include #else -# define XkbOpenDisplay(D,V,E,M,m,R) ((V),(E),(M),(m),(R),(NULL)) +# define XkbOpenDisplay(D,V,E,M,m,R) (((void)D),((void)V),((void)E),((void)M),((void)m),((void)R),(NULL)) #endif /* -- cgit v0.12 From 653ea2dfcac7073199950085df5f242e89ed48d5 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Mar 2021 20:32:48 +0000 Subject: Fix [d50f63a0e1]: menu-38.1 hangs when unconstrained. --- tests/menu.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/menu.test b/tests/menu.test index 7589aea..ec43ad3 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -3931,7 +3931,7 @@ test menu-37.1 {menubar menues cannot be posted - bug 2160206} -setup { } -result {1 {a menubar menu cannot be posted}} test menu-38.1 {Can't dismiss ttk::menubutton menu until mouse has hovered over it - bug fa32290898} -setup { -} -constraints {userInteraction} -body { +} -constraints {x11} -body { toplevel .top ttk::menubutton .top.mb -text "Some menu"; menu .top.mb.m; -- cgit v0.12 From 755b1f2f743f936a622485e9fa8a539d80641b78 Mon Sep 17 00:00:00 2001 From: fvogel Date: Tue, 9 Mar 2021 22:01:08 +0000 Subject: Fix [2374c602bf]: bind-34.1 sometimes fails on Linux. This is a race condition. 'wm geometry' runs UpdateGeometryInfo() as an idle callback, on all platforms. Give a few ms to the OS to get that callback in the event loop before running the following 'update' that services it. Therefore, bind-34.1 should now always pass. --- tests/bind.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/bind.test b/tests/bind.test index 6868eba..47b80ed 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -6736,20 +6736,20 @@ test bind-33.21 {simulate use of the keyboard to trigger a pattern sequence with test bind-34.1 {-warp works relatively to a window} -setup { toplevel .top wm geometry .top +100+100 - update + after 10 ; update } -body { # In order to avoid platform-dependent coordinate results due to # decorations and borders, this test warps the pointer twice # relatively to a window that moved in the meantime, and checks # how much the pointer moved wm geometry .top +200+200 - update + after 10 ; update event generate .top -x 20 -y 20 -warp 1 update idletasks ; # DoWarp is an idle callback after 50 ; # Win specific - wait for SendInput to be executed set pointerPos1 [winfo pointerxy .top] wm geometry .top +600+600 - update + after 10 ; update event generate .top -x 20 -y 20 -warp 1 update idletasks ; # DoWarp is an idle callback after 50 ; # Win specific - wait for SendInput to be executed -- cgit v0.12 From d5a1cc52cf08703de2efb17dbc8eb5cc48a94a9f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 13 Mar 2021 16:15:35 +0000 Subject: One more failsOnQuarz mark --- tests/send.test | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/send.test b/tests/send.test index fbf1555..7149c6e 100644 --- a/tests/send.test +++ b/tests/send.test @@ -16,6 +16,7 @@ tcltest::loadTestedCommands testConstraint xhost [llength [auto_execok xhost]] testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] +testConstraint failsOnQuarz [expr {![info exists ::env(MAC_CI)]}] # Compute a script that will load Tk into a child interpreter. @@ -295,7 +296,7 @@ test send-8.15 {Tk_SendCmd procedure, local interp, error info} {secureserver te "if 1 {open bogus_file_name}" invoked from within "send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}} -test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend failsOnUbuntu} { +test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend failsOnUbuntu failsOnQuarz} { testsend prop root InterpRegistry "10234 bogus\n" set result [list [catch {send bogus bogus command} msg] $msg] winfo interps -- cgit v0.12 From 4d40a829a939527fa2bcdb95edcc339d6419ff44 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 15 Mar 2021 09:21:10 +0000 Subject: Get rid of hackery function TkUtfPrev(): No longer necessary due to TIP #575 --- generic/tkInt.h | 5 ++--- generic/tkTextIndex.c | 6 +++--- generic/tkUtil.c | 54 ++++++--------------------------------------------- 3 files changed, 11 insertions(+), 54 deletions(-) diff --git a/generic/tkInt.h b/generic/tkInt.h index ee453ea..5ef38ab 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1417,14 +1417,13 @@ MODULE_SCOPE void TkUnixSetXftClipRegion(Region clipRegion); # define c_class class #endif -#if TCL_UTF_MAX > 4 +/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */ +#if TCL_UTF_MAX > (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6)) # define TkUtfToUniChar(src, ch) (size_t)(((int (*)(const char *, int *))Tcl_UtfToUniChar)(src, ch)) # define TkUniCharToUtf(ch, src) (size_t)(((int (*)(int, char *))Tcl_UniCharToUtf)(ch, src)) -# define TkUtfPrev Tcl_UtfPrev #else MODULE_SCOPE size_t TkUtfToUniChar(const char *, int *); MODULE_SCOPE size_t TkUniCharToUtf(int, char *); - MODULE_SCOPE const char *TkUtfPrev(const char *, const char *); #endif #if defined(_WIN32) && !defined(STATIC_BUILD) && TCL_MAJOR_VERSION < 9 diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index eea8f50..7d55331 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -436,7 +436,7 @@ TkTextMakeByteIndex( */ start = segPtr->body.chars + (byteIndex - index); - p = TkUtfPrev(start, segPtr->body.chars); + p = Tcl_UtfPrev(start, segPtr->body.chars); p += TkUtfToUniChar(p, &ch); indexPtr->byteIndex += p - start; } @@ -2126,7 +2126,7 @@ TkTextIndexBackChars( if (segPtr->typePtr == &tkTextCharType) { start = segPtr->body.chars; end = segPtr->body.chars + segSize; - for (p = end; ; p = TkUtfPrev(p, start)) { + for (p = end; ; p = Tcl_UtfPrev(p, start)) { if (charCount == 0) { dstPtr->byteIndex -= (end - p); goto backwardCharDone; @@ -2367,7 +2367,7 @@ StartEnd( } if (offset + 1 > 1) { chSize = (segPtr->body.chars + offset - - TkUtfPrev(segPtr->body.chars + offset, + - Tcl_UtfPrev(segPtr->body.chars + offset, segPtr->body.chars)); } firstChar = 0; diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 1e9c334..da2ce95 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -1196,7 +1196,8 @@ Tk_SendVirtualEvent( Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL); } -#if TCL_UTF_MAX <= 4 +/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */ +#if TCL_UTF_MAX <= (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6)) /* *--------------------------------------------------------------------------- * @@ -1225,15 +1226,10 @@ TkUtfToUniChar( Tcl_UniChar uniChar = 0; size_t len = Tcl_UtfToUniChar(src, &uniChar); - if ((sizeof(Tcl_UniChar) == 2) - && ((uniChar & 0xFC00) == 0xD800) -#if TCL_MAJOR_VERSION > 8 - && (len == 1) -#endif - ) { + if ((uniChar & 0xFC00) == 0xD800) { Tcl_UniChar low = uniChar; - /* This can only happen if Tcl is compiled with TCL_UTF_MAX=4, - * or when a high surrogate character is detected in UTF-8 form */ + /* This can only happen if sizeof(Tcl_UniChar)== 2 and src points + * to a character > U+FFFF */ size_t len2 = Tcl_UtfToUniChar(src+len, &low); if ((low & 0xFC00) == 0xDC00) { *chPtr = (((uniChar & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000; @@ -1265,7 +1261,7 @@ TkUtfToUniChar( size_t TkUniCharToUtf(int ch, char *buf) { - if ((sizeof(Tcl_UniChar) == 2) && (((unsigned)(ch - 0x10000) <= 0xFFFFF))) { + if ((unsigned)(ch - 0x10000) <= 0xFFFFF) { /* Spit out a 4-byte UTF-8 character or 2 x 3-byte UTF-8 characters, depending on Tcl * version and/or TCL_UTF_MAX build value */ int len = Tcl_UniCharToUtf(0xD800 | ((ch - 0x10000) >> 10), buf); @@ -1273,44 +1269,6 @@ size_t TkUniCharToUtf(int ch, char *buf) } return Tcl_UniCharToUtf(ch, buf); } -/* - *--------------------------------------------------------------------------- - * - * TkUtfPrev -- - * - * Almost the same as Tcl_UtfPrev. - * This function is capable of jumping over a upper/lower surrogate pair. - * So, might jump back up to 6 bytes. - * - * Results: - * pointer to the first byte of the current UTF-8 character. A surrogate - * pair is also handled as being a single entity. - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -const char * -TkUtfPrev( - const char *src, /* The UTF-8 string. */ - const char *start) /* Start position of string */ -{ - const char *p = Tcl_UtfPrev(src, start); - const char *first = Tcl_UtfPrev(p, start); - int ch; - -#if TCL_UTF_MAX == 3 - if ((src - start > 3) && ((src[-1] & 0xC0) == 0x80) && ((src[-2] & 0xC0) == 0x80) - && ((src[-3] & 0xC0) == 0x80) && (UCHAR(src[-4]) >= 0xF0)) { - return src - 4; - } -#endif - - return (first + TkUtfToUniChar(first, &ch) >= src) ? first : p ; -} - #endif /* * Local Variables: -- cgit v0.12 From c5e2b9248f392b466707ad994ac21756a5208532 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 15 Mar 2021 11:42:39 +0000 Subject: TkUtfPrev() is only needed when sizeof(Tcl_UniChar) == 2 --- generic/tkInt.h | 3 ++- generic/tkUtil.c | 42 ++++++++++++++++++++---------------------- 2 files changed, 22 insertions(+), 23 deletions(-) diff --git a/generic/tkInt.h b/generic/tkInt.h index a98b6d6..3cc78f3 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1322,7 +1322,8 @@ MODULE_SCOPE void TkUnixSetXftClipRegion(TkRegion clipRegion); # define c_class class #endif -#if TCL_UTF_MAX > 4 +/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */ +#if TCL_UTF_MAX > (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6)) # define TkUtfToUniChar Tcl_UtfToUniChar # define TkUniCharToUtf Tcl_UniCharToUtf # define TkUtfPrev Tcl_UtfPrev diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 00ac7be..375bb83 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -57,8 +57,7 @@ TkStateParseProc( int flags = PTR2INT(clientData); size_t length; Tcl_Obj *msgObj; - - register Tk_State *statePtr = (Tk_State *) (widgRec + offset); + Tk_State *statePtr = (Tk_State *) (widgRec + offset); if (value == NULL || *value == 0) { *statePtr = TK_STATE_NULL; @@ -134,7 +133,7 @@ TkStatePrintProc( * information about how to reclaim storage * for return string. */ { - register Tk_State *statePtr = (Tk_State *) (widgRec + offset); + Tk_State *statePtr = (Tk_State *) (widgRec + offset); switch (*statePtr) { case TK_STATE_NORMAL: @@ -179,8 +178,7 @@ TkOrientParseProc( { int c; size_t length; - - register int *orientPtr = (int *) (widgRec + offset); + int *orientPtr = (int *) (widgRec + offset); if (value == NULL || *value == 0) { *orientPtr = 0; @@ -237,7 +235,7 @@ TkOrientPrintProc( * information about how to reclaim storage * for return string. */ { - register int *statePtr = (int *) (widgRec + offset); + int *statePtr = (int *) (widgRec + offset); if (*statePtr) { return "vertical"; @@ -424,7 +422,7 @@ TkOffsetPrintProc( if (offsetPtr->flags >= INT_MAX) { return "end"; } - p = ckalloc(32); + p = (char *)ckalloc(32); sprintf(p, "%d", offsetPtr->flags & ~TK_OFFSET_INDEX); *freeProcPtr = TCL_DYNAMIC; return p; @@ -454,7 +452,7 @@ TkOffsetPrintProc( return "se"; } } - q = p = ckalloc(32); + q = p = (char *)ckalloc(32); if (offsetPtr->flags & TK_OFFSET_RELATIVE) { *q++ = '#'; } @@ -519,7 +517,7 @@ TkPixelPrintProc( Tcl_FreeProc **freeProcPtr) /* not used */ { double *doublePtr = (double *) (widgRec + offset); - char *p = ckalloc(24); + char *p = (char *)ckalloc(24); Tcl_PrintDouble(NULL, *doublePtr, p); *freeProcPtr = TCL_DYNAMIC; @@ -1088,7 +1086,7 @@ TkBackgroundEvalObjv( Tcl_Command TkMakeEnsemble( Tcl_Interp *interp, - const char *namespace, + const char *namesp, const char *name, ClientData clientData, const TkEnsemble map[]) @@ -1105,11 +1103,11 @@ TkMakeEnsemble( Tcl_DStringInit(&ds); - namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0); + namespacePtr = Tcl_FindNamespace(interp, namesp, NULL, 0); if (namespacePtr == NULL) { - namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL); + namespacePtr = Tcl_CreateNamespace(interp, namesp, NULL, NULL); if (namespacePtr == NULL) { - Tcl_Panic("failed to create namespace \"%s\"", namespace); + Tcl_Panic("failed to create namespace \"%s\"", namesp); } } @@ -1125,8 +1123,8 @@ TkMakeEnsemble( } Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, namespace, -1); - if (!(strlen(namespace) == 2 && namespace[1] == ':')) { + Tcl_DStringAppend(&ds, namesp, -1); + if (!(strlen(namesp) == 2 && namesp[1] == ':')) { Tcl_DStringAppend(&ds, "::", -1); } Tcl_DStringAppend(&ds, name, -1); @@ -1192,7 +1190,8 @@ TkSendVirtualEvent( Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL); } -#if TCL_UTF_MAX <= 4 +/* Tcl 8.6 has a different definition of Tcl_UniChar than other Tcl versions for TCL_UTF_MAX > 3 */ +#if TCL_UTF_MAX <= (3 + (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 6)) /* *--------------------------------------------------------------------------- * @@ -1221,11 +1220,11 @@ TkUtfToUniChar( Tcl_UniChar uniChar = 0; int len = Tcl_UtfToUniChar(src, &uniChar); - if ((sizeof(Tcl_UniChar) == 2) && ((uniChar & 0xFC00) == 0xD800)) { + if ((uniChar & 0xFC00) == 0xD800) { Tcl_UniChar low = uniChar; - /* This can only happen if Tcl is compiled with TCL_UTF_MAX=4, - * or when a high surrogate character is detected in UTF-8 form */ - int len2 = Tcl_UtfToUniChar(src+len, &low); + /* This can only happen if sizeof(Tcl_UniChar)== 2 and src points + * to a character > U+FFFF */ + size_t len2 = Tcl_UtfToUniChar(src+len, &low); if ((low & 0xFC00) == 0xDC00) { *chPtr = (((uniChar & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000; return len + len2; @@ -1256,7 +1255,7 @@ TkUtfToUniChar( int TkUniCharToUtf(int ch, char *buf) { - if ((sizeof(Tcl_UniChar) == 2) && (((unsigned)(ch - 0x10000) <= 0xFFFFF))) { + if ((unsigned)(ch - 0x10000) <= 0xFFFFF) { /* Spit out a 4-byte UTF-8 character or 2 x 3-byte UTF-8 characters, depending on Tcl * version and/or TCL_UTF_MAX build value */ int len = Tcl_UniCharToUtf(0xD800 | ((ch - 0x10000) >> 10), buf); @@ -1333,7 +1332,6 @@ TkUtfAtIndex( return p; } #endif - /* * Local Variables: * mode: c -- cgit v0.12