summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-10-12 06:09:22 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-10-12 06:09:22 (GMT)
commitd132f6a77e1eef979d0c0d3809383546184fcb27 (patch)
tree96b4e2feb35dbe8fe183cac17ce50857d094c967 /tests
parent327ab1ecf903217147e6cbbc0f33f4813ca67f56 (diff)
parentcb3a0ab0484b6747c2055c04530979b75363ca54 (diff)
downloadtk-d132f6a77e1eef979d0c0d3809383546184fcb27.zip
tk-d132f6a77e1eef979d0c0d3809383546184fcb27.tar.gz
tk-d132f6a77e1eef979d0c0d3809383546184fcb27.tar.bz2
Merge trunk
Diffstat (limited to 'tests')
-rw-r--r--tests/all.tcl3
-rw-r--r--tests/bind.test25
-rw-r--r--tests/canvText.test3
-rw-r--r--tests/clipboard.test4
-rw-r--r--tests/entry.test8
-rw-r--r--tests/focus.test9
-rw-r--r--tests/font.test440
-rw-r--r--tests/fontchooser.test5
-rw-r--r--tests/grid.test2
-rw-r--r--tests/image.test6
-rw-r--r--tests/imgPhoto.test11
-rw-r--r--tests/oldpack.test4
-rw-r--r--tests/pack.test7
-rw-r--r--tests/pkgconfig.test4
-rw-r--r--tests/place.test7
-rw-r--r--tests/safe.test5
-rw-r--r--tests/scrollbar.test30
-rw-r--r--tests/select.test15
-rw-r--r--tests/spinbox.test5
-rw-r--r--tests/text.test8
-rw-r--r--tests/textDisp.test31
-rw-r--r--tests/textTag.test9
-rw-r--r--tests/ttk/all.tcl3
-rw-r--r--tests/unixEmbed.test9
-rw-r--r--tests/unixFont.test12
-rw-r--r--tests/unixWm.test13
-rw-r--r--tests/winWm.test15
-rw-r--r--tests/winfo.test3
-rw-r--r--tests/wm.test9
29 files changed, 373 insertions, 332 deletions
diff --git a/tests/all.tcl b/tests/all.tcl
index 3b6b75f..46721a2 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -4,7 +4,7 @@
# tests. Execute it by invoking "source all.tcl" when running tktest
# in this directory.
#
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,4 +17,5 @@ tcltest::configure -loadfile \
[file join [tcltest::testsDirectory] constraints.tcl]
tcltest::configure -singleproc 1
set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)]
+encoding system utf-8
if {[tcltest::runAllTests] && $ErrorOnFailures} {exit 1}
diff --git a/tests/bind.test b/tests/bind.test
index 152fe3e..2685946 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
@@ -5541,13 +5544,13 @@ test bind-26.6 {event names: ButtonPress} -setup {
focus -force .t.f
update
} -body {
- bind .t.f <ButtonPress> "set x {event ButtonPress}"
+ bind .t.f <Button> "set x {event Button}"
set x xyzzy
- event generate .t.f <ButtonPress>
+ event generate .t.f <Button>
list $x [bind .t.f]
} -cleanup {
destroy .t.f
-} -result {{event ButtonPress} <Button>}
+} -result {{event Button} <Button>}
test bind-26.7 {event names: ButtonRelease} -setup {
frame .t.f -class Test -width 150 -height 100
@@ -5639,9 +5642,9 @@ test bind-26.13 {event names: KeyPress} -setup {
focus -force .t.f
update
} -body {
- bind .t.f <KeyPress> "set x {event KeyPress}"
+ bind .t.f <Key> "set x {event KeyPress}"
set x xyzzy
- event generate .t.f <KeyPress>
+ event generate .t.f <Key>
list $x [bind .t.f]
} -cleanup {
destroy .t.f
@@ -6017,7 +6020,7 @@ test bind-28.9 {keysym names, Eth -> ETH} -body {
} -cleanup {
destroy .t.f
} -result {<Key-ETH>}
-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 <Ooblique> foo
bind .t.f
@@ -6764,7 +6767,7 @@ test bind-33.19 {simulate use of the keyboard to trigger a pattern sequence with
set x {}
} -body {
bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" }
- bind .t.f <Escape><KeyPress><KeyPress><Control-c> { lappend x "Esc_Key(2)_Control-c" }
+ bind .t.f <Escape><Key><Key><Control-c> { lappend x "Esc_Key(2)_Control-c" }
event generate .t.f <Escape>
event generate .t.f <Alt_L>
event generate .t.f <Control_L>
@@ -6883,7 +6886,7 @@ proc testKey {window event type mods} {
global keyInfo numericKeysym
set keyInfo {}
set numericKeysym {}
- bind $window <KeyPress> {
+ bind $window <Key> {
set keyInfo [format "%K,0x%%X,0x%%X,%A" %N %k]
set numericKeysym %N
}
@@ -6957,8 +6960,8 @@ test bind-35.1 {Key events agree for entry widgets} -constraints {aqua} -setup {
test bind-35.2 {Can bind to function keys} -constraints {aqua} -body {
global keyInfo numericKeysym
- bind . <KeyPress> {}
- bind . <KeyPress> {
+ bind . <Key> {}
+ bind . <Key> {
lappend keyInfo %K
set numericKeysym %N
}
@@ -6976,7 +6979,7 @@ test bind-35.3 {Events agree for modifier keys} -constraints {aqua} -setup {
} -body {
global keyInfo numericalKeysym
set result {}
- bind . <KeyPress> {
+ bind . <Key> {
set keyInfo [format "%K,0x%%X,0x%%X,%A" %N %k]
set numericalKeysym [format "0x%x" %N]
}
diff --git a/tests/canvText.test b/tests/canvText.test
index cd8660e..02bca47 100644
--- a/tests/canvText.test
+++ b/tests/canvText.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 failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
# Canvas used in 1.* - 17.* tests
canvas .c -width 400 -height 300 -bd 2 -relief sunken
@@ -942,7 +943,7 @@ test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} -setup
destroy .c
} -result {{Yeah } Yeah- 4 4}
-test canvText-20.1 {angled text bounding box} -constraints failsOnUbuntu -setup {
+test canvText-20.1 {angled text bounding box} -constraints {failsOnUbuntu failsOnXQuarz} -setup {
destroy .c
canvas .c
proc transpose {bbox} {
diff --git a/tests/clipboard.test b/tests/clipboard.test
index 81534d5..7c1a506 100644
--- a/tests/clipboard.test
+++ b/tests/clipboard.test
@@ -21,6 +21,8 @@ namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
+
# set up a very large buffer to test INCR retrievals
set longValue ""
foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
@@ -233,7 +235,7 @@ test clipboard-6.1 {Tk_ClipboardAppend procedure} -setup {
} -cleanup {
clipboard clear
} -returnCodes ok -result {first chunk second chunk}
-test clipboard-6.2 {Tk_ClipboardAppend procedure} -constraints x11 -setup {
+test clipboard-6.2 {Tk_ClipboardAppend procedure} -constraints {x11 failsOnXQuarz} -setup {
clipboard clear
} -body {
setupbg
diff --git a/tests/entry.test b/tests/entry.test
index 7ee50dd..6be21e6 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -11,6 +11,10 @@ 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 eq "xft"))}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
+
# For xscrollcommand
set scrollInfo {}
proc scroll args {
@@ -1701,7 +1705,7 @@ test entry-5.7 {ConfigureEntry procedure} -setup {
test entry-5.8 {ConfigureEntry procedure} -constraints {
- fonts
+ fonts failsOnXQuarz
} -setup {
entry .e -borderwidth 2 -highlightthickness 2
pack .e
@@ -2328,7 +2332,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/focus.test b/tests/focus.test
index 20d25eb..f60d120 100644
--- a/tests/focus.test
+++ b/tests/focus.test
@@ -12,6 +12,7 @@ tcltest::loadTestedCommands
namespace import -force tcltest::test
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
proc focusSetup {} {
destroy .t
@@ -310,7 +311,7 @@ in .t.b1 NotifyNonlinear
} .t.b1}
test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} -constraints {
- unix testwrapper failsOnUbuntu
+ unix testwrapper failsOnUbuntu failsOnXQuarz
} -body {
focus .t.b1
focus .
@@ -322,7 +323,7 @@ test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} -constraints {
list $x $focusInfo
} -result {.t.b1 {press .t.b1 x}}
test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} -constraints {
- unix testwrapper failsOnUbuntu
+ unix testwrapper failsOnUbuntu failsOnXQuarz
} -body {
set result {}
foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
@@ -343,7 +344,7 @@ test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} -constraints {
focus
} -result {.t.b1}
test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} -constraints {
- unix testwrapper failsOnUbuntu
+ unix testwrapper failsOnUbuntu failsOnXQuarz
} -body {
focus .t.b1
event gen [testwrapper .] <FocusOut> -detail NotifyAncestor
@@ -601,7 +602,7 @@ cleanupbg
# Test 5.1 fails (before and after update)
test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} -constraints {
- unix testwrapper secureserver failsOnUbuntu
+ unix testwrapper secureserver failsOnUbuntu failsOnXQuarz
} -body {
setupbg
focusSetup
diff --git a/tests/font.test b/tests/font.test
index efa1d7d..df4046e 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -14,6 +14,8 @@ tcltest::loadTestedCommands
# Some tests require support for 4-byte UTF-8 sequences
testConstraint fullutf [expr {[format %c 0x010000] != "\uFFFD"}]
testConstraint utfcompat [expr {([string length "\U10000"] == 2) && [package vsatisfies [package provide Tcl] 8]}]
+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 eq "xft"))}]
set defaultfontlist [font names]
@@ -61,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 {}
@@ -77,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}}
@@ -137,7 +139,7 @@ test font-4.8 {font command: actual: all attributes} -body {
# not (objc > 3) so objPtr = NULL
lindex [font actual {-family times}] 0
} -result {-family}
-test font-4.9 {font command: actual} -constraints {unix noExceed} -body {
+test font-4.9 {font command: actual} -constraints {unix noExceed failsOnUbuntu} -body {
# (objc > 3) so objPtr = objv[3 + skip]
string tolower [font actual {-family times} -family]
} -result {times}
@@ -194,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
@@ -202,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}
@@ -215,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}
@@ -223,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}
@@ -243,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
@@ -285,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 {
@@ -294,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
@@ -310,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
@@ -343,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
@@ -357,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
@@ -383,7 +385,7 @@ test font-8.3 {font command: families: arguments} -body {
# (objc - skip != 2) when skip == 2
font families -displayof . xyz
} -returnCodes error -result {wrong # args: should be "font families ?-displayof window?"}
-test font-8.4 {font command: families} -body {
+test font-8.4 {font command: families} -constraints failsOnUbuntu -body {
# TkpGetFontFamilies()
regexp -nocase times [font families]
} -result 1
@@ -515,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
@@ -534,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}
@@ -557,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}
@@ -566,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
@@ -581,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}
@@ -591,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 {
@@ -604,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 {}
@@ -619,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 {}
@@ -642,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
@@ -654,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 {
@@ -665,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
@@ -709,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"
@@ -718,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
@@ -729,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 {}
@@ -741,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}
@@ -927,7 +929,7 @@ test font-21.5 {Tk_PostscriptFontName procedure: spaces} -constraints {
}
} -result {LucidaBright}
test font-21.6 {Tk_PostscriptFontName procedure: spaces} -constraints {
- x11
+ x11 failsOnUbuntu
} -body {
psfontname "{new century schoolbook} 10"
} -result {NewCenturySchlbk-Roman}
@@ -1449,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
@@ -1470,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 {}
@@ -1487,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}
@@ -1516,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
@@ -1543,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
@@ -1557,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
@@ -1571,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
@@ -1620,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}
@@ -1632,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 {}
@@ -1649,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"
@@ -1794,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 <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x 0 -y 0
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result 0
test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body {
csetup "000\n000\n000"
- .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x $ax -y $ay
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result 5
test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} -body {
csetup "000\n0\n000"
- .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x [expr $ax*2] -y $ay
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result {}
test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} -body {
csetup "000\t000\n000"
- .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x [expr $ax*6] -y 0
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result 3
test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} -body {
csetup "000\n0\n000"
- .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x [expr $ax*2] -y $ay
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -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 <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x [expr $ax*5] -y $ay
.t.c itemconfig text -width 0
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -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 <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x 0 -y 0
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result {}
test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} -body {
csetup "0\n000"
- .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x [expr $ax*2] -y 0
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result {}
test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} -body {
csetup "0\n000"
- .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x $ax -y 0
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result 0
test font-30.10 {Tk_DistanceToTextLayout procedure: above line} -body {
csetup "0\n000"
- .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x 0 -y 0
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result {}
test font-30.11 {Tk_DistanceToTextLayout procedure: below line} -body {
csetup "000\n0"
- .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x 0 -y $ay
@@ -1907,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 <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x $ax -y $ay
@@ -1918,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 <Enter> {lappend x [.t.c index current @%x,%y]}
+ .t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
set x {}
event generate .t.c <Leave>
event generate .t.c <Enter> -x $ax -y 0
return $x
} -cleanup {
- bind all <Enter> {}
+ bind all <Enter> {}
} -result 1
destroy .t.c
@@ -1976,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.
@@ -1993,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)]
[()]
@@ -2051,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"}
@@ -2140,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}
@@ -2151,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}
@@ -2164,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
@@ -2256,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}
@@ -2338,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
@@ -2374,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 97ca859..a9f914d 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 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
# 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/grid.test b/tests/grid.test
index 7f66e0d..b033311 100644
--- a/tests/grid.test
+++ b/tests/grid.test
@@ -45,7 +45,7 @@ test grid-1.1 {basic argument checking} -body {
} -returnCodes error -result {wrong # args: should be "grid option arg ?arg ...?"}
test grid-1.2 {basic argument checking} -body {
grid foo bar
-} -returnCodes error -match glob -result {bad option "foo": must be anchor, bbox, columnconfigure, configure, content, forget, info, location, propagate, remove, rowconfigure, *size*}
+} -returnCodes error -result {bad option "foo": must be anchor, bbox, columnconfigure, configure, content, forget, info, location, propagate, remove, rowconfigure, or size}
test grid-1.3 {basic argument checking} -body {
button .b
grid .b -row 0 -column
diff --git a/tests/image.test b/tests/image.test
index 7eaa404..2203b6a 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -313,11 +313,9 @@ test image-6.1 {Tk_ImageCmd procedure, "types" option} -constraints {
} -body {
image types x
} -returnCodes error -result {wrong # args: should be "image types"}
-test image-6.2 {Tk_ImageCmd procedure, "types" option} -constraints {
- testOldImageType
-} -body {
+test image-6.2 {Tk_ImageCmd procedure, "types" option} -body {
lsort [image types]
-} -result {bitmap oldtest photo test}
+} -match glob -result {bitmap*photo test}
test image-7.1 {Tk_ImageCmd procedure, "width" option} -body {
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index c4b4755..2e7ca4c 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -129,7 +129,9 @@ testConstraint hasTeapotPhoto [file exists $teapotPhotoFile]
# let's see if we have the semi-transparent one as well
set transpTeapotPhotoFile [file join [file dirname [info script]] teapotTransparent.png]
testConstraint hasTranspTeapotPhoto [file exists $transpTeapotPhotoFile]
-
+testConstraint needsTcl867 [package vsatisfies [package provide Tcl] 8.6.7-]
+
+
test imgPhoto-1.1 {options for photo images} -body {
image create photo photo1 -width 79 -height 83
list [photo1 cget -width] [photo1 cget -height] \
@@ -264,8 +266,9 @@ test imgPhoto-3.4 {ImgPhotoConfigureModel: -data <ppm>} -constraints {
} -cleanup {
imageCleanup
} -result {20 20}
+# This testcase fails with Tcl < 8.6.7, due to [25842c]
test imgPhoto-3.5 {ImgPhotoConfigureModel: -data <png>} -constraints {
- hasTeapotPhoto
+ hasTeapotPhoto needsTcl867
} -setup {
image create photo photo1 -file $teapotPhotoFile
image create photo photo2
@@ -1332,10 +1335,10 @@ test imgPhoto-4.117 {ImgPhotoCmd data: list colorformat} -setup {
} -body {
photo1 data -format {default -colorformat list}
} -result {{{255 0 0 170} {0 128 0 255}} {{0 0 255 204} {255 255 255 221}}}
+# This testcase fails with Tcl < 8.6.7, due to [25842c]
test imgPhoto-4.118 {ImgPhotoCmd data: using data for new image
results in same image as orignial } -constraints {
- hasTeapotPhoto
- hasTranspTeapotPhoto
+ hasTeapotPhoto hasTranspTeapotPhoto needsTcl867
} -setup {
image create photo teapot -file $teapotPhotoFile
teapot copy teapot -from 50 60 70 80 -shrink
diff --git a/tests/oldpack.test b/tests/oldpack.test
index 35fd0f6..c3676ec 100644
--- a/tests/oldpack.test
+++ b/tests/oldpack.test
@@ -457,10 +457,10 @@ test oldpack-8.2 {syntax errors} -body {
} -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"}
test oldpack-8.3 {syntax errors} -body {
pack gorp foo
-} -returnCodes error -match glob -result {bad option "gorp": must be configure, content, forget, info, *propagate*}
+} -returnCodes error -result {bad option "gorp": must be configure, content, forget, info, or propagate}
test oldpack-8.4 {syntax errors} -body {
pack a .pack
-} -returnCodes error -match glob -result {bad option "a": must be configure, content, forget, info, *propagate*}
+} -returnCodes error -result {bad option "a": must be configure, content, forget, info, or propagate}
test oldpack-8.5 {syntax errors} -body {
pack after foobar
} -returnCodes error -result {bad window path name "foobar"}
diff --git a/tests/pack.test b/tests/pack.test
index 02008c7..ba50d78 100644
--- a/tests/pack.test
+++ b/tests/pack.test
@@ -12,6 +12,7 @@ tcltest::loadTestedCommands
namespace import -force tcltest::test
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
# Create some test windows.
@@ -1361,7 +1362,7 @@ test pack-12.46 {command options and errors} -setup {
pack forget .pack.a .pack.b .pack.c .pack.d
} -body {
pack lousy .pack
-} -returnCodes error -match glob -result {bad option "lousy": must be configure, content, forget, info, *propagate*}
+} -returnCodes error -result {bad option "lousy": must be configure, content, forget, info, or propagate}
test pack-13.1 {window deletion} -setup {
pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom
@@ -1543,7 +1544,7 @@ if {[tk windowingsystem] == "win32"} {
}
test pack-18.1 {unmap content when container unmapped} -constraints {
- tempNotPc failsOnUbuntu
+ tempNotPc failsOnUbuntu failsOnXQuarz
} -setup {
eval destroy [winfo child .pack]
} -body {
@@ -1573,7 +1574,7 @@ test pack-18.1 {unmap content when container unmapped} -constraints {
lappend result [winfo ismapped .pack.a]
} -result {1 0 200 75 0 1}
-test pack-18.2 {unmap content when container unmapped} -constraints failsOnUbuntu -setup {
+test pack-18.2 {unmap content when container unmapped} -constraints {failsOnUbuntu failsOnXQuarz} -setup {
eval destroy [winfo child .pack]
} -body {
# adjust the position of .pack before test to avoid a screen switch
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/place.test b/tests/place.test
index 3ef1de7..4bf9689 100644
--- a/tests/place.test
+++ b/tests/place.test
@@ -14,6 +14,7 @@ tcltest::loadTestedCommands
testConstraint memory [llength [info commands memory]]
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
# XXX - This test file is woefully incomplete. At present, only a
# few of the features are tested.
@@ -269,7 +270,7 @@ if {[tk windowingsystem] == "win32"} {
}
}
-test place-8.1 {PlaceStructureProc, mapping and unmapping content} -constraints failsOnUbuntu -setup {
+test place-8.1 {PlaceStructureProc, mapping and unmapping content} -constraints {failsOnUbuntu failsOnXQuarz} -setup {
place forget .t.f2
place forget .t.f
} -body {
@@ -285,7 +286,7 @@ test place-8.1 {PlaceStructureProc, mapping and unmapping content} -constraints
placeUpdate
lappend result [winfo ismapped .t.f2]
} -result {1 0 40 30 0 1}
-test place-8.2 {PlaceStructureProc, mapping and unmapping content} -constraints failsOnUbuntu -setup {
+test place-8.2 {PlaceStructureProc, mapping and unmapping content} -constraints {failsOnUbuntu failsOnXQuarz} -setup {
place forget .t.f2
place forget .t.f
update idletasks
@@ -331,7 +332,7 @@ test place-9.5 {PlaceObjCmd} -setup {
place badopt .foo
} -cleanup {
destroy .foo
-} -returnCodes error -match glob -result {bad option "badopt": must be configure, content, forget, *info*}
+} -returnCodes error -result {bad option "badopt": must be configure, content, forget, or info}
test place-9.6 {PlaceObjCmd, configure errors} -setup {
destroy .foo
} -body {
diff --git a/tests/safe.test b/tests/safe.test
index 5a2cd26..31cb1b7 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 {
diff --git a/tests/scrollbar.test b/tests/scrollbar.test
index 20ac275..6601099 100644
--- a/tests/scrollbar.test
+++ b/tests/scrollbar.test
@@ -12,6 +12,8 @@ eval tcltest::configure $argv
tcltest::loadTestedCommands
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
+testConstraint nodeprecated [expr {"nodeprecated" ni [tk::pkgconfig list]}]
proc scroll args {
global scrollInfo
@@ -272,13 +274,13 @@ test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} {
format {%.6g} [.s fraction 4 21]
} [format %.6g [expr {(21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \
/([getTroughSize .s] - 1)}]]
-test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} {x11 failsOnUbuntu} {
+test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} {x11 failsOnUbuntu failsOnXQuarz} {
format {%.6g} [.s fraction 4 179]
} 1
test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} {
format {%.6g} [.s fraction 4 [expr {200 - [testmetrics cyvscroll .s]}]]
} 1
-test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} {x11 failsOnUbuntu} {
+test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} {x11 failsOnUbuntu failsOnXQuarz} {
format {%.6g} [.s fraction 4 178]
} {0.993711}
test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics win} {
@@ -316,7 +318,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 +403,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}
@@ -493,7 +495,7 @@ test scrollbar-6.11.2 {ScrollbarPosition procedure} aqua {
# macOS scrollbars have no arrows nowadays
.s identify 8 4
} {trough1}
-test scrollbar-6.12.1 {ScrollbarPosition procedure} {x11 failsOnUbuntu} {
+test scrollbar-6.12.1 {ScrollbarPosition procedure} {x11 failsOnUbuntu failsOnXQuarz} {
.s identify 8 19
} {arrow1}
test scrollbar-6.12.2 {ScrollbarPosition procedure} aqua {
@@ -551,7 +553,7 @@ test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics win} {
.s identify [expr {[winfo width .s] / 2}] [expr {[winfo height .s]
- [testmetrics cyvscroll .s] - 1}]
} {trough2}
-test scrollbar-6.29.1 {ScrollbarPosition procedure} {x11 failsOnUbuntu} {
+test scrollbar-6.29.1 {ScrollbarPosition procedure} {x11 failsOnUbuntu failsOnXQuarz} {
.s identify 8 180
} {arrow2}
test scrollbar-6.29.2 {ScrollbarPosition procedure} aqua {
@@ -575,7 +577,7 @@ test scrollbar-6.33 {ScrollbarPosition procedure} win {
test scrollbar-6.34 {ScrollbarPosition procedure} unix {
.s identify 4 100
} {trough2}
-test scrollbar-6.35 {ScrollbarPosition procedure} {unix failsOnUbuntu} {
+test scrollbar-6.35 {ScrollbarPosition procedure} {unix failsOnUbuntu failsOnXQuarz} {
.s identify 18 100
} {trough2}
test scrollbar-6.37 {ScrollbarPosition procedure} win {
@@ -614,7 +616,7 @@ test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics win} {
.t.s identify [expr {int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s]
- 1}] [expr {[winfo height .t.s] / 2}]
} {slider}
-test scrollbar-6.44 {ScrollbarPosition procedure} {unix failsOnUbuntu} {
+test scrollbar-6.44 {ScrollbarPosition procedure} {unix failsOnUbuntu failsOnXQuarz} {
.t.s identify 100 18
} {trough2}
test scrollbar-6.46 {ScrollbarPosition procedure} win {
diff --git a/tests/select.test b/tests/select.test
index 9146397..31d6494 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -23,6 +23,7 @@ if {![catch {selection get -selection CLIPBOARD_MANAGER -type TARGETS}]} {
testConstraint cliboardManagerPresent 1
}
}
+testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
global longValue selValue selInfo
@@ -895,7 +896,7 @@ test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup {
test select-9.2 {SelCvtToX and SelCvtFromX procedures} -setup {
setup
setupbg
-} -constraints x11 -body {
+} -constraints {x11 failsOnUbuntu} -body {
set selValue "1024 0xffff 2048 -2 "
set selInfo ""
selection handle -selection PRIMARY -format INTEGER -type TEST \
@@ -908,7 +909,7 @@ test select-9.2 {SelCvtToX and SelCvtFromX procedures} -setup {
test select-9.3 {SelCvtToX and SelCvtFromX procedures} -setup {
setup
setupbg
-} -constraints x11 -body {
+} -constraints {x11 failsOnUbuntu} -body {
set selValue " "
set selInfo ""
selection handle -selection PRIMARY -format INTEGER -type TEST \
@@ -921,7 +922,7 @@ test select-9.3 {SelCvtToX and SelCvtFromX procedures} -setup {
test select-9.4 {SelCvtToX and SelCvtFromX procedures} -setup {
setup
setupbg
-} -constraints x11 -body {
+} -constraints {x11 failsOnUbuntu} -body {
set selValue "16 foobar 32"
set selInfo ""
selection handle -selection PRIMARY -format INTEGER -type TEST \
@@ -1006,7 +1007,7 @@ test select-10.3 {ConvertSelection procedure} -constraints x11 -setup {
# testing timers
# This one hangs in Exceed
test select-10.4 {ConvertSelection procedure} -constraints {
- x11 noExceed
+ x11 noExceed failsOnUbuntu
} -setup {
setup
setupbg
@@ -1021,7 +1022,7 @@ test select-10.4 {ConvertSelection procedure} -constraints {
lappend result $selInfo
} -result {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}}
test select-10.5 {ConvertSelection procedure, reentrancy issues} -constraints {
- x11
+ x11 failsOnUbuntu
} -setup {
setup
setupbg
@@ -1036,7 +1037,7 @@ test select-10.5 {ConvertSelection procedure, reentrancy issues} -constraints {
lappend result $selInfo
} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}}
test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints {
- x11
+ x11 failsOnUbuntu
} -setup {
setup
setupbg
@@ -1059,7 +1060,7 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints {
##############################################################################
# testing reentrancy
-test select-11.1 {TkSelPropProc procedure} -constraints x11 -setup {
+test select-11.1 {TkSelPropProc procedure} -constraints {x11 failsOnUbuntu} -setup {
setup
setupbg
} -body {
diff --git a/tests/spinbox.test b/tests/spinbox.test
index 88294b2..b858988 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 eq "xft"))}]
+
# For xscrollcommand
set scrollInfo {}
proc scroll args {
@@ -2618,7 +2621,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/text.test b/tests/text.test
index d830dc2..df2769e 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -5078,11 +5078,11 @@ test text-22.132 {TextSearchCmd, multiline regexp matching} -body {
void
Tcl_SetObjLength(objPtr, length)
- register Tcl_Obj *objPtr; /* Pointer to object. This object must
- * not currently be shared. */
- register int length; /* Number of bytes desired for string
+ Tcl_Obj *objPtr; /* Pointer to object. This object must
+ * not currently be shared. */
+ int length; /* Number of bytes desired for string
* representation of object, not including
- * terminating null byte. */
+ * terminating null byte. */
\{
char *new;
}
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 4b6535d..69c53b2 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -12,6 +12,7 @@ tcltest::loadTestedCommands
namespace import -force tcltest::test
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
# Platform specific procedure for updating the text widget.
@@ -111,8 +112,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
@@ -675,7 +674,7 @@ test textDisp-4.7 {UpdateDisplayInfo, filling in extra vertical space} {
updateText
set x
} {8.0 {16.0 17.0 15.0 14.0 13.0 12.0 11.0 10.0 9.0 8.0} {8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0 16.0 17.0}}
-test textDisp-4.8 {UpdateDisplayInfo, filling in extra vertical space} {
+test textDisp-4.8 {UpdateDisplayInfo, filling in extra vertical space} failsOnXQuarz {
.t delete 1.0 end
.t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17"
.t yview 16.0
@@ -738,7 +737,7 @@ test textDisp-4.13 {UpdateDisplayInfo, special handling for top/bottom lines} {
updateText
list $tk_textRelayout $tk_textRedraw
} {{11.0 12.0 13.0} {4.0 10.0 11.0 12.0 13.0}}
-test textDisp-4.14 {UpdateDisplayInfo, special handling for top/bottom lines} {
+test textDisp-4.14 {UpdateDisplayInfo, special handling for top/bottom lines} failsOnXQuarz {
.t tag remove x 1.0 end
.t yview 1.0
updateText
@@ -871,7 +870,7 @@ test textDisp-5.2 {DisplayDLine, line resizes during display} {
} [list 30 30]
.t configure -wrap char
-test textDisp-6.1 {scrolling in DisplayText, scroll up} {
+test textDisp-6.1 {scrolling in DisplayText, scroll up} failsOnXQuarz {
.t delete 1.0 end
.t insert 1.0 "Line 1"
foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
@@ -1159,7 +1158,7 @@ test textDisp-8.6 {TkTextChanged} {
updateText
list $tk_textRelayout $tk_textRedraw
} {{1.0 1.20 1.40} {1.0 1.20 1.40}}
-test textDisp-8.7 {TkTextChanged} {
+test textDisp-8.7 {TkTextChanged} failsOnXQuarz {
.t delete 1.0 end
.t insert 1.0 "Line 1 is so long that it wraps around, two times"
foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
@@ -1181,7 +1180,7 @@ test textDisp-8.8 {TkTextChanged} {
updateText
list $tk_textRelayout $tk_textRedraw
} {2.0 2.0}
-test textDisp-8.9 {TkTextChanged} {
+test textDisp-8.9 {TkTextChanged} failsOnXQuarz {
.t delete 1.0 end
.t insert 1.0 "Line 1 is so long that it wraps around, two times"
foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
@@ -1292,7 +1291,7 @@ test textDisp-9.4 {TkTextRedrawTag} failsOnUbuntu {
updateText
list $tk_textRelayout $tk_textRedraw
} {{2.0 2.20} {2.0 2.20 eof}}
-test textDisp-9.5 {TkTextRedrawTag} failsOnUbuntu {
+test textDisp-9.5 {TkTextRedrawTag} {failsOnUbuntu failsOnXQuarz} {
.t configure -wrap char
.t delete 1.0 end
.t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4"
@@ -1454,7 +1453,7 @@ test textDisp-11.1 {TkTextSetYView} {
updateText
.t index @0,0
} {30.0}
-test textDisp-11.2 {TkTextSetYView} {
+test textDisp-11.2 {TkTextSetYView} failsOnXQuarz {
.t yview 30.0
updateText
.t yview 32.0
@@ -1468,7 +1467,7 @@ test textDisp-11.3 {TkTextSetYView} {
updateText
list [.t index @0,0] $tk_textRedraw
} {28.0 {28.0 29.0}}
-test textDisp-11.4 {TkTextSetYView} {
+test textDisp-11.4 {TkTextSetYView} failsOnXQuarz {
.t yview 30.0
updateText
.t yview 31.4
@@ -1499,7 +1498,7 @@ test textDisp-11.7 {TkTextSetYView} {
updateText
list [.t index @0,0] $tk_textRedraw
} {21.0 {21.0 22.0 23.0 24.0 25.0 26.0 27.0 28.0 29.0}}
-test textDisp-11.8 {TkTextSetYView} {
+test textDisp-11.8 {TkTextSetYView} failsOnXQuarz {
.t yview 30.0
updateText
set tk_textRedraw {}
@@ -1507,7 +1506,7 @@ test textDisp-11.8 {TkTextSetYView} {
updateText
list [.t index @0,0] $tk_textRedraw
} {32.0 {40.0 41.0}}
-test textDisp-11.9 {TkTextSetYView} {
+test textDisp-11.9 {TkTextSetYView} failsOnXQuarz {
.t yview 30.0
updateText
set tk_textRedraw {}
@@ -1531,7 +1530,7 @@ test textDisp-11.11 {TkTextSetYView} {
updateText
list [.t index @0,0] $tk_textRedraw
} {191.0 {191.0 192.0 193.0 194.0 195.0 196.0}}
-test textDisp-11.12 {TkTextSetYView, wrapped line is off-screen} {
+test textDisp-11.12 {TkTextSetYView, wrapped line is off-screen} failsOnXQuarz {
.t insert 10.0 "Long line with enough text to wrap\n"
.t yview 1.0
updateText
@@ -2871,7 +2870,7 @@ test textDisp-19.16 {count -ypixels} {
[.t count -ypixels 16.0 "16.0 displaylineend +1c"] \
[.t count -ypixels "16.0 +1 displaylines" "16.0 +4 displaylines +3c"]
} [list [expr {260 + 20 * $fixedDiff}] [expr {260 + 20 * $fixedDiff}] $fixedHeight [expr {2*$fixedHeight}] $fixedHeight [expr {3*$fixedHeight}]]
-test textDisp-19.17 {count -ypixels with indices in elided lines} failsOnUbuntu {
+test textDisp-19.17 {count -ypixels with indices in elided lines} {failsOnUbuntu failsOnXQuarz} {
.t configure -wrap none
.t delete 1.0 end
for {set i 1} {$i < 100} {incr i} {
@@ -2898,7 +2897,7 @@ test textDisp-19.17 {count -ypixels with indices in elided lines} failsOnUbuntu
.t yview 35.0
lappend res [.t count -ypixels 5.0 25.0]
} [list [expr {4 * $fixedHeight}] [expr {3 * $fixedHeight}] 0 0 0 0 0 0 [expr {5 * $fixedHeight}] [expr {- 5 * $fixedHeight}] [expr {2 * $fixedHeight}] [expr {3 * $fixedHeight}] [expr {5 * $fixedHeight}]]
-test textDisp-19.18 {count -ypixels with indices in elided lines} failsOnUbuntu {
+test textDisp-19.18 {count -ypixels with indices in elided lines} {failsOnUbuntu failsOnXQuarz} {
.t configure -wrap none
.t delete 1.0 end
for {set i 1} {$i < 100} {incr i} {
@@ -3415,7 +3414,7 @@ test textDisp-24.24 {TkTextCharLayoutProc, justification and tabs} {textfonts} {
.t tag add x 1.0 end
list [.t bbox 1.0] [.t bbox 1.10]
} [list [list 45 3 7 $fixedHeight] [list 94 3 7 $fixedHeight]]
-test textDisp-24.25 {TkTextCharLayoutProc, justification and tabs} -constraints {textfonts} -setup {
+test textDisp-24.25 {TkTextCharLayoutProc, justification and tabs} -constraints {textfonts failsOnXQuarz} -setup {
text .tt -tabs {40 right} -wrap none -font $fixedFont
pack .tt
} -body {
diff --git a/tests/textTag.test b/tests/textTag.test
index 94db751..e923611 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -26,6 +26,9 @@ testConstraint haveFontSizes [expr {
[font actual $bigFont -size] == 24 }
]
+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 eq "xft"))}]
+
destroy .t
text .t -width 20 -height 10
@@ -1342,7 +1345,7 @@ test textTag-16.1 {TkTextPickCurrent procedure} -setup {
} -result {2.1 3.2 3.2 3.2 3.2 3.2 4.3}
test textTag-16.2 {TkTextPickCurrent procedure} -constraints {
- haveFontSizes
+ haveFontSizes failsOnUbuntuNoXft
} -setup {
.t tag delete {*}[.t tag names]
wm geometry . +200+200 ; update
@@ -1438,7 +1441,7 @@ test textTag-16.5 {TkTextPickCurrent procedure} -constraints {
} -result {3.2}
test textTag-16.6 {TkTextPickCurrent procedure} -constraints {
- haveFontSizes
+ haveFontSizes failsOnUbuntuNoXft
} -setup {
foreach i {big a b c d} {
.t tag remove $i 1.0 end
@@ -1460,7 +1463,7 @@ test textTag-16.6 {TkTextPickCurrent procedure} -constraints {
} -result {3.1}
test textTag-16.7 {TkTextPickCurrent procedure} -constraints {
- haveFontSizes
+ haveFontSizes failsOnUbuntuNoXft
} -setup {
foreach i {big a b c d} {
.t tag remove $i 1.0 end
diff --git a/tests/ttk/all.tcl b/tests/ttk/all.tcl
index a75172f..8a75ba7 100644
--- a/tests/ttk/all.tcl
+++ b/tests/ttk/all.tcl
@@ -4,7 +4,7 @@
# tests. Execute it by invoking "source all.tcl" when running tktest
# in this directory.
#
-# Copyright (c) 2007 by the Tk developers.
+# Copyright © 2007 by the Tk developers.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,4 +17,5 @@ tcltest::configure -loadfile \
[file join [file dirname [tcltest::testsDirectory]] constraints.tcl]
tcltest::configure -singleproc 1
set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)]
+encoding system utf-8
if {[tcltest::runAllTests] && $ErrorOnFailures} {exit 1}
diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test
index 5d00ccf..151ecf2 100644
--- a/tests/unixEmbed.test
+++ b/tests/unixEmbed.test
@@ -12,6 +12,7 @@ tcltest::loadTestedCommands
namespace import -force tcltest::test
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
namespace eval ::_test_tmp {}
@@ -990,7 +991,7 @@ test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} -constrain
# TkpRedirectKeyEvent is not implemented in win or aqua. If someone
# implements it they should change the constraints for this test.
test unixEmbed-7.1a {TkpRedirectKeyEvent procedure, forward keystroke} -constraints {
- unix notAqua
+ unix notAqua failsOnXQuarz
} -setup {
deleteWindows
catch {interp delete child}
@@ -1088,7 +1089,7 @@ test unixEmbed-7.2a {TkpRedirectKeyEvent procedure, don't forward keystroke widt
} -result {{} {{key b}}}
test unixEmbed-8.1 {TkpClaimFocus procedure} -constraints {
- unix notAqua failsOnUbuntu
+ unix notAqua failsOnUbuntu failsOnXQuarz
} -setup {
deleteWindows
} -body {
@@ -1235,7 +1236,7 @@ test unixEmbed-9.2a {EmbedWindowDeleted procedure, check embeddedPtr} -constrain
test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -constraints {
- unix failsOnUbuntu
+ unix failsOnUbuntu failsOnXQuarz
} -setup {
deleteWindows
} -body {
@@ -1251,7 +1252,7 @@ test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -con
deleteWindows
} -result {150x80+0+0}
test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -constraints {
- unix failsOnUbuntu
+ unix failsOnUbuntu failsOnXQuarz
} -setup {
deleteWindows
} -body {
diff --git a/tests/unixFont.test b/tests/unixFont.test
index 524191d..dacfd03 100644
--- a/tests/unixFont.test
+++ b/tests/unixFont.test
@@ -17,6 +17,8 @@ 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 eq "xft"))}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
if {[tk windowingsystem] eq "x11"} {
set xlsf [auto_execok xlsfonts]
@@ -116,7 +118,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 {
@@ -255,7 +257,7 @@ test unixfont-8.3 {AllocFont procedure: can't parse info from name} x11 {
catch {unset fontArray}
set result
} {-family -overstrike -size -slant -underline -weight}
-test unixfont-8.4 {AllocFont procedure: classify characters} {x11 failsOnUbuntu} {
+test unixfont-8.4 {AllocFont procedure: classify characters} {x11 failsOnUbuntu failsOnXQuarz} {
set x 0
incr x [font measure $courier "\u4000"] ;# 6
incr x [font measure $courier "\002"] ;# 4
@@ -266,7 +268,7 @@ test unixfont-8.4 {AllocFont procedure: classify characters} {x11 failsOnUbuntu}
test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} x11 {
font metrics $courier -fixed
} 1
-test unixfont-8.6 {AllocFont procedure: setup widths of special chars} {x11 failsOnUbuntu} {
+test unixfont-8.6 {AllocFont procedure: setup widths of special chars} {x11 failsOnUbuntu failsOnXQuarz} {
set x 0
incr x [font measure $courier "\001"] ;# 4
incr x [font measure $courier "\002"] ;# 4
@@ -294,7 +296,7 @@ test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} x11 {
set x {}
} {}
-test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} {x11 failsOnUbuntu} {
+test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} {x11 failsOnUbuntu failsOnXQuarz} {
.b.c dchars $t 0 end
.b.c insert $t 0 "0\a0"
set x {}
@@ -303,7 +305,7 @@ test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} {x11 failsOnUbu
lappend x [.b.c index $t @[expr $ax*2],0]
lappend x [.b.c index $t @[expr $ax*3],0]
} {0 1 1 2}
-test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {x11 failsOnUbuntu} {
+test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {x11 failsOnUbuntu failsOnXQuarz} {
.b.c dchars $t 0 end
.b.c insert $t 0 "0\0010"
set x {}
diff --git a/tests/unixWm.test b/tests/unixWm.test
index b2b91b7..028c5be 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -14,6 +14,7 @@ tcltest::loadTestedCommands
namespace import -force ::tk::test:loadTkCommand
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
proc sleep ms {
global x
@@ -1552,7 +1553,7 @@ test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} unix {
} {100 1}
destroy .t
toplevel .t -width 80 -height 60
-test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} unix {
+test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {unix failsOnXQuarz} {
tkwait visibility .t
wm overrideredirect .t 1
update
@@ -1562,7 +1563,7 @@ test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} unix {
} [list 5 [expr [winfo screenheight .t] - 70]]
destroy .t
toplevel .t -width 80 -height 60
-test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} unix {
+test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {unix failsOnXQuarz} {
tkwait visibility .t
wm overrideredirect .t 1
update
@@ -1612,7 +1613,7 @@ test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unix testwrapper
[expr [lindex $property 7]] [expr [lindex $property 8]] \
[expr [lindex $property 9]] [expr [lindex $property 10]]
} {40 30 320 210 10 5}
-test unixWm-45.2 {UpdateSizeHints procedure} {unix testwrapper failsOnUbuntu} {
+test unixWm-45.2 {UpdateSizeHints procedure} {unix testwrapper failsOnUbuntu failsOnXQuarz} {
destroy .t
toplevel .t -width 80 -height 60
wm minsize .t 30 40
@@ -1640,7 +1641,7 @@ test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} {testmenubar testwr
[expr [lindex $property 7]] [expr [lindex $property 8]] \
[expr [lindex $property 9]] [expr [lindex $property 10]]
} {60 40 53 320 233 10 5}
-test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {testmenubar testwrapper failsOnUbuntu} {
+test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {testmenubar testwrapper failsOnUbuntu failsOnXQuarz} {
destroy .t
toplevel .t -width 80 -height 60
frame .t.menu -height 23 -width 50
@@ -1794,7 +1795,7 @@ if {[tk windowingsystem] == "aqua"} {
# Windows are assumed to have a border (invisible in Gnome 3).
set result_50_1 {{} {} .t {} .t2 {} .t2 {} .t}
}
-test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords, title bar} {unix failsOnUbuntu} {
+test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords, title bar} {unix failsOnUbuntu failsOnXQuarz} {
update
toplevel .t -width 300 -height 400 -bg green
wm geom .t +100+100
@@ -2051,7 +2052,7 @@ test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapp
wm geometry .t2 +0+0
winfo containing 100 100
} {.t}
-test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} unix {
+test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} {unix failsOnXQuarz} {
foreach w {.t .t2 .t3} {
destroy $w
update
diff --git a/tests/winWm.test b/tests/winWm.test
index 705e355..baf8e3d 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -14,6 +14,7 @@ namespace import ::tcltest::*
tcltest::configure {*}$argv
tcltest::loadTestedCommands
+testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
test winWm-1.1 {TkWmMapWindow} -constraints win -setup {
destroy .t
@@ -485,7 +486,7 @@ test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constrai
rename winwm90$cmd {}
}
destroy .tx .t .sd
-} -result {ok}
+} -result ok
test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win -setup {
proc winwm91click {w} {
@@ -530,9 +531,9 @@ test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win
rename winwm91$cmd {}
}
destroy .tx .t .sd
-} -result {ok}
+} -result ok
-test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup {
+test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -constraints failsOnUbuntu -setup {
destroy .t
toplevel .t
set winwm92 {}
@@ -541,15 +542,15 @@ test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup
} -body {
pack .t.f.x
pack .t.f
- lappend aid [after 2000 {set ::winwm92 timeout}] [after 100 {
+ lappend aid [after 5000 {set ::winwm92 timeout}] [after 500 {
wm manage .t.f
wm iconify .t
- lappend aid [after 100 {
+ lappend aid [after 500 {
wm forget .t.f
wm deiconify .t
- lappend aid [after 100 {
+ lappend aid [after 500 {
pack .t.f
- lappend aid [after 100 {
+ lappend aid [after 500 {
set ::winwm92 [expr {
[winfo rooty .t.f.x] == 0 ? "failed" : "ok"}]}]
}]
diff --git a/tests/winfo.test b/tests/winfo.test
index 13193ef..a247346 100644
--- a/tests/winfo.test
+++ b/tests/winfo.test
@@ -12,6 +12,7 @@ tcltest::configure {*}$argv
tcltest::loadTestedCommands
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
# eatColors --
# Creates a toplevel window and allocates enough colors in it to
@@ -322,7 +323,7 @@ test winfo-9.6 {"winfo viewable" command} -setup {
} -cleanup {
deleteWindows
} -result {0 0}
-test winfo-9.7 {"winfo viewable" command} -constraints failsOnUbuntu -setup {
+test winfo-9.7 {"winfo viewable" command} -constraints {failsOnUbuntu failsOnXQuarz} -setup {
deleteWindows
} -body {
frame .f1 -width 100 -height 100 -relief raised -bd 2
diff --git a/tests/wm.test b/tests/wm.test
index d5bc733..c1e6cba 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -28,6 +28,7 @@ proc stdWindow {} {
}
testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
+testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }]
# [raise] and [lower] may return before the window manager has completed the
# operation. The raiseDelay procedure idles for a while to give the operation
@@ -1527,7 +1528,7 @@ test wm-stackorder-5.1 {a menu is not a toplevel} -body {
destroy .t
} -result {.t .}
test wm-stackorder-5.2 {A normal toplevel can't be raised above an \
- overrideredirect toplevel on unix} -constraints {x11 failsOnUbuntu} -body {
+ overrideredirect toplevel on unix} -constraints {x11 failsOnUbuntu failsOnXQuarz} -body {
toplevel .t
tkwait visibility .t
wm overrideredirect .t 1
@@ -1551,7 +1552,7 @@ test wm-stackorder-5.2.1 {A normal toplevel can be raised above an \
destroy .t
} -result 1
test wm-stackorder-5.3 {An overrideredirect window\
- can be explicitly lowered} -body {
+ can be explicitly lowered} -constraints failsOnXQuarz -body {
toplevel .t
tkwait visibility .t
wm overrideredirect .t 1
@@ -1726,7 +1727,7 @@ test wm-transient-3.3 {withdraw/deiconify on the toplevel
} -result {withdrawn 0 normal 1}
test wm-transient-4.1 {transient toplevel is withdrawn
- when mapped if toplevel is iconic} -constraints failsOnUbuntu -body {
+ when mapped if toplevel is iconic} -constraints {failsOnUbuntu failsOnXQuarz} -body {
toplevel .top
wm iconify .top
update
@@ -1928,7 +1929,7 @@ test wm-transient-7.5 {Reassign transient, destroy transient} -body {
deleteWindows
}
-test wm-transient-8.1 {transient to withdrawn window, Bug 1163496} -constraints failsOnUbuntu -setup {
+test wm-transient-8.1 {transient to withdrawn window, Bug 1163496} -constraints {failsOnUbuntu failsOnXQuarz} -setup {
deleteWindows
set result {}
} -body {
generated by cgit v0.12 at 2024-11-16 10:15:53 (GMT)