From e883cc84772de84b5cbb175808ecad82d5112a04 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 30 Sep 2020 09:45:02 +0000 Subject: Fix safe-1.2 testcase when running Tcl version < 8.6.7 (That's when tcl:encoding:dirs became hidden) --- tests/safe.test | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/tests/safe.test b/tests/safe.test index 5a2cd26..3a3b029 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -35,7 +35,10 @@ namespace import -force tcltest::test set hidden_cmds [list bell cd clipboard encoding exec exit \ fconfigure glob grab load menu open pwd selection \ - socket source tcl:encoding:dirs toplevel unload wm] + socket source toplevel unload wm] +if {[package vsatisfies [package provide Tcl] 8.6.7-]} { + lappend hidden_cmds tcl:encoding:dirs +} if {[package vsatisfies [package provide Tcl] 8.7-]} { lappend hidden_cmds file tcl:encoding:system tcl:file:tempdir foreach cmd { -- cgit v0.12 From 2cfcf649ca494a8a1a8b733fa9fbe9b033d7dfdd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 30 Sep 2020 10:30:45 +0000 Subject: Mark 10 testcases with failsOnUbuntuNoXft. They fail on Ubuntu if Tk is compiled with --disable-xft --- tests/entry.test | 5 +- tests/font.test | 433 +++++++++++++++++++++++++------------------------ tests/fontchooser.test | 5 +- tests/spinbox.test | 5 +- tests/textTag.test | 7 +- tests/unixFont.test | 3 +- 6 files changed, 236 insertions(+), 222 deletions(-) diff --git a/tests/entry.test b/tests/entry.test index 0146dbf..f1d61b2 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -11,6 +11,9 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] + # For xscrollcommand set scrollInfo {} proc scroll args { @@ -2311,7 +2314,7 @@ test entry-8.17 {DeleteChars procedure} -setup { } -cleanup { destroy .e } -result 4 -test entry-8.18 {DeleteChars procedure} -setup { +test entry-8.18 {DeleteChars procedure} -constraints failsOnUbuntuNoXft -setup { entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e focus .e diff --git a/tests/font.test b/tests/font.test index 352139a..0f4c8de 100644 --- a/tests/font.test +++ b/tests/font.test @@ -15,6 +15,7 @@ tcltest::loadTestedCommands testConstraint fullutf [expr {[format %c 0x010000] != "\uFFFD"}] testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] set defaultfontlist [font names] @@ -62,9 +63,9 @@ test font-1.1 {TkFontPkgInit} -setup { } -body { interp create foo foo eval { - load {} Tk - wm geometry . +0+0 - update + load {} Tk + wm geometry . +0+0 + update } interp delete foo } -result {} @@ -78,25 +79,25 @@ test font-2.1 {TkFontPkgFree} -setup { # Makes sure that named font was visible only to child interp. foo eval { - load {} Tk - wm geometry . +0+0 - button .b -font {times 16} -text "hi" - pack .b - font create wiggles -family courier -underline 1 - update + load {} Tk + wm geometry . +0+0 + button .b -font {times 16} -text "hi" + pack .b + font create wiggles -family courier -underline 1 + update } lappend x [catch {font configure wiggles} msg; set msg] # Tests cancelling the idle handler for TheWorldHasChanged, # because app goes away before idle serviced. foo eval { - .b config -font wiggles - font config wiggles -size 24 - destroy . + .b config -font wiggles + font config wiggles -size 24 + destroy . } lappend x [foo eval {catch {font families} msg; set msg}] } -cleanup { - interp delete foo + interp delete foo } -result {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}} @@ -195,7 +196,7 @@ test font-5.4 {font command: configure: get all options} -setup { font create xyz -family xyz lindex [font configure xyz] 1 } -cleanup { - font delete xyz + font delete xyz } -result xyz test font-5.5 {font command: configure: get one option} -setup { clearnondefaultfonts @@ -203,9 +204,9 @@ test font-5.5 {font command: configure: get one option} -setup { # (objc == 4) so objPtr = objv[3] font create xyz -family xyz font configure xyz -family - getnondefaultfonts + getnondefaultfonts } -cleanup { - font delete xyz + font delete xyz } -result xyz test font-5.6 {font command: configure: update existing font} -setup { catch {font delete xyz} @@ -216,7 +217,7 @@ test font-5.6 {font command: configure: update existing font} -setup { update font configure xyz -family } -cleanup { - font delete xyz + font delete xyz } -result xyz test font-5.7 {font command: configure: bad option} -setup { catch {font delete xyz} @@ -224,7 +225,7 @@ test font-5.7 {font command: configure: bad option} -setup { font create xyz font configure xyz -style } -cleanup { - font delete xyz + font delete xyz } -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike} @@ -244,7 +245,7 @@ test font-6.2 {font command: create: name specified} -setup { font create xyz getnondefaultfonts } -cleanup { - font delete xyz + font delete xyz } -result {xyz} test font-6.3 {font command: create: name not really specified} -setup { clearnondefaultfonts @@ -286,7 +287,7 @@ test font-6.7 {font command: create: already exists} -setup { font create xyz font create xyz } -cleanup { - font delete xyz + font delete xyz } -returnCodes error -result {named font "xyz" already exists} test font-7.1 {font command: delete: arguments} -body { @@ -295,7 +296,7 @@ test font-7.1 {font command: delete: arguments} -body { } -returnCodes error -result {wrong # args: should be "font delete fontname ?fontname ...?"} test font-7.2 {font command: delete: loop test} -setup { clearnondefaultfonts - set x {} + set x {} } -body { # for (i = 2; i < objc; i++) font create a -underline 1 @@ -311,7 +312,7 @@ test font-7.2 {font command: delete: loop test} -setup { } -result {{a b c d e} d} test font-7.3 {font command: delete: loop test} -setup { clearnondefaultfonts - set x {} + set x {} } -body { # (namedHashPtr == NULL) in middle of loop font create a -underline 1 @@ -344,7 +345,7 @@ test font-7.5 {font command: delete: mark for later deletion} -setup { font actual xyz font configure xyz } -cleanup { - destroy .t.f + destroy .t.f } -returnCodes error -result {named font "xyz" doesn't exist} test font-7.6 {font command: delete: mark for later deletion} -setup { destroy .t.f @@ -358,7 +359,7 @@ test font-7.6 {font command: delete: mark for later deletion} -setup { font delete xyz font actual xyz catch {font configure xyz} - .t.f cget -font + .t.f cget -font } -cleanup { destroy .t.f } -result xyz @@ -516,7 +517,7 @@ test font-12.1 {UpdateDependantFonts procedure: no users} -setup { font create xyz font configure xyz -family times } -cleanup { - font delete xyz + font delete xyz } -result {} test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { destroy .t.f @@ -535,21 +536,21 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { set b2 [winfo reqwidth .t.f] expr {$a1==$b1 && $a2==$b2} } -cleanup { - destroy .t.f + destroy .t.f font delete xyz } -result {1} test font-13.1 {CreateNamedFont: new named font} -setup { catch {font delete xyz} - set x {} + set x {} } -body { # not (new == 0) lappend x [getnondefaultfonts] font create xyz lappend x [getnondefaultfonts] } -cleanup { - font delete xyz + font delete xyz } -result {{} xyz} test font-13.2 {CreateNamedFont: named font already exists} -setup { catch {font delete xyz} @@ -558,7 +559,7 @@ test font-13.2 {CreateNamedFont: named font already exists} -setup { font create xyz font create xyz } -cleanup { - font delete xyz + font delete xyz } -returnCodes error -result {named font "xyz" already exists} test font-13.3 {CreateNamedFont: named font already exists} -setup { catch {font delete xyz} @@ -567,7 +568,7 @@ test font-13.3 {CreateNamedFont: named font already exists} -setup { font create xyz font create xyz } -cleanup { - font delete xyz + font delete xyz } -returnCodes error -result {named font "xyz" already exists} test font-13.4 {CreateNamedFont: recreate "deleted" font} -setup { destroy .t.f @@ -582,8 +583,8 @@ test font-13.4 {CreateNamedFont: recreate "deleted" font} -setup { font create xyz -family courier font configure xyz -family } -cleanup { - font delete xyz - destroy .t.f + font delete xyz + destroy .t.f } -result {courier} @@ -592,7 +593,7 @@ test font-14.1 {Tk_GetFont procedure} -body { test font-15.1 {Tk_AllocFontFromObj - converting internal reps} -constraints { - testfont + testfont } -setup { destroy .b1 .b2 } -body { @@ -605,7 +606,7 @@ test font-15.1 {Tk_AllocFontFromObj - converting internal reps} -constraints { destroy .b1 .b2 } -result {{1 0}} test font-15.2 {Tk_AllocFontFromObj - discard stale font} -constraints { - testfont + testfont } -setup { destroy .b1 .b2 set result {} @@ -620,7 +621,7 @@ test font-15.2 {Tk_AllocFontFromObj - discard stale font} -constraints { destroy .b2 } -result {{} {{1 1}}} test font-15.3 {Tk_AllocFontFromObj - reuse existing font} -constraints { - testfont + testfont } -setup { destroy .b1 .b2 set result {} @@ -643,7 +644,7 @@ test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} -setup { .t.f config -font {-family fixed} lindex [font actual {-family fixed}] 0 } -cleanup { - destroy .t.f + destroy .t.f } -result {-family} test font-15.5 {Tk_AllocFontFromObj procedure: get named font} -setup { destroy .t.f @@ -655,7 +656,7 @@ test font-15.5 {Tk_AllocFontFromObj procedure: get named font} -setup { font create xyz .t.f config -font xyz } -cleanup { - destroy .t.f + destroy .t.f font delete xyz } -result {} test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} -setup { @@ -666,7 +667,7 @@ test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} -setup { # not (namedHashPtr != NULL) .t.f config -font {times 20} } -cleanup { - destroy .t.f + destroy .t.f } -result {-family} -result {} test font-15.7 {Tk_AllocFontFromObj procedure: get native font} -constraints { unix @@ -710,7 +711,7 @@ test font-15.11 {Tk_AllocFontFromObj procedure: get attribute font} -body { lindex [font actual {plan 9}] 0 } -result {-family} test font-15.12 {Tk_AllocFontFromObj procedure: setup tab width} -setup { - destroy .l + destroy .l } -body { # Tk_MeasureChars(fontPtr, "0", ...) label .l -bd 0 -padx 0 -highlightthickness 0 -font $fixed -text "a\tb" @@ -719,7 +720,7 @@ test font-15.12 {Tk_AllocFontFromObj procedure: setup tab width} -setup { set res2 [expr [font measure $fixed "0"]*9] expr {$res1 eq $res2} } -cleanup { - destroy .l + destroy .l } -result 1 test font-15.13 {Tk_AllocFontFromObj procedure: underline position} -setup { destroy .t.f @@ -730,7 +731,7 @@ test font-15.13 {Tk_AllocFontFromObj procedure: underline position} -setup { .t.f config -text "underline" -font "times -8 underline" update } -cleanup { - destroy .t.f + destroy .t.f } -result {} @@ -742,7 +743,7 @@ test font-16.1 {Tk_NameOfFont procedure} -setup { .t.f config -font -family\ fixed .t.f cget -font } -cleanup { - destroy .t.f + destroy .t.f } -result {-family fixed} @@ -1450,20 +1451,20 @@ test font-21.66 {Tk_PostscriptFontName procedure: exhaustive} -constraints { test font-22.1 {Tk_TextWidth procedure} -setup { - destroy .t.l + destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ - -text "0" -font "Courier -12" - pack .t.l - set ax [winfo reqwidth .t.l] + label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + -text "0" -font "Courier -12" + pack .t.l + set ax [winfo reqwidth .t.l] expr {[font measure [.t.l cget -font] "000"] eq $ax*3} } -cleanup { - destroy .t.l + destroy .t.l } -result 1 test font-23.1 {Tk_UnderlineChars procedure} -setup { - destroy .t.t + destroy .t.t } -body { text .t.t .t.t insert 1.0 abc\tdefg @@ -1471,7 +1472,7 @@ test font-23.1 {Tk_UnderlineChars procedure} -setup { .t.t tag add sel 1.0 end update } -cleanup { - destroy .t.t + destroy .t.t } -result {} @@ -1488,27 +1489,27 @@ test font-24.1 {Tk_ComputeTextLayout: empty string} -body { } -result {} test font-24.2 {Tk_ComputeTextLayout: simple string} -body { .t.l config -text "000" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ - [expr {[winfo reqheight .t.l] eq $ay}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq $ay}] } -result {1 1} test font-24.3 {Tk_ComputeTextLayout: find special chars} -body { .t.l config -text "000\n000" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] } -result {1 1} test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} -body { .t.l config -text "000\n000" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] } -result {1 1} test font-24.5 {Tk_ComputeTextLayout: break line} -body { .t.l config -text "000\t00000" -wrap [expr 9 * $ax] - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] } -cleanup { .t.l config -wrap 0 } -result {1 1} @@ -1517,26 +1518,26 @@ test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} -body { } -result {} test font-24.7 {Tk_ComputeTextLayout: special char was \n} -body { .t.l config -text "000\n0000" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] } -result {1 1} test font-24.8 {Tk_ComputeTextLayout: special char was \t} -body { .t.l config -text "000\t00" - update - list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] \ - [expr {[winfo reqheight .t.l] eq $ay}] + update + list [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] \ + [expr {[winfo reqheight .t.l] eq $ay}] } -result {1 1} test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} -body { set x {} .t.l config -text "000\t000" - update + update lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 11}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] .t.l config -text "000\t000" -wrap [expr 100 * $ax] - update + update lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 11}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] return $x } -cleanup { .t.l config -wrap 0 @@ -1544,13 +1545,13 @@ test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} -body { test font-24.10 {Tk_ComputeTextLayout: tab caused break} -body { set x {} .t.l config -text "000\t" - update + update lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] .t.l config -text "000\t00" -wrap [expr $ax * 6] - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 8}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] return $x } -cleanup { .t.l config -wrap 0 @@ -1558,13 +1559,13 @@ test font-24.10 {Tk_ComputeTextLayout: tab caused break} -body { test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} -body { set x {} .t.l config -text "000 000" -wrap [expr {$ax * 5}] - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] .t.l config -text "000 " - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 3}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] return $x } -cleanup { .t.l config -wrap 0 @@ -1572,44 +1573,44 @@ test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} -body { test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} -body { set x {} .t.l config -text "000 0000" -wrap [expr {$ax * 5}] - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] .t.l config -text "000\t00 0000" -wrap [expr {$ax * 12}] - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 10}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] return $x } -cleanup { .t.l config -wrap 0 } -result {1 1 1 1} test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} -body { .t.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" - update - list [expr {[winfo reqwidth .t.l] eq 1}] \ - [expr {[winfo reqheight .t.l] eq [expr {$ay * 129}]}] + update + list [expr {[winfo reqwidth .t.l] eq 1}] \ + [expr {[winfo reqheight .t.l] eq [expr {$ay * 129}]}] } -result {1 1} test font-24.14 {Tk_ComputeTextLayout: text ended with \n} -body { set x {} - .t.l config -text "0000" - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] - lappend x [expr {[winfo reqheight .t.l] eq $ay}] - .t.l config -text "0000\n" - update - lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] - lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] - return $x + .t.l config -text "0000" + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq $ay}] + .t.l config -text "0000\n" + update + lappend x [expr {[winfo reqwidth .t.l] eq [expr {$ax * 4}]}] + lappend x [expr {[winfo reqheight .t.l] eq [expr {$ay * 2}]}] + set x } -result {1 1 1 1} destroy .t.l test font-24.15 {Tk_ComputeTextLayout: justification} -setup { set x {} - destroy .t.c - canvas .t.c -closeenough 0 - .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" - pack .t.c - update + destroy .t.c + canvas .t.c -closeenough 0 + .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" + pack .t.c + update } -body { csetup "000\n00000" .t.c itemconfig text -just left @@ -1621,7 +1622,7 @@ test font-24.15 {Tk_ComputeTextLayout: justification} -setup { .t.c itemconfig text -just left return $x } -cleanup { - destroy .t.c + destroy .t.c } -result {2 1 0} @@ -1633,7 +1634,7 @@ test font-25.1 {Tk_FreeTextLayout procedure} -setup { .t.f config -text foo .t.f config -text boo } -cleanup { - destroy .t.f + destroy .t.f } -result {} @@ -1650,7 +1651,7 @@ test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} -setup { } -body { .t.f config -text foo } -cleanup { - destroy .t.f + destroy .t.f } -result {} test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} -body { csetup "000\t00\n000" @@ -1795,110 +1796,110 @@ pack .t.c update test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} -body { csetup "000\n000\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x 0 -y 0 return $x } -cleanup { - bind all {} + bind all {} } -result {0} test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body { csetup "000\n000\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x $ax -y $ay return $x } -cleanup { - bind all {} + bind all {} } -result {5} test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} -body { csetup "000\n0\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x [expr $ax*2] -y $ay return $x } -cleanup { - bind all {} + bind all {} } -result {} test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} -body { csetup "000\t000\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x [expr $ax*6] -y 0 return $x } -cleanup { - bind all {} + bind all {} } -result {3} test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} -body { csetup "000\n0\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x [expr $ax*2] -y $ay return $x } -cleanup { - bind all {} + bind all {} } -result {} test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} -body { csetup "000\n000 000000000" .t.c itemconfig text -width [expr $ax*10] - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x [expr $ax*5] -y $ay .t.c itemconfig text -width 0 return $x } -cleanup { - bind all {} + bind all {} } -result {} .t.c itemconfig text -justify center test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} -body { csetup "0\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x 0 -y 0 return $x } -cleanup { - bind all {} + bind all {} } -result {} test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} -body { csetup "0\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x [expr $ax*2] -y 0 return $x } -cleanup { - bind all {} + bind all {} } -result {} test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} -body { csetup "0\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x $ax -y 0 return $x } -cleanup { - bind all {} + bind all {} } -result {0} test font-30.10 {Tk_DistanceToTextLayout procedure: above line} -body { csetup "0\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x 0 -y 0 return $x } -cleanup { - bind all {} + bind all {} } -result {} test font-30.11 {Tk_DistanceToTextLayout procedure: below line} -body { csetup "000\n0" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x 0 -y $ay @@ -1908,7 +1909,7 @@ test font-30.11 {Tk_DistanceToTextLayout procedure: below line} -body { } -result {} test font-30.12 {Tk_DistanceToTextLayout procedure: in line} -body { csetup "0\n000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x $ax -y $ay @@ -1919,13 +1920,13 @@ test font-30.12 {Tk_DistanceToTextLayout procedure: in line} -body { .t.c itemconfig text -justify left test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body { csetup "000" - .t.c bind all {lappend x [.t.c index current @%x,%y]} + .t.c bind all {lappend x [.t.c index current @%x,%y]} set x {} event generate .t.c event generate .t.c -x $ax -y 0 return $x } -cleanup { - bind all {} + bind all {} } -result {1} destroy .t.c @@ -1977,11 +1978,11 @@ destroy .t.c test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setup { - destroy .t.c - canvas .t.c -closeenough 0 - .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" - pack .t.c - update + destroy .t.c + canvas .t.c -closeenough 0 + .t.c create text 0 0 -tags text -anchor nw -just left -font "Courier -12" + pack .t.c + update } -body { # If there were a whole bunch of returns or tabs in a row, then the # temporary buffer could overflow and write on the stack. @@ -1994,7 +1995,7 @@ test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setu set i [string first "(qwerty" $x] string range $x $i [expr {$i + 278}] } -cleanup { - destroy .t.c + destroy .t.c } -result {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)] [(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)] [()] @@ -2052,85 +2053,85 @@ test font-34.2 {ConfigAttributesObj procedure: arguments} -setup { test font-34.3 {ConfigAttributesObj procedure: family} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -family xyz - lappend x [font config xyz -family] - font config xyz -family times - lappend x [font config xyz -family] + font create xyz -family xyz + lappend x [font config xyz -family] + font config xyz -family times + lappend x [font config xyz -family] } -cleanup { font delete xyz } -result {xyz times} test font-34.4 {ConfigAttributesObj procedure: size} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -size 20 - lappend x [font config xyz -size] - font config xyz -size 40 - lappend x [font config xyz -size] + font create xyz -size 20 + lappend x [font config xyz -size] + font config xyz -size 40 + lappend x [font config xyz -size] } -cleanup { - font delete xyz + font delete xyz } -result {20 40} test font-34.5 {ConfigAttributesObj procedure: weight} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -weight normal - lappend x [font config xyz -weight] - font config xyz -weight bold - lappend x [font config xyz -weight] + font create xyz -weight normal + lappend x [font config xyz -weight] + font config xyz -weight bold + lappend x [font config xyz -weight] } -cleanup { - font delete xyz + font delete xyz } -result {normal bold} test font-34.6 {ConfigAttributesObj procedure: slant} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -slant roman - lappend x [font config xyz -slant] - font config xyz -slant italic - lappend x [font config xyz -slant] + font create xyz -slant roman + lappend x [font config xyz -slant] + font config xyz -slant italic + lappend x [font config xyz -slant] } -cleanup { - font delete xyz + font delete xyz } -result {roman italic} test font-34.7 {ConfigAttributesObj procedure: underline} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -underline 0 - lappend x [font config xyz -underline] - font config xyz -underline 1 - lappend x [font config xyz -underline] + font create xyz -underline 0 + lappend x [font config xyz -underline] + font config xyz -underline 1 + lappend x [font config xyz -underline] } -cleanup { - font delete xyz + font delete xyz } -result {0 1} test font-34.8 {ConfigAttributesObj procedure: overstrike} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -overstrike 0 - lappend x [font config xyz -overstrike] - font config xyz -overstrike 1 - lappend x [font config xyz -overstrike] + font create xyz -overstrike 0 + lappend x [font config xyz -overstrike] + font config xyz -overstrike 1 + lappend x [font config xyz -overstrike] } -cleanup { - font delete xyz + font delete xyz } -result {0 1} test font-34.9 {ConfigAttributesObj procedure: size} -body { - font create xyz -size xyz + font create xyz -size xyz } -returnCodes error -result {expected integer but got "xyz"} test font-34.10 {ConfigAttributesObj procedure: weight} -body { - font create xyz -weight xyz + font create xyz -weight xyz } -returnCodes error -result {bad -weight value "xyz": must be normal, or bold} test font-34.11 {ConfigAttributesObj procedure: slant} -body { - font create xyz -slant xyz + font create xyz -slant xyz } -returnCodes error -result {bad -slant value "xyz": must be roman, or italic} test font-34.12 {ConfigAttributesObj procedure: underline} -body { - font create xyz -underline xyz + font create xyz -underline xyz } -returnCodes error -result {expected boolean value but got "xyz"} test font-34.13 {ConfigAttributesObj procedure: overstrike} -body { - font create xyz -overstrike xyz + font create xyz -overstrike xyz } -returnCodes error -result {expected boolean value but got "xyz"} @@ -2141,7 +2142,7 @@ test font-35.1 {GetAttributeInfoObj procedure: one attribute} -setup { font create xyz -family xyz font config xyz -family } -cleanup { - font delete xyz + font delete xyz } -result {xyz} @@ -2152,7 +2153,7 @@ test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} -setup { font create xyz font config xyz -xyz } -cleanup { - font delete xyz + font delete xyz } -returnCodes { error } -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike} @@ -2165,60 +2166,60 @@ test font-37.1 {GetAttributeInfoObj procedure: all attributes} -setup { font create xyz -family xyz font config xyz } -cleanup { - font delete xyz + font delete xyz } -result {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0} test font-37.2 {GetAttributeInfo procedure: family} -setup { catch {font delete xyz} } -body { - font create xyz -family xyz - font config xyz -family + font create xyz -family xyz + font config xyz -family } -cleanup { - font delete xyz + font delete xyz } -result {xyz} test font-37.3 {GetAttributeInfo procedure: size} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -size 20 - font config xyz -size + font create xyz -size 20 + font config xyz -size } -cleanup { - font delete xyz + font delete xyz } -result {20} test font-37.4 {GetAttributeInfo procedure: weight} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -weight normal - font config xyz -weight + font create xyz -weight normal + font config xyz -weight } -cleanup { - font delete xyz + font delete xyz } -result {normal} test font-37.5 {GetAttributeInfo procedure: slant} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -slant italic - font config xyz -slant + font create xyz -slant italic + font config xyz -slant } -cleanup { - font delete xyz + font delete xyz } -result {italic} test font-37.6 {GetAttributeInfo procedure: underline} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -underline yes - font config xyz -underline + font create xyz -underline yes + font config xyz -underline } -cleanup { - font delete xyz + font delete xyz } -result {1} test font-37.7 {GetAttributeInfo procedure: overstrike} -setup { catch {font delete xyz} - set x {} + set x {} } -body { - font create xyz -overstrike no - font config xyz -overstrike + font create xyz -overstrike no + font config xyz -overstrike } -cleanup { - font delete xyz + font delete xyz } -result {0} @@ -2257,7 +2258,7 @@ test font-38.10 {ParseFontNameObj procedure: arguments} -body { font actual {times xyz xyz} } -returnCodes error -result {expected integer but got "xyz"} test font-38.11 {ParseFontNameObj procedure: stylelist loop} -constraints { - unixOrWin + unixOrWin failsOnUbuntuNoXft } -body { lrange [font actual {times 12 bold italic overstrike underline}] 4 end } -result {-weight bold -slant italic -underline 1 -overstrike 1} @@ -2339,21 +2340,21 @@ test font-43.1 {FieldSpecified procedure: specified vs. non-specified} -body { } -result [font actual {times 0} -family] -test font-44.1 {TkFontGetPixels: size < 0} -setup { - set oldscale [tk scaling] +test font-44.1 {TkFontGetPixels: size < 0} -constraints failsOnUbuntuNoXft -setup { + set oldscale [tk scaling] } -body { - tk scaling 0.5 + tk scaling 0.5 font actual {times -12} -size } -cleanup { - tk scaling $oldscale + tk scaling $oldscale } -result {24} -test font-44.2 {TkFontGetPoints: size >= 0} -constraints noExceed -setup { - set oldscale [tk scaling] +test font-44.2 {TkFontGetPoints: size >= 0} -constraints {noExceed failsOnUbuntuNoXft} -setup { + set oldscale [tk scaling] } -body { - tk scaling 0.5 + tk scaling 0.5 font actual {times 12} -size } -cleanup { - tk scaling $oldscale + tk scaling $oldscale } -result {12} @@ -2375,12 +2376,12 @@ test font-45.3 {TkFontGetAliasList: match} -constraints {noExceed} -body { test font-46.1 {font actual, with character, no option, no --} -body { - font actual {times 10} a + font actual {times 10} a } -match glob -result [list -family [font actual {times 10} -family] -size *\ -slant roman -underline 0 -overstrike 0] test font-46.2 {font actual, with character introduced by --} -body { - font actual {times 10} -- - + font actual {times 10} -- - } -match glob -result [list -family [font actual {times 10} -family] -size *\ -slant roman -underline 0 -overstrike 0] diff --git a/tests/fontchooser.test b/tests/fontchooser.test index 3fbc01f..0efe619 100644 --- a/tests/fontchooser.test +++ b/tests/fontchooser.test @@ -6,6 +6,9 @@ package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] + # the following helper functions are related to the functions used # in winDialog.test where they are used to send messages to the win32 # dialog (hence the wierdness). @@ -179,7 +182,7 @@ test fontchooser-4.3 {fontchooser -font} -constraints scriptImpl -body { expr {$::testfont ne {}} } -result {1} -test fontchooser-4.4 {fontchooser -font} -constraints scriptImpl -body { +test fontchooser-4.4 {fontchooser -font} -constraints {scriptImpl failsOnUbuntuNoXft} -body { start { tk::fontchooser::Configure -command ApplyFont -font {times 14 bold} tk::fontchooser::Show diff --git a/tests/spinbox.test b/tests/spinbox.test index 8d19a7e..4cc1238 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -11,6 +11,9 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] + # For xscrollcommand set scrollInfo {} proc scroll args { @@ -2603,7 +2606,7 @@ test spinbox-8.17 {DeleteChars procedure} -setup { } -cleanup { destroy .e } -result 4 -test spinbox-8.18 {DeleteChars procedure} -setup { +test spinbox-8.18 {DeleteChars procedure} -constraints failsOnUbuntuNoXft -setup { spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 pack .e focus .e diff --git a/tests/textTag.test b/tests/textTag.test index ba7be87..6a7fc86 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -11,6 +11,9 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] + destroy .t text .t -width 20 -height 10 testConstraint haveCourier12 [expr {[catch { @@ -1695,7 +1698,7 @@ test textTag-16.5 {TkTextPickCurrent procedure} -constraints { } -result {3.2} test textTag-16.6 {TkTextPickCurrent procedure} -constraints { - haveCourier12 + haveCourier12 failsOnUbuntuNoXft } -setup { foreach i {big a b c d} { .t tag remove $i 1.0 end @@ -1715,7 +1718,7 @@ test textTag-16.6 {TkTextPickCurrent procedure} -constraints { } -result {3.1} test textTag-16.7 {TkTextPickCurrent procedure} -constraints { - haveCourier12 + haveCourier12 failsOnUbuntuNoXft } -setup { foreach i {big a b c d} { .t tag remove $i 1.0 end diff --git a/tests/unixFont.test b/tests/unixFont.test index 9a8f864..973d4d9 100644 --- a/tests/unixFont.test +++ b/tests/unixFont.test @@ -17,6 +17,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] if {[tk windowingsystem] eq "x11"} { set xlsf [auto_execok xlsfonts] @@ -116,7 +117,7 @@ test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} {x11 test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {x11 noExceed failsOnUbuntu} { lindex [font actual {-family courier}] 1 } {courier} -test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} x11 { +test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} {x11 failsOnUbuntuNoXft} { lindex [font actual {-family courier -size 37}] 3 } {37} test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} x11 { -- cgit v0.12 From af62bb859761fb78877f2b623732d200a2c07c5f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 30 Sep 2020 21:24:50 +0000 Subject: Fix [59cba33c6d]: win: theme detection in TkWinGetPlatformTheme() likely broken --- win/tkWinX.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/win/tkWinX.c b/win/tkWinX.c index 8616369..df8c004 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -358,12 +358,12 @@ TkWinGetPlatformTheme(void) * TK_THEME_WIN_CLASSIC could be set even when running under XP if the * windows classic theme was selected. */ - if (os.dwMajorVersion == 5 && os.dwMinorVersion == 1) { + if (os.dwMajorVersion == 5 && os.dwMinorVersion >= 1) { HKEY hKey; LPCWSTR szSubKey = L"Control Panel\\Appearance"; LPCWSTR szCurrent = L"Current"; DWORD dwSize = 200; - char pBuffer[200]; + WCHAR pBuffer[200]; memset(pBuffer, 0, dwSize); if (RegOpenKeyExW(HKEY_CURRENT_USER, szSubKey, 0L, @@ -372,7 +372,7 @@ TkWinGetPlatformTheme(void) } else { RegQueryValueExW(hKey, szCurrent, NULL, NULL, (LPBYTE) pBuffer, &dwSize); RegCloseKey(hKey); - if (strcmp(pBuffer, "Windows Standard") == 0) { + if (wcscmp(pBuffer, L"Windows Standard") == 0) { tkWinTheme = TK_THEME_WIN_CLASSIC; } else { tkWinTheme = TK_THEME_WIN_XP; -- cgit v0.12 From 32fd820c915bae23b016062081b921b3feec4ca8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 30 Sep 2020 22:07:41 +0000 Subject: If Tk is compiled with -DTK_NO_DEPRECATED, disable some testcases which fail because of that --- generic/tkPkgConfig.c | 3 +++ tests/bind.test | 5 ++++- tests/pkgconfig.test | 4 +++- tests/scrollbar.test | 17 +++++++++-------- 4 files changed, 19 insertions(+), 10 deletions(-) diff --git a/generic/tkPkgConfig.c b/generic/tkPkgConfig.c index fe084bf..ed8fb0b 100644 --- a/generic/tkPkgConfig.c +++ b/generic/tkPkgConfig.c @@ -100,6 +100,9 @@ static const Tcl_Config cfg[] = { {"profiled", CFG_PROFILED}, {"64bit", CFG_64}, {"optimized", CFG_OPTIMIZED}, +#ifdef TK_NO_DEPRECATED + {"nodeprecated", "1"}, +#endif {"mem_debug", CFG_MEMDEBUG}, {"fontsystem", CFG_FONTSYSTEM}, diff --git a/tests/bind.test b/tests/bind.test index 152fe3e..29f8873 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -13,6 +13,9 @@ eval tcltest::configure $argv tcltest::loadTestedCommands tk useinputmethods 0 +testConstraint nodeprecated [expr {"nodeprecated" ni [tk::pkgconfig list]}] + + toplevel .t -width 100 -height 50 wm geom .t +0+0 update idletasks @@ -6017,7 +6020,7 @@ test bind-28.9 {keysym names, Eth -> ETH} -body { } -cleanup { destroy .t.f } -result {} -test bind-28.10 {keysym names, Ooblique -> Oslash} -body { +test bind-28.10 {keysym names, Ooblique -> Oslash} -constraints nodeprecated -body { frame .t.f -class Test -width 150 -height 100 bind .t.f foo bind .t.f diff --git a/tests/pkgconfig.test b/tests/pkgconfig.test index e080b91..f07ca0f 100644 --- a/tests/pkgconfig.test +++ b/tests/pkgconfig.test @@ -18,7 +18,9 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -test pkgconfig-1.1 {query keys} nonwin { +testConstraint nodeprecated [expr {"nodeprecated" ni [tk::pkgconfig list]}] + +test pkgconfig-1.1 {query keys} nodeprecated { lsort [::tk::pkgconfig list] } [list \ 64bit bindir,install bindir,runtime debug demodir,install demodir,runtime \ diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 20ac275..86e742e 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -12,6 +12,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint nodeprecated [expr {"nodeprecated" ni [tk::pkgconfig list]}] proc scroll args { global scrollInfo @@ -316,7 +317,7 @@ destroy .t test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} { list [catch {.s get a} msg] $msg } {1 {wrong # args: should be ".s get"}} -test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} { +test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} nodeprecated { .s set 100 10 13 14 .s get } {100 10 13 14} @@ -401,27 +402,27 @@ test scrollbar-3.63 {ScrollbarWidgetCmd procedure, "set" option} { } set result } {0.4 0.4} -test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { list [catch {.s set abc def ghi jkl} msg] $msg } {1 {expected integer but got "abc"}} -test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { list [catch {.s set 1 def ghi jkl} msg] $msg } {1 {expected integer but got "def"}} -test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { list [catch {.s set 1 2 ghi jkl} msg] $msg } {1 {expected integer but got "ghi"}} -test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { list [catch {.s set 1 2 3 jkl} msg] $msg } {1 {expected integer but got "jkl"}} -test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { .s set -10 50 20 30 .s get } {0 50 0 0} -test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { .s set 100 -10 20 30 .s get } {100 0 20 30} -test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} { +test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} nodeprecated { .s set 100 50 30 20 .s get } {100 50 30 30} -- cgit v0.12 From 279143927533f7cdd980e4d1d239303cbc9e8a5a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 1 Oct 2020 08:55:52 +0000 Subject: Expression for contraint failsOnUbuntuNoXft was reverse .... --- tests/entry.test | 2 +- tests/font.test | 2 +- tests/fontchooser.test | 2 +- tests/spinbox.test | 2 +- tests/textTag.test | 4 ++-- tests/unixFont.test | 2 +- 6 files changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/entry.test b/tests/entry.test index f1d61b2..4463b9b 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -12,7 +12,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] -testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] # For xscrollcommand set scrollInfo {} diff --git a/tests/font.test b/tests/font.test index 0f4c8de..89780ba 100644 --- a/tests/font.test +++ b/tests/font.test @@ -15,7 +15,7 @@ tcltest::loadTestedCommands testConstraint fullutf [expr {[format %c 0x010000] != "\uFFFD"}] testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] -testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] set defaultfontlist [font names] diff --git a/tests/fontchooser.test b/tests/fontchooser.test index 0efe619..3ec7309 100644 --- a/tests/fontchooser.test +++ b/tests/fontchooser.test @@ -7,7 +7,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] -testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] # the following helper functions are related to the functions used # in winDialog.test where they are used to send messages to the win32 diff --git a/tests/spinbox.test b/tests/spinbox.test index 4cc1238..28d90d7 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -12,7 +12,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] -testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] # For xscrollcommand set scrollInfo {} diff --git a/tests/textTag.test b/tests/textTag.test index 6a7fc86..038150f 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -12,7 +12,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] -testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] destroy .t text .t -width 20 -height 10 @@ -1602,7 +1602,7 @@ test textTag-16.1 {TkTextPickCurrent procedure} -constraints { } -result {2.1 3.2 3.2 3.2 3.2 3.2 4.3} test textTag-16.2 {TkTextPickCurrent procedure} -constraints { - haveCourier12 + haveCourier12 failsOnUbuntuNoXft } -setup { .t tag delete {*}[.t tag names] wm geometry . +200+200 ; update diff --git a/tests/unixFont.test b/tests/unixFont.test index 973d4d9..86fb5bf 100644 --- a/tests/unixFont.test +++ b/tests/unixFont.test @@ -17,7 +17,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] -testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || ([catch {tk::pkgconfig get fontsystem} fs] || ($fs ne "xft"))}] +testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))}] if {[tk windowingsystem] eq "x11"} { set xlsf [auto_execok xlsfonts] -- cgit v0.12 From 231368f73de8a15b94a1cd60793e52c8d6f6d052 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 1 Oct 2020 09:05:38 +0000 Subject: Duplicate testconstraint failsOnUbuntu --- tests/textDisp.test | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/textDisp.test b/tests/textDisp.test index d54eb62..39d50d0 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -103,8 +103,6 @@ wm positionfrom . user wm deiconify . updateText -testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] - # Some window managers (like olwm under SunOS 4.1.3) misbehave in a way # that tends to march windows off the top and left of the screen. If # this happens, some tests will fail because parts of the window will -- cgit v0.12 From fecbf2b8553ba43518eba229753b0efc12aabd28 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 1 Oct 2020 14:49:14 +0000 Subject: Fix some gcc warnings (when using -Wshadow, deprecated XKeycodeToKeysym(), XScreenSaverQueryInfo weak symbol on MacOS) --- generic/tkFont.c | 16 ++++++++-------- generic/tkMenu.c | 4 +--- generic/tkOldConfig.c | 2 -- generic/tkPlace.c | 22 +++++++++++----------- generic/tkUtil.c | 2 +- unix/tkUnix.c | 2 +- unix/tkUnixKey.c | 7 +++++++ 7 files changed, 29 insertions(+), 26 deletions(-) diff --git a/generic/tkFont.c b/generic/tkFont.c index 3aed702..3e4044f 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -740,7 +740,7 @@ Tk_FontObjCmd( } case FONT_METRICS: { Tk_Font tkfont; - int skip, index, i; + int skip, i; const TkFontMetrics *fmPtr; static const char *const switches[] = { "-ascent", "-descent", "-linespace", "-fixed", NULL @@ -1973,7 +1973,7 @@ Tk_ComputeTextLayout( int *heightPtr) /* Filled with height of string. */ { TkFont *fontPtr = (TkFont *) tkfont; - const char *start, *end, *special; + const char *start, *endp, *special; int n, y, bytesThisChunk, maxChunks, curLine, layoutHeight; int baseline, height, curX, newX, maxWidth, *lineLengths; TextLayout *layoutPtr; @@ -2021,12 +2021,12 @@ Tk_ComputeTextLayout( curX = 0; - end = TkUtfAtIndex(string, numChars); + endp = TkUtfAtIndex(string, numChars); special = string; flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES; flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE; - for (start = string; start < end; ) { + for (start = string; start < endp; ) { if (start >= special) { /* * Find the next special character in the string. @@ -2037,7 +2037,7 @@ Tk_ComputeTextLayout( * whitespace set. */ - for (special = start; special < end; special++) { + for (special = start; special < endp; special++) { if (!(flags & TK_IGNORE_NEWLINES)) { if ((*special == '\n') || (*special == '\r')) { break; @@ -2071,7 +2071,7 @@ Tk_ComputeTextLayout( } } - if ((start == special) && (special < end)) { + if ((start == special) && (special < endp)) { /* * Handle the special character. * @@ -2088,7 +2088,7 @@ Tk_ComputeTextLayout( start++; curX = newX; flags &= ~TK_AT_LEAST_ONE; - if ((start < end) && + if ((start < endp) && ((wrapLength <= 0) || (newX <= wrapLength))) { /* * More chars can still fit on this line. @@ -2110,7 +2110,7 @@ Tk_ComputeTextLayout( * Consume all extra spaces at end of line. */ - while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */ + while ((start < endp) && isspace(UCHAR(*start))) { /* INTL: ISO space */ if (!(flags & TK_IGNORE_NEWLINES)) { if ((*start == '\n') || (*start == '\r')) { break; diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 638139a..1cd7a16 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -1623,7 +1623,6 @@ ConfigureMenu( } } else if ((menuListPtr->numEntries > 0) && (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) { - int i; Tcl_EventuallyFree(menuListPtr->entries[0], (Tcl_FreeProc *) DestroyMenuEntry); @@ -1819,7 +1818,6 @@ PostProcessEntry( if ((mePtr->type == CHECK_BUTTON_ENTRY) || (mePtr->type == RADIO_BUTTON_ENTRY)) { Tcl_Obj *valuePtr; - const char *name; if (mePtr->namePtr == NULL) { if (mePtr->labelPtr == NULL) { @@ -2732,7 +2730,7 @@ CloneMenu( && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) { TkMenu *newMenuPtr = menuRefPtr->menuPtr; Tcl_Obj *newObjv[3]; - int i, numElements; + int numElements; /* * Now put this newly created menu into the parent menu's instance diff --git a/generic/tkOldConfig.c b/generic/tkOldConfig.c index d01da95..7bb02b4 100644 --- a/generic/tkOldConfig.c +++ b/generic/tkOldConfig.c @@ -863,8 +863,6 @@ FormatConfigValue( result = buffer; break; case TK_CONFIG_WINDOW: { - Tk_Window tkwin; - tkwin = *((Tk_Window *) ptr); if (tkwin != NULL) { result = Tk_PathName(tkwin); diff --git a/generic/tkPlace.c b/generic/tkPlace.c index 4cff85f..47ceee2 100644 --- a/generic/tkPlace.c +++ b/generic/tkPlace.c @@ -666,10 +666,10 @@ ConfigureContent( goto scheduleLayout; } else if (mask & IN_MASK) { /* -in changed */ - Tk_Window tkwin; + Tk_Window win; Tk_Window ancestor; - tkwin = contentPtr->inTkwin; + win = contentPtr->inTkwin; /* * Make sure that the new container is either the logical parent of the @@ -677,19 +677,19 @@ ConfigureContent( * aren't the same. */ - for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) { + for (ancestor = win; ; ancestor = Tk_Parent(ancestor)) { if (ancestor == Tk_Parent(contentPtr->tkwin)) { break; } if (Tk_TopWinHierarchy(ancestor)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't place %s relative to %s", - Tk_PathName(contentPtr->tkwin), Tk_PathName(tkwin))); + Tk_PathName(contentPtr->tkwin), Tk_PathName(win))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL); goto error; } } - if (contentPtr->tkwin == tkwin) { + if (contentPtr->tkwin == win) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't place %s relative to itself", Tk_PathName(contentPtr->tkwin))); @@ -701,22 +701,22 @@ ConfigureContent( * Check for management loops. */ - for (container = (TkWindow *)tkwin; container != NULL; + for (container = (TkWindow *)win; container != NULL; container = (TkWindow *)TkGetContainer(container)) { if (container == (TkWindow *)contentPtr->tkwin) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't put %s inside %s, would cause management loop", - Tk_PathName(contentPtr->tkwin), Tk_PathName(tkwin))); + Tk_PathName(contentPtr->tkwin), Tk_PathName(win))); Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL); goto error; } } - if (tkwin != Tk_Parent(contentPtr->tkwin)) { - ((TkWindow *)contentPtr->tkwin)->maintainerPtr = (TkWindow *)tkwin; + if (win != Tk_Parent(contentPtr->tkwin)) { + ((TkWindow *)contentPtr->tkwin)->maintainerPtr = (TkWindow *)win; } if ((contentPtr->containerPtr != NULL) - && (contentPtr->containerPtr->tkwin == tkwin)) { + && (contentPtr->containerPtr->tkwin == win)) { /* * Re-using same old container. Nothing to do. */ @@ -729,7 +729,7 @@ ConfigureContent( Tk_UnmaintainGeometry(contentPtr->tkwin, contentPtr->containerPtr->tkwin); } UnlinkContent(contentPtr); - containerWin = tkwin; + containerWin = win; } /* diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 17ba443..00ac7be 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -1133,7 +1133,7 @@ TkMakeEnsemble( dictObj = Tcl_NewObj(); for (i = 0; map[i].name != NULL ; ++i) { - Tcl_Obj *nameObj, *fqdnObj; + Tcl_Obj *fqdnObj; nameObj = Tcl_NewStringObj(map[i].name, -1); fqdnObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), diff --git a/unix/tkUnix.c b/unix/tkUnix.c index c6fff82..2de6e98 100644 --- a/unix/tkUnix.c +++ b/unix/tkUnix.c @@ -16,7 +16,7 @@ # include # ifdef __APPLE__ /* Support for weak-linked libXss. */ -# define HaveXSSLibrary() (XScreenSaverQueryInfo != NULL) +# define HaveXSSLibrary() (&XScreenSaverQueryInfo != NULL) # else /* Other platforms always link libXss. */ # define HaveXSSLibrary() (1) diff --git a/unix/tkUnixKey.c b/unix/tkUnixKey.c index 4e150f7..d55fde0 100644 --- a/unix/tkUnixKey.c +++ b/unix/tkUnixKey.c @@ -12,6 +12,13 @@ #include "tkInt.h" +#ifdef __GNUC__ +/* + * We know that XKeycodeToKeysym is deprecated, nothing we can do about it. + */ +#pragma GCC diagnostic ignored "-Wdeprecated-declarations" +#endif + /* ** Bug [3607830]: Before using Xkb, it must be initialized. TkpOpenDisplay ** does this and sets the USE_XKB flag if xkb is supported. -- cgit v0.12