summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorstu <stwo@users.sourceforge.net>2018-07-03 16:08:09 (GMT)
committerstu <stwo@users.sourceforge.net>2018-07-03 16:08:09 (GMT)
commit8ab901ef383c7855e86d4278be85c9cb0457c13e (patch)
tree4204166d84a24b3a67540ed48abe6649d55f8d16 /tests
parente6032ebc5625554d828c05f7613453e0d03fccf4 (diff)
parentde866e22c431f4fae653508f38af2fd645b1fc2a (diff)
downloadtk-8ab901ef383c7855e86d4278be85c9cb0457c13e.zip
tk-8ab901ef383c7855e86d4278be85c9cb0457c13e.tar.gz
tk-8ab901ef383c7855e86d4278be85c9cb0457c13e.tar.bz2
Merge trunk.
Diffstat (limited to 'tests')
-rw-r--r--tests/bind.test33
-rw-r--r--tests/busy.test82
-rw-r--r--tests/canvImg.test8
-rw-r--r--tests/canvText.test4
-rw-r--r--tests/canvas.test88
-rw-r--r--tests/choosedir.test16
-rw-r--r--tests/config.test4
-rw-r--r--tests/entry.test27
-rw-r--r--tests/filebox.test34
-rw-r--r--tests/iDOT.pngbin0 -> 6279 bytes
-rw-r--r--tests/image.test10
-rw-r--r--tests/imgPNG.test11
-rw-r--r--tests/menuDraw.test2
-rw-r--r--tests/msgbox.test26
-rw-r--r--tests/packgrid.test30
-rw-r--r--tests/safePrimarySelection.test1220
-rw-r--r--tests/select.test23
-rw-r--r--tests/spinbox.test10
-rw-r--r--tests/text.test117
-rw-r--r--tests/textTag.test2
-rw-r--r--tests/ttk/checkbutton.test9
-rw-r--r--tests/ttk/entry.test20
-rw-r--r--tests/ttk/scrollbar.test23
-rw-r--r--tests/unixFont.test98
-rw-r--r--tests/winWm.test2
25 files changed, 1760 insertions, 139 deletions
diff --git a/tests/bind.test b/tests/bind.test
index 374ef9b..788f132 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -34,6 +34,19 @@ proc unsetBindings {} {
bind .t <Enter> {}
}
+# This function fills the pattern matcher's ring buffer with events of
+# the specified type. This can be used when testing with generated
+# events to make sure that there are no stray events in the ring
+# buffer which might cause the pattern matcher to find unintended
+# matches. The size of the ring buffer is EVENT_BUFFER_SIZE, which is
+# currently set to 30. If this changes, the code below will need to
+# change.
+proc clearRingBuffer {{event}} {
+ for {set i 0} {$i < 30} {incr i} {
+ event generate . $event
+ }
+}
+
# move the mouse pointer away of the testing area
# otherwise some spurious events may pollute the tests
toplevel .top
@@ -648,8 +661,8 @@ test bind-13.14 {Tk_BindEvent procedure: invalid key detail} -setup {
} -body {
bind .t.f <Key> "lappend x Key%K"
bind .t.f <KeyRelease> "lappend x Release%K"
- event generate .t.f <Key> -keycode 0
- event generate .t.f <KeyRelease> -keycode 0
+ event generate .t.f <Key> -keycode -1
+ event generate .t.f <KeyRelease> -keycode -1
return $x
} -cleanup {
destroy .t.f
@@ -1382,10 +1395,11 @@ test bind-15.22 {MatchPatterns procedure, time wrap-around} -setup {
pack .t.f
focus -force .t.f
update
+ clearRingBuffer <Key>
} -body {
bind .t.f <Double-1> {set x 1}
set x 0
- event generate .t.f <Button-1> -time [expr -100]
+ event generate .t.f <Button-1> -time -100
event generate .t.f <Button-1> -time 200
event generate .t.f <ButtonRelease-1>
return $x
@@ -1397,6 +1411,7 @@ test bind-15.23 {MatchPatterns procedure, time wrap-around} -setup {
pack .t.f
focus -force .t.f
update
+ clearRingBuffer <Key>
} -body {
bind .t.f <Double-1> {set x 1}
set x 0
@@ -1407,13 +1422,13 @@ test bind-15.23 {MatchPatterns procedure, time wrap-around} -setup {
} -cleanup {
destroy .t.f
} -result {0}
-
test bind-15.24 {MatchPatterns procedure, virtual event} -setup {
frame .t.f -class Test -width 150 -height 100
pack .t.f
focus -force .t.f
update
set x {}
+ clearRingBuffer <Key>
} -body {
event add <<Paste>> <Button-1>
bind .t.f <<Paste>> {lappend x paste}
@@ -1430,6 +1445,7 @@ test bind-15.25 {MatchPatterns procedure, reject a virtual event} -setup {
focus -force .t.f
update
set x {}
+ clearRingBuffer <Key>
} -body {
event add <<Paste>> <Shift-Button-1>
bind .t.f <<Paste>> {lappend x paste}
@@ -1446,6 +1462,7 @@ test bind-15.26 {MatchPatterns procedure, reject a virtual event} -setup {
focus -force .t.f
update
set x {}
+ clearRingBuffer <Key>
} -body {
event add <<V1>> <Button>
event add <<V2>> <Button-1>
@@ -1472,6 +1489,7 @@ test bind-15.27 {MatchPatterns procedure, conflict resolution} -setup {
pack .t.f
focus -force .t.f
update
+ clearRingBuffer <Button>
} -body {
bind .t.f <KeyPress> {set x 0}
bind .t.f 1 {set x 1}
@@ -1486,6 +1504,7 @@ test bind-15.28 {MatchPatterns procedure, conflict resolution} -setup {
pack .t.f
focus -force .t.f
update
+ clearRingBuffer <Button>
} -body {
bind .t.f <KeyPress> {set x 0}
bind .t.f 1 {set x 1}
@@ -1500,6 +1519,7 @@ test bind-15.29 {MatchPatterns procedure, conflict resolution} -setup {
pack .t.f
focus -force .t.f
update
+ clearRingBuffer <Button>
} -body {
bind .t.f <KeyPress> {lappend x 0}
bind .t.f 1 {lappend x 1}
@@ -1517,6 +1537,7 @@ test bind-15.30 {MatchPatterns procedure, conflict resolution} -setup {
pack .t.f
focus -force .t.f
update
+ clearRingBuffer <Key>
} -body {
bind .t.f <ButtonPress> {set x 0}
bind .t.f <1> {set x 1}
@@ -1533,6 +1554,7 @@ test bind-15.31 {MatchPatterns procedure, conflict resolution} -setup {
focus -force .t.f
update
set x {}
+ clearRingBuffer <Button>
} -body {
bind .t.f <M1-Key> {set x 0}
bind .t.f <M2-Key> {set x 1}
@@ -1546,6 +1568,7 @@ test bind-15.32 {MatchPatterns procedure, conflict resolution} -setup {
pack .t.f
focus -force .t.f
update
+ clearRingBuffer <Button>
} -body {
bind .t.f <M2-Key> {set x 0}
bind .t.f <M1-Key> {set x 1}
@@ -1561,6 +1584,7 @@ test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup {
focus -force .t.f
update
set x {}
+ clearRingBuffer <Key>
} -body {
bind .t.f <1> {lappend x single}
bind Test <1> {lappend x single(Test)}
@@ -2208,6 +2232,7 @@ test bind-16.46 {ExpandPercents procedure} -setup {
focus -force .t.e
foreach p [event info] {event delete $p}
update
+ clearRingBuffer <Button>
} -body {
bind all <Key> {set z "%M"}
bind Entry <Key> {set y "%M"}
diff --git a/tests/busy.test b/tests/busy.test
index 304c2eb..001bb6c 100644
--- a/tests/busy.test
+++ b/tests/busy.test
@@ -23,53 +23,59 @@ test busy-2.1 {tk busy hold} -returnCodes error -body {
tk busy hold
} -result {wrong # args: should be "tk busy hold window ?option value ...?"}
test busy-2.2 {tk busy hold root window} -body {
- tk busy hold .
+ set res [tk busy hold .]
update
+ set res
} -cleanup {
tk busy forget .
-} -result {}
+} -result {._Busy}
test busy-2.3 {tk busy hold root window with shortcut} -body {
- tk busy .
+ set res [tk busy .]
update
+ set res
} -cleanup {
tk busy forget .
-} -result {}
+} -result {._Busy}
test busy-2.4 {tk busy hold nested window} -setup {
pack [frame .f]
} -body {
- tk busy hold .f
+ set res [tk busy hold .f]
update
+ set res
} -cleanup {
tk busy forget .f
destroy .f
-} -result {}
+} -result {.f_Busy}
test busy-2.5 {tk busy hold nested window with shortcut} -setup {
pack [frame .f]
} -body {
- tk busy .f
+ set res [tk busy .f]
update
+ set res
} -cleanup {
tk busy forget .f
destroy .f
-} -result {}
+} -result {.f_Busy}
test busy-2.6 {tk busy hold toplevel window} -setup {
toplevel .f
} -body {
- tk busy hold .f
+ set res [tk busy hold .f]
update
+ set res
} -cleanup {
tk busy forget .f
destroy .f
-} -result {}
+} -result {.f._Busy}
test busy-2.7 {tk busy hold toplevel window with shortcut} -setup {
toplevel .f
} -body {
- tk busy .f
+ set res [tk busy .f]
update
+ set res
} -cleanup {
tk busy forget .f
destroy .f
-} -result {}
+} -result {.f._Busy}
test busy-2.8 {tk busy hold non existing window} -body {
tk busy hold .f
update
@@ -79,39 +85,41 @@ test busy-2.9 {tk busy hold (shortcut) non existing window} -body {
update
} -returnCodes {error} -result {bad window path name ".f"}
test busy-2.10 {tk busy hold root window with cursor} -body {
- tk busy hold . -cursor arrow
+ set res [tk busy hold . -cursor arrow]
update
+ set res
} -cleanup {
tk busy forget .
-} -result {}
+} -result {._Busy}
test busy-2.11 {tk busy hold (shortcut) root window, cursor} -body {
- tk busy . -cursor arrow
+ set res [tk busy . -cursor arrow]
update
+ set res
} -cleanup {
tk busy forget .
-} -result {}
+} -result {._Busy}
test busy-2.12 {tk busy hold root window, invalid cursor} -body {
tk busy hold . -cursor nonExistingCursor
update
-} -constraints tempNotMac -returnCodes error -cleanup {
+} -returnCodes error -cleanup {
tk busy forget .
} -result {bad cursor spec "nonExistingCursor"}
test busy-2.13 {tk busy hold (shortcut) root window, invalid cursor} -body {
tk busy . -cursor nonExistingCursor
update
-} -constraints tempNotMac -returnCodes error -cleanup {
+} -returnCodes error -cleanup {
tk busy forget .
} -result {bad cursor spec "nonExistingCursor"}
test busy-2.14 {tk busy hold root window, invalid option} -body {
tk busy hold . -invalidOption 1
update
-} -constraints tempNotMac -returnCodes error -cleanup {
+} -returnCodes error -cleanup {
tk busy forget .
} -result {unknown option "-invalidOption"}
test busy-2.15 {tk busy hold (shortcut) root window, invalid option} -body {
tk busy . -invalidOption 1
update
-} -constraints tempNotMac -returnCodes error -cleanup {
+} -returnCodes error -cleanup {
tk busy forget .
} -result {unknown option "-invalidOption"}
@@ -170,7 +178,7 @@ test busy-3.7 {tk busy cget unix} -setup {
} -cleanup {
tk busy forget .f
destroy .f
-} -result {hand1} -constraints tempNotMac
+} -result {hand1}
test busy-4.1 {tk busy configure no window} -returnCodes error -body {
tk busy configure
@@ -210,7 +218,7 @@ test busy-4.4-win {tk busy configure} -constraints {win} -setup {
destroy .f
} -result {{-cursor cursor Cursor wait wait}}
-test busy-4.5 {tk busy configure} -constraints {nonwin tempNotMac} -setup {
+test busy-4.5 {tk busy configure} -constraints {nonwin} -setup {
pack [frame .f]
tk busy hold .f -cursor hand2
update
@@ -266,7 +274,7 @@ test busy-4.7-win {tk busy configure valid option} -constraints {win} -setup {
} -result {-cursor cursor Cursor wait wait}
test busy-4.8 {tk busy configure valid option} -constraints {
- nonwin tempNotMac
+ nonwin
} -setup {
pack [frame .f]
tk busy hold .f -cursor circle
@@ -299,7 +307,7 @@ test busy-4.9 {tk busy configure valid option with value} -setup {
} -cleanup {
tk busy forget .f
destroy .f
-} -result {pencil} -constraints tempNotMac
+} -result {pencil}
test busy-4.10 {tk busy configure valid option with invalid value} -setup {
pack [frame .f]
@@ -307,7 +315,7 @@ test busy-4.10 {tk busy configure valid option with invalid value} -setup {
update
} -body {
tk busy configure .f -cursor nonExistingCursor
-} -constraints tempNotMac -returnCodes error -cleanup {
+} -returnCodes error -cleanup {
tk busy forget .f
destroy .f
} -result {bad cursor spec "nonExistingCursor"}
@@ -473,5 +481,29 @@ test busy-7.9 {tk busy current 2 busy with non matching filter after forget} -se
destroy .f1 .f2
} -result {}
+test busy-8.1 {tk busy busywindow with a busy toplevel} -body {
+ toplevel .top
+ tk busy .top
+ tk busy busywindow .top
+} -cleanup {
+ tk busy forget .top
+ destroy .top
+} -result {.top._Busy}
+test busy-8.2 {tk busy busywindow with a busy widget} -body {
+ pack [frame .f]
+ tk busy .f
+ tk busy busywindow .f
+} -cleanup {
+ tk busy forget .f
+ destroy .f
+} -result {.f_Busy}
+test busy-8.3 {tk busy busywindow with a nonexisting widget} -body {
+ tk busy .
+ tk busy busywindow .nonExistingWidget
+} -cleanup {
+ tk busy forget .
+} -result {}
+
+
::tcltest::cleanupTests
return
diff --git a/tests/canvImg.test b/tests/canvImg.test
index 433dfac..e16c703 100644
--- a/tests/canvImg.test
+++ b/tests/canvImg.test
@@ -173,7 +173,7 @@ test canvImg-4.2 {ConfiugreImage procedure} -constraints testImageType -setup {
.c delete all
image delete foo
image delete foo2
-} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}}
+} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60}} {50 100 130 160}}
test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup {
.c delete all
} -body {
@@ -733,7 +733,7 @@ test canvImg-10.1 {TranslateImage procedure} -constraints testImageType -setup {
} -cleanup {
.c delete all
image delete foo
-} -result {{foo display 2 4 6 8 30 30}}
+} -result {{foo display 2 4 6 8}}
test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup {
.c delete all
@@ -748,7 +748,7 @@ test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup {
} -cleanup {
.c delete all
image delete foo
-} -result {{foo display 0 0 40 50 30 30}}
+} -result {{foo display 0 0 40 50}}
test canvImg-11.2 {ImageChangedProc procedure} -constraints {
testImageType
} -setup {
@@ -784,7 +784,7 @@ test canvImg-11.3 {ImageChangedProc procedure} -constraints {
} -cleanup {
.c delete all
image delete foo foo2
-} -result {{foo2 display 0 0 20 40 50 40}}
+} -result {{foo2 display 0 0 20 40}}
# cleanup
imageFinish
diff --git a/tests/canvText.test b/tests/canvText.test
index ff5e4b9..c04cb63 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -55,8 +55,8 @@ test canvText-1.10 {configuration options: good value for "stipple"} -body {
list [lindex [.c itemconfigure test -stipple] 4] [.c itemcget test -stipple]
} -result {gray50 gray50}
test canvasText-1.11 {configuration options: bad value for "stipple"} -body {
- .c itemconfigure test -stipple xyz
-} -returnCodes error -result {bitmap "xyz" not defined}
+ .c itemconfigure test -stipple abcxyz
+} -returnCodes error -result {bitmap "abcxyz" not defined}
test canvText-1.12 {configuration options: good value for "underline"} -body {
.c itemconfigure test -underline 0
list [lindex [.c itemconfigure test -underline] 4] [.c itemcget test -underline]
diff --git a/tests/canvas.test b/tests/canvas.test
index ae95751..f5bddcb 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -950,6 +950,94 @@ test canvas-19.11 {rchars method - errors} -setup {
destroy .c
} -returnCodes error -result {bad index "foo"}
+# Procedure used in test cases 20.1 20.2 20.3
+proc matchPixels {pixels expected} {
+ set matched 1
+ foreach pline $pixels eline $expected {
+ foreach ppixel $pline epixel $eline {
+ if {$ppixel != $epixel} {
+ set matched 0
+ break
+ }
+ }
+ }
+ return $matched
+}
+
+test canvas-20.1 {canvas image} -setup {
+ canvas .c
+ image create photo testimage
+} -body {
+ .c configure -background #c0c0c0 -scrollregion {0 0 9 9}
+ .c create rectangle 0 0 0 9 -fill #000080 -outline #000080
+ .c image testimage
+ matchPixels [testimage data] { \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#000080 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0}}
+} -cleanup {
+ destroy .c
+ image delete testimage
+} -result 1
+
+test canvas-20.2 {canvas image with subsample} -setup {
+ canvas .c
+ image create photo testimage
+} -body {
+ .c configure -background #c0c0c0 -scrollregion {0 0 9 9}
+ .c create rectangle 0 0 1 9 -fill #008000 -outline #008000
+ .c image testimage 2
+ matchPixels [testimage data] { \
+ {#008000 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#008000 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#008000 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#008000 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#008000 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0}}
+} -cleanup {
+ destroy .c
+ image delete testimage
+} -result 1
+
+test canvas-20.3 {canvas image with subsample and zoom} -setup {
+ canvas .c
+ image create photo testimage
+} -body {
+ .c configure -background #c0c0c0 -scrollregion {0 0 9 9}
+ .c create rectangle 0 0 9 0 -fill #800000 -outline #800000
+ .c image testimage 1 2
+ matchPixels [testimage data] { \
+ {#800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000} \
+ {#800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000 #800000} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0} \
+ {#c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0 #c0c0c0}}
+} -cleanup {
+ destroy .c
+ image delete testimage
+} -result 1
+
# cleanup
imageCleanup
cleanupTests
diff --git a/tests/choosedir.test b/tests/choosedir.test
index fb6e62d..f67a721 100644
--- a/tests/choosedir.test
+++ b/tests/choosedir.test
@@ -85,23 +85,25 @@ set fake [file join $dir non-existant]
set parent .
-test choosedir-1.1 {tk_chooseDirectory command} -constraints unix -body {
+test choosedir-1.1 {tk_chooseDirectory command} -body {
tk_chooseDirectory -initialdir
} -returnCodes error -result {value for "-initialdir" missing}
-test choosedir-1.2 {tk_chooseDirectory command} -constraints unix -body {
+test choosedir-1.2 {tk_chooseDirectory command} -body {
tk_chooseDirectory -mustexist
} -returnCodes error -result {value for "-mustexist" missing}
-test choosedir-1.3 {tk_chooseDirectory command} -constraints unix -body {
+test choosedir-1.3 {tk_chooseDirectory command} -body {
tk_chooseDirectory -parent
} -returnCodes error -result {value for "-parent" missing}
-test choosedir-1.4 {tk_chooseDirectory command} -constraints unix -body {
+test choosedir-1.4 {tk_chooseDirectory command} -body {
tk_chooseDirectory -title
} -returnCodes error -result {value for "-title" missing}
-
-test choosedir-1.5 {tk_chooseDirectory command} -constraints unix -body {
+test choosedir-1.5.1 {tk_chooseDirectory command} -constraints notAqua -body {
tk_chooseDirectory -foo bar
} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
-test choosedir-1.6 {tk_chooseDirectory command} -constraints unix -body {
+test choosedir-1.5.2 {tk_chooseDirectory command} -constraints aqua -body {
+ tk_chooseDirectory -foo bar
+} -returnCodes error -result {bad option "-foo": must be -initialdir, -message, -mustexist, -parent, -title, or -command}
+test choosedir-1.6 {tk_chooseDirectory command} -body {
tk_chooseDirectory -parent foo.bar
} -returnCodes error -result {bad window path name "foo.bar"}
diff --git a/tests/config.test b/tests/config.test
index 8c23595..9fd048a 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -679,10 +679,10 @@ test config-4.56 {DoObjConfig - new bitmap} -constraints testobjconfig -body {
test config-4.57 {DoObjConfig - invalid bitmap} -constraints {
testobjconfig
} -body {
- testobjconfig alltypes .foo -bitmap foo
+ testobjconfig alltypes .foo -bitmap foobar
} -cleanup {
killTables
-} -returnCodes error -result {bitmap "foo" not defined}
+} -returnCodes error -result {bitmap "foobar" not defined}
test config-4.58 {DoObjConfig - null bitmap} -constraints testobjconfig -body {
testobjconfig alltypes .foo -bitmap {}
} -cleanup {
diff --git a/tests/entry.test b/tests/entry.test
index 785dd0b..7065343 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -351,7 +351,7 @@ test entry-1.31 {configuration option: "insertbackground" for entry} -setup {
} -returnCodes {error} -result {unknown color name "non-existent"}
test entry-1.32 {configuration option: "insertborderwidth" for entry} -setup {
- entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
+ entry .e -borderwidth 2 -insertwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .e
update
} -body {
@@ -627,6 +627,23 @@ test entry-1.58 {configuration option: "xscrollcommand" for entry} -setup {
destroy .e
} -result {Some command}
+test entry-1.59 {configuration option: "-placeholder"} -setup {
+ pack [entry .e]
+} -body {
+ .e configure -placeholder {Some text}
+ .e cget -placeholder
+} -cleanup {
+ destroy .e
+} -result {Some text}
+
+test entry-1.60 {configuration option: "-placeholderforeground"} -setup {
+ pack [entry .e]
+} -body {
+ .e configure -placeholder {Some text} -placeholderforeground red
+ .e cget -placeholderforeground
+} -cleanup {
+ destroy .e
+} -result {red}
test entry-2.1 {Tk_EntryCmd procedure} -body {
@@ -808,7 +825,7 @@ test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} -setup {
llength [.e configure]
} -cleanup {
destroy .e
-} -result {36}
+} -result {38}
test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} -setup {
entry .e
} -body {
@@ -2580,7 +2597,7 @@ test entry-13.9 {GetEntryIndex procedure} -setup {
-test entry-13.10 {GetEntryIndex procedure} -constraints unix -body {
+test entry-13.10 {GetEntryIndex procedure} -constraints x11 -body {
# On unix, when selection is cleared, entry widget's internal
# selection range is reset.
# Previous settings:
@@ -2599,7 +2616,7 @@ test entry-13.10 {GetEntryIndex procedure} -constraints unix -body {
destroy .e
} -returnCodes error -result {selection isn't in widget .e}
-test entry-13.11 {GetEntryIndex procedure} -constraints win -body {
+test entry-13.11 {GetEntryIndex procedure} -constraints aquaOrWin32 -body {
# On mac and pc, when selection is cleared, entry widget remembers
# last selected range. When selection ownership is restored to
# entry, the old range will be rehighlighted.
@@ -2620,7 +2637,7 @@ test entry-13.11 {GetEntryIndex procedure} -constraints win -body {
destroy .e
} -result {1}
-test entry-13.12 {GetEntryIndex procedure} -constraints unix -body {
+test entry-13.12 {GetEntryIndex procedure} -constraints x11 -body {
# Previous settings:
entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken
pack .e
diff --git a/tests/filebox.test b/tests/filebox.test
index 85cb8a5..e373d73 100644
--- a/tests/filebox.test
+++ b/tests/filebox.test
@@ -110,8 +110,10 @@ if {$tcl_platform(platform) == "unix"} {
set modes 1
}
-set unknownOptionsMsg(tk_getOpenFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
-set unknownOptionsMsg(tk_getSaveFile) {bad option "-foo": must be -confirmoverwrite, -defaultextension, -filetypes, -initialdir, -initialfile, -parent, -title, or -typevariable}
+set unknownOptionsMsg(tk_getOpenFile,notAqua) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
+set unknownOptionsMsg(tk_getOpenFile,aqua) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -message, -multiple, -parent, -title, -typevariable, or -command}
+set unknownOptionsMsg(tk_getSaveFile,notAqua) {bad option "-foo": must be -confirmoverwrite, -defaultextension, -filetypes, -initialdir, -initialfile, -parent, -title, or -typevariable}
+set unknownOptionsMsg(tk_getSaveFile,aqua) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -message, -parent, -title, -typevariable, -command, or -confirmoverwrite}
set tmpFile "filebox.tmp"
makeFile {
@@ -155,9 +157,12 @@ foreach mode $modes {
}
}
- test filebox-1.1-$mode "tk_getOpenFile command" -body {
+ test filebox-1.1.1-$mode "tk_getOpenFile command" -constraints notAqua -body {
tk_getOpenFile -foo
- } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile)
+ } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile,notAqua)
+ test filebox-1.1.2-$mode "tk_getOpenFile command" -constraints aqua -body {
+ tk_getOpenFile -foo
+ } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile,aqua)
catch {tk_getOpenFile -foo 1} msg
regsub -all , $msg "" options
@@ -171,9 +176,12 @@ foreach mode $modes {
}
}
- test filebox-1.3-$mode "tk_getOpenFile command" -body {
+ test filebox-1.3.1-$mode "tk_getOpenFile command" -constraints notAqua -body {
+ tk_getOpenFile -foo bar
+ } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile,notAqua)
+ test filebox-1.3.2-$mode "tk_getOpenFile command" -constraints aqua -body {
tk_getOpenFile -foo bar
- } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile)
+ } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile,aqua)
test filebox-1.4-$mode "tk_getOpenFile command" -body {
tk_getOpenFile -initialdir
} -returnCodes error -result {value for "-initialdir" missing}
@@ -289,9 +297,12 @@ foreach mode $modes {
} $res
}
- test filebox-4.1-$mode "tk_getSaveFile command" -body {
+ test filebox-4.1.1-$mode "tk_getSaveFile command" -constraints notAqua -body {
tk_getSaveFile -foo
- } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile)
+ } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile,notAqua)
+ test filebox-4.1.2-$mode "tk_getSaveFile command" -constraints aqua -body {
+ tk_getSaveFile -foo
+ } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile,aqua)
catch {tk_getSaveFile -foo 1} msg
regsub -all , $msg "" options
@@ -305,9 +316,12 @@ foreach mode $modes {
}
}
- test filebox-4.3-$mode "tk_getSaveFile command" -body {
+ test filebox-4.3.1-$mode "tk_getSaveFile command" -constraints notAqua -body {
+ tk_getSaveFile -foo bar
+ } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile,notAqua)
+ test filebox-4.3.2-$mode "tk_getSaveFile command" -constraints aqua -body {
tk_getSaveFile -foo bar
- } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile)
+ } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile,aqua)
test filebox-4.4-$mode "tk_getSaveFile command" -body {
tk_getSaveFile -initialdir
} -returnCodes error -result {value for "-initialdir" missing}
diff --git a/tests/iDOT.png b/tests/iDOT.png
new file mode 100644
index 0000000..e8cd024
--- /dev/null
+++ b/tests/iDOT.png
Binary files differ
diff --git a/tests/image.test b/tests/image.test
index 52701fb..7322f2f 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -67,7 +67,7 @@ test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints {
return $x
} -cleanup {
imageCleanup
-} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
+} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}}
test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
testImageType
} -setup {
@@ -86,7 +86,7 @@ test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
} -cleanup {
.c delete all
imageCleanup
-} -result {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
+} -result {{myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}}
test image-1.9 {Tk_ImageCmd procedure, "create" option} -constraints {
testImageType
} -body {
@@ -360,7 +360,7 @@ test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup {
} -cleanup {
.c delete all
imageCleanup
-} -result {{foo display 5 6 7 8 30 30}}
+} -result {{foo display 5 6 7 8}}
test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
.c delete all
imageCleanup
@@ -376,7 +376,7 @@ test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
} -cleanup {
.c delete all
imageCleanup
-} -result {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}}
+} -result {{foo display 5 6 25 9} {foo display 0 0 12 14}}
test image-10.1 {Tk_GetImage procedure} -setup {
@@ -417,7 +417,7 @@ test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup {
} -cleanup {
.c delete all
imageCleanup
-} -result {foo {{foo free} {foo display 0 0 30 15 103 121}}}
+} -result {foo {{foo free} {foo display 0 0 30 15}}}
test image-11.2 {Tk_FreeImage procedure} -constraints testImageType -setup {
.c delete all
imageCleanup
diff --git a/tests/imgPNG.test b/tests/imgPNG.test
index 0757411..4900e9c 100644
--- a/tests/imgPNG.test
+++ b/tests/imgPNG.test
@@ -1103,6 +1103,17 @@ test imgPNG-2.2 {reading a good image with multiple IDATs} -setup {
} -cleanup {
image delete $i
} -result 223x212
+
+test imgPNG-3.1 {reading image with unknown ancillary chunk - bug [1c659ef0f1]} -setup {
+ set fileName [file join [file dirname [info script]] iDOT.png]
+} -body {
+ # the image contains an unknown chunk iDOT
+ # since the name of this chunk starts with a lowercase letter,
+ # it's an ancillary chunk that shall not trigger an error
+ catch {set i [image create photo -file $fileName]}
+} -cleanup {
+ image delete $i
+} -result {0}
}
namespace delete png
diff --git a/tests/menuDraw.test b/tests/menuDraw.test
index cfd88d5..ec9dae5 100644
--- a/tests/menuDraw.test
+++ b/tests/menuDraw.test
@@ -647,7 +647,7 @@ test menuDraw-16.4 {TkPostSubMenu} -setup {
} -cleanup {
deleteWindows
} -result {}
-test menuDraw-16.5 {TkPostSubMenu} -constraints unix -setup {
+test menuDraw-16.5 {TkPostSubMenu} -setup {
deleteWindows
} -body {
menu .m1
diff --git a/tests/msgbox.test b/tests/msgbox.test
index 4790b88..4a6de57 100644
--- a/tests/msgbox.test
+++ b/tests/msgbox.test
@@ -11,12 +11,18 @@ tcltest::loadTestedCommands
namespace import -force tcltest::test
-test msgbox-1.1 {tk_messageBox command} -body {
+test msgbox-1.1.1 {tk_messageBox command} -constraints notAqua -body {
tk_messageBox -foo
} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}
-test msgbox-1.2 {tk_messageBox command} -body {
+test msgbox-1.1.2 {tk_messageBox command} -constraints aqua -body {
+ tk_messageBox -foo
+} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, -type, or -command}
+test msgbox-1.2.1 {tk_messageBox command} -constraints notAqua -body {
tk_messageBox -foo bar
} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}
+test msgbox-1.2.2 {tk_messageBox command} -constraints aqua -body {
+ tk_messageBox -foo bar
+} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, -type, or -command}
test msgbox-1.3 {tk_messageBox command} -body {
tk_messageBox -default
@@ -48,30 +54,22 @@ test msgbox-1.11 {tk_messageBox command} -body {
tk_messageBox -type foo
} -returnCodes error -result {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}
-test msgbox-1.12 {tk_messageBox command} -constraints unix -body {
- tk_messageBox -default 1.1
-} -returnCodes error -result {invalid default button "1.1"}
-test msgbox-1.13 {tk_messageBox command} -constraints macOrWin -body {
+test msgbox-1.13 {tk_messageBox command} -body {
tk_messageBox -default 1.1
} -returnCodes error -result {bad -default value "1.1": must be abort, retry, ignore, ok, cancel, no, or yes}
-test msgbox-1.14 {tk_messageBox command} -constraints unix -body {
- tk_messageBox -default foo
-} -returnCodes error -result {invalid default button "foo"}
-test msgbox-1.15 {tk_messageBox command} -constraints macOrWin -body {
+test msgbox-1.14 {tk_messageBox command} -body {
tk_messageBox -default foo
} -returnCodes error -result {bad -default value "foo": must be abort, retry, ignore, ok, cancel, no, or yes}
-test msgbox-1.16 {tk_messageBox command} -constraints unix -body {
- tk_messageBox -type yesno -default 3
-} -returnCodes error -result {invalid default button "3"}
-test msgbox-1.17 {tk_messageBox command} -constraints macOrWin -body {
+test msgbox-1.16 {tk_messageBox command} -body {
tk_messageBox -type yesno -default 3
} -returnCodes error -result {bad -default value "3": must be abort, retry, ignore, ok, cancel, no, or yes}
test msgbox-1.18 {tk_messageBox command} -body {
tk_messageBox -icon foo
} -returnCodes error -result {bad -icon value "foo": must be error, info, question, or warning}
+
test msgbox-1.19 {tk_messageBox command} -body {
tk_messageBox -parent foo.bar
} -returnCodes error -result {bad window path name "foo.bar"}
diff --git a/tests/packgrid.test b/tests/packgrid.test
index 355b49d..6074ce9 100644
--- a/tests/packgrid.test
+++ b/tests/packgrid.test
@@ -246,5 +246,35 @@ test packgrid-3.4 {stealing slave} -setup {
destroy .g
} -result {cannot use geometry manager grid inside . which already has slaves managed by pack}
+test packgrid-4.1 {slave stolen after master destruction - bug [aa7679685e]} -setup {
+ frame .f
+ button .b -text hello
+} -body {
+ pack .f
+ grid .b -in .f
+ destroy .f
+ set res [winfo manager .b]
+ # shall not crash
+ pack .b
+ set res
+} -cleanup {
+ destroy .b
+} -result {}
+
+test packgrid-4.2 {slave stolen after master destruction - bug [aa7679685e]} -setup {
+ frame .f
+ button .b -text hello
+} -body {
+ pack .f
+ pack .b -in .f
+ destroy .f
+ set res [winfo manager .b]
+ # shall not crash
+ grid .b
+ set res
+} -cleanup {
+ destroy .b
+} -result {}
+
cleanupTests
return
diff --git a/tests/safePrimarySelection.test b/tests/safePrimarySelection.test
new file mode 100644
index 0000000..7cc31f4
--- /dev/null
+++ b/tests/safePrimarySelection.test
@@ -0,0 +1,1220 @@
+# This file is a Tcl script to test entry widgets in Tk. It is
+# organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+
+package require tcltest 2.2
+namespace import ::tcltest::*
+eval tcltest::configure $argv
+tcltest::loadTestedCommands
+
+# ------------------------------------------------------------------------------
+# Tests that a Safe Base interpreter cannot write to the PRIMARY selection.
+# ------------------------------------------------------------------------------
+# - Tests 3.*, 6.* test that the fix for ticket de156e9efe implemented in branch
+# bug-de156e9efe has been applied and still works. They test that a Safe Base
+# slave interpreter cannot write to the PRIMARY selection.
+# - The other tests verify that the master interpreter and an unsafe slave CAN
+# write to the PRIMARY selection, and therefore that the test scripts
+# themselves are valid.
+# - A text, entry, ttk::entry, listbox, spinbox or ttk::spinbox widget can have
+# option -exportselection 1, meaning (in an unsafe interpreter) that a
+# selection made in one of these widgets is automatically written to the
+# PRIMARY selection.
+# - A safe interpreter must not write to the PRIMARY selection.
+# - The spinbox, ttk::spinbox are variants of entry, ttk::entry respectively.
+# ------------------------------------------------------------------------------
+
+namespace eval ::_test_tmp {}
+
+# ------------------------------------------------------------------------------
+# Proc ::_test_tmp::unsafeInterp
+# ------------------------------------------------------------------------------
+# Command that creates an unsafe child interpreter and tries to load Tk.
+# - This is necessary for loading Tk if the tests are done in the build
+# directory without installing Tk. In that case the usual auto_path loading
+# mechanism cannot work because the tk binary is not where pkgIndex.tcl says
+# it is.
+# - This command is not needed for Safe Base slaves because safe::loadTk does
+# something similar and works correctly.
+# - Based on scripts in winSend.test.
+# ------------------------------------------------------------------------------
+
+namespace eval ::_test_tmp {
+ variable TkLoadCmd
+}
+
+foreach pkg [info loaded] {
+ if {[lindex $pkg 1] eq "Tk"} {
+ set ::_test_tmp::TkLoadCmd [list load {*}$pkg]
+ break
+ }
+}
+
+proc ::_test_tmp::unsafeInterp {name} {
+ variable TkLoadCmd
+ interp create $name
+ $name eval [list set argv [list -name $name]]
+ catch {{*}$TkLoadCmd $name}
+}
+
+
+set ::_test_tmp::script {
+ package require Tk
+ namespace eval ::_test_tmp {}
+
+ proc ::_test_tmp::getPrimarySelection {} {
+ if {[catch {::tk::GetSelection . PRIMARY} sel]} {
+ set sel {}
+ }
+ return $sel
+ }
+
+ proc ::_test_tmp::setPrimarySelection {} {
+ destroy .preset
+ text .preset -exportselection 1
+ .preset insert end OLD_VALUE
+ # pack .preset
+ .preset tag add sel 1.0 end-1c
+ update
+ return
+ }
+
+ # Clearing the PRIMARY selection is troublesome.
+ # The window need not be mapped.
+ # However, the window must continue to exist, or some X11 servers
+ # will set the PRIMARY selection to something else.
+ proc ::_test_tmp::clearPrimarySelection {} {
+ destroy .clear
+ text .clear -exportselection 1
+ .clear insert end TMP_VALUE
+ # pack .clear
+ .clear tag add sel 1.0 end-1c
+ update
+ .clear tag remove sel 1.0 end-1c
+ update
+ return
+ }
+
+ # If this interpreter can write to the PRIMARY
+ # selection, the commands below will do so.
+
+ proc ::_test_tmp::tryText {} {
+ text .t -exportselection 1
+ .t insert end PAYLOAD
+ pack .t
+ .t tag add sel 1.0 end-1c
+ update
+ return
+ }
+
+ proc ::_test_tmp::tryEntry {} {
+ entry .t -exportselection 1
+ .t insert end PAYLOAD
+ pack .t
+ .t selection range 0 end
+ update
+ return
+ }
+
+ proc ::_test_tmp::tryTtkEntry {} {
+ ::ttk::entry .t -exportselection 1
+ .t insert end PAYLOAD
+ pack .t
+ .t selection range 0 end
+ update
+ return
+ }
+
+ proc ::_test_tmp::tryListbox {} {
+ listbox .t -exportselection 1
+ .t insert end list1 PAYLOAD list3
+ pack .t
+ .t selection set 1
+ update
+ return
+ }
+
+ proc ::_test_tmp::trySpinbox {ver} {
+ if {$ver == 1} {
+ # spinbox as entry
+ spinbox .t -exportselection 1 -values {1 2 3 4 5}
+ .t delete 0 end
+ .t insert end PAYLOAD
+ pack .t
+ .t selection range 0 end
+ update
+ return
+ # selects PAYLOAD
+ } elseif {$ver == 2} {
+ # spinbox spun
+ spinbox .t -exportselection 1 -values {1 2 3 4 5}
+ .t invoke buttonup
+ pack .t
+ .t selection range 0 end
+ update
+ return
+ # selects 2
+ } else {
+ # spinbox spun/selected/spun
+ spinbox .t -exportselection 1 -values {1 2 3 4 5}
+ .t invoke buttonup
+ pack .t
+ .t selection range 0 end
+ update
+ .t invoke buttonup
+ update
+ return
+ # selects 3
+ }
+ }
+
+ proc ::_test_tmp::tryTtkSpinbox {ver} {
+ if {$ver == 1} {
+ # ttk::spinbox as entry
+ ::ttk::spinbox .t -exportselection 1 -values {1 2 3 4 5}
+ .t delete 0 end
+ .t insert end PAYLOAD
+ pack .t
+ .t selection range 0 end
+ update
+ return
+ } elseif {$ver == 2} {
+ # ttk::spinbox spun
+ ::ttk::spinbox .t -exportselection 1 -values {1 2 3 4 5}
+ ::ttk::spinbox::Spin .t +1
+ ::ttk::spinbox::Spin .t +1
+ pack .t
+ # ttk::spinbox::Spin sets selection
+ update
+ return
+ # selects 2
+ } else {
+ # ttk::spinbox spun/selected/spun
+ ::ttk::spinbox .t -exportselection 1 -values {1 2 3 4 5}
+ ::ttk::spinbox::Spin .t +1
+ ::ttk::spinbox::Spin .t +1
+ pack .t
+ # ttk::spinbox::Spin sets selection
+ update
+ ::ttk::spinbox::Spin .t +1
+ update
+ return
+ # selects 3
+ }
+ }
+}
+
+# Do this once for the master interpreter.
+eval $::_test_tmp::script
+
+test safePrimarySelection-1.1 {master interpreter, text, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::tryText
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-1.2 {master interpreter, entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::tryEntry
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-1.3 {master interpreter, ttk::entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::tryTtkEntry
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-1.4 {master interpreter, listbox, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::tryListbox
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-1.5 {master interpreter, spinbox as entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::trySpinbox 1
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-1.6 {master interpreter, spinbox spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::trySpinbox 2
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {2}
+
+test safePrimarySelection-1.7 {master interpreter, spinbox spun/selected/spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::trySpinbox 3
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {3}
+
+test safePrimarySelection-1.8 {master interpreter, ttk::spinbox as entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::tryTtkSpinbox 1
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-1.9 {master interpreter, ttk::spinbox spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::tryTtkSpinbox 2
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {2}
+
+test safePrimarySelection-1.10 {master interpreter, ttk::spinbox spun/selected/spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ ::_test_tmp::tryTtkSpinbox 3
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {3}
+
+test safePrimarySelection-2.1 {unsafe slave interpreter, text, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryText
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-2.2 {unsafe slave interpreter, entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryEntry
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-2.3 {unsafe slave interpreter, ttk::entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkEntry
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-2.4 {unsafe slave interpreter, listbox, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryListbox
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-2.5 {unsafe slave interpreter, spinbox as entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 1
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-2.6 {unsafe slave interpreter, spinbox spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 2
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {2}
+
+test safePrimarySelection-2.7 {unsafe slave interpreter, spinbox spun/selected/spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 3
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {3}
+
+test safePrimarySelection-2.8 {unsafe slave interpreter, ttk::spinbox as entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 1
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-2.9 {unsafe slave interpreter, ttk::spinbox spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 2
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {2}
+
+test safePrimarySelection-2.10 {unsafe slave interpreter, ttk::spinbox spun/selected/spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 3
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {3}
+
+test safePrimarySelection-3.1 {IMPORTANT, safe slave interpreter, text, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryText
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.2 {IMPORTANT, safe slave interpreter, entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryEntry
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.3 {IMPORTANT, safe slave interpreter, ttk::entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkEntry
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.4 {IMPORTANT, safe slave interpreter, listbox, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryListbox
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.5 {IMPORTANT, safe slave interpreter, spinbox as entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 1
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.6 {IMPORTANT, safe slave interpreter, spinbox spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 2
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.7 {IMPORTANT, safe slave interpreter, spinbox spun/selected/spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 3
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.8 {IMPORTANT, safe slave interpreter, ttk::spinbox as entry, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 1
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.9 {IMPORTANT, safe slave interpreter, ttk::spinbox spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 2
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-3.10 {IMPORTANT, safe slave interpreter, ttk::spinbox spun/selected/spun, no existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 3
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {----}
+
+test safePrimarySelection-4.1 {master interpreter, text, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::tryText
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-4.2 {master interpreter, entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::tryEntry
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-4.3 {master interpreter, ttk::entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::tryTtkEntry
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-4.4 {master interpreter, listbox, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::tryListbox
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-4.5 {master interpreter, spinbox as entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::trySpinbox 1
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-4.6 {master interpreter, spinbox spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::trySpinbox 2
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {2}
+
+test safePrimarySelection-4.7 {master interpreter, spinbox spun/selected/spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::trySpinbox 3
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {3}
+
+test safePrimarySelection-4.8 {master interpreter, ttk::spinbox as entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::tryTtkSpinbox 1
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-4.9 {master interpreter, ttk::spinbox spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::tryTtkSpinbox 2
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {2}
+
+test safePrimarySelection-4.10 {master interpreter, ttk::spinbox spun/selected/spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ ::_test_tmp::tryTtkSpinbox 3
+ ::_test_tmp::getPrimarySelection
+} -cleanup {
+ destroy {*}[winfo children .]
+ ::_test_tmp::clearPrimarySelection
+} -result {3}
+
+test safePrimarySelection-5.1 {unsafe slave interpreter, text, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryText
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-5.2 {unsafe slave interpreter, entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryEntry
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-5.3 {unsafe slave interpreter, ttk::entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkEntry
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-5.4 {unsafe slave interpreter, listbox, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryListbox
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-5.5 {unsafe slave interpreter, spinbox as entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 1
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-5.6 {unsafe slave interpreter, spinbox spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 2
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {2}
+
+test safePrimarySelection-5.7 {unsafe slave interpreter, spinbox spun/selected/spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 3
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {3}
+
+test safePrimarySelection-5.8 {unsafe slave interpreter, ttk::spinbox as entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 1
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {PAYLOAD}
+
+test safePrimarySelection-5.9 {unsafe slave interpreter, ttk::spinbox spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 2
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {2}
+
+test safePrimarySelection-5.10 {unsafe slave interpreter, ttk::spinbox spun/selected/spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set int2 slave2
+ ::_test_tmp::unsafeInterp $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 3
+ $int2 eval ::_test_tmp::getPrimarySelection
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2
+ ::_test_tmp::clearPrimarySelection
+} -result {3}
+
+test safePrimarySelection-6.1 {IMPORTANT, safe slave interpreter, text, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryText
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.2 {IMPORTANT, safe slave interpreter, entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryEntry
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.3 {IMPORTANT, safe slave interpreter, ttk::entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkEntry
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.4 {IMPORTANT, safe slave interpreter, listbox, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryListbox
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.5 {IMPORTANT, safe slave interpreter, spinbox as entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 1
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.6 {IMPORTANT, safe slave interpreter, spinbox spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 2
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.7 {IMPORTANT, safe slave interpreter, spinbox spun/selected/spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::trySpinbox 3
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.8 {IMPORTANT, safe slave interpreter, ttk::spinbox as entry, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 1
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.9 {IMPORTANT, safe slave interpreter, ttk::spinbox spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 2
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+test safePrimarySelection-6.10 {IMPORTANT, safe slave interpreter, ttk::spinbox spun/selected/spun, existing selection} -setup {
+ catch {interp delete slave2}
+ destroy {*}[winfo children .]
+ ::_test_tmp::setPrimarySelection
+} -body {
+ set res0 [::_test_tmp::getPrimarySelection]
+ set int2 slave2
+ ::safe::interpCreate $int2
+ ::safe::loadTk $int2
+ $int2 eval $::_test_tmp::script
+ $int2 eval ::_test_tmp::tryTtkSpinbox 3
+ set res1 [$int2 eval ::_test_tmp::getPrimarySelection]
+ set res2 [::_test_tmp::getPrimarySelection]
+ set res3 $res0--$res1--$res2
+} -cleanup {
+ interp delete $int2
+ destroy {*}[winfo children .]
+ unset int2 res0 res1 res2 res3
+ ::_test_tmp::clearPrimarySelection
+} -result {OLD_VALUE----OLD_VALUE}
+
+
+namespace delete ::_test_tmp
+
+# option clear
+# cleanup
+cleanupTests
+return
diff --git a/tests/select.test b/tests/select.test
index f9f3e38..de330e5 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -17,6 +17,13 @@ namespace import ::tk::test:loadTkCommand
eval tcltest::configure $argv
tcltest::loadTestedCommands
+testConstraint cliboardManagerPresent 0
+if {![catch {selection get -selection CLIPBOARD_MANAGER -type TARGETS}]} {
+ if {"SAVE_TARGETS" in [selection get -selection CLIPBOARD_MANAGER -type TARGETS]} {
+ testConstraint cliboardManagerPresent 1
+ }
+}
+
global longValue selValue selInfo
set selValue {}
@@ -1044,6 +1051,8 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints {
lappend result [dobg {selection get}]
cleanupbg
lappend result $selInfo
+} -cleanup {
+ rename weirdHandler {}
} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {STRING 0 4000}}
##############################################################################
@@ -1148,8 +1157,20 @@ test select-13.1 {SelectionSize procedure, handler deleted} -constraints {
cleanupbg
lappend result $selInfo
} -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}
+
+test select-14.1 {Bug [73ba07efcd]: Use correct property type when handling MULTIPLE conversion requests} -constraints {
+ cliboardManagerPresent
+} -setup {
+ proc get_clip {offset maxChars} {return abcd}
+} -body {
+ selection handle -selection CLIPBOARD . get_clip
+ selection own -selection CLIPBOARD .
+ selection get -selection CLIPBOARD_MANAGER -type SAVE_TARGETS
+ clipboard get
+} -cleanup {
+ rename get_clip {}
+} -result {abcd}
-catch {rename weirdHandler {}}
# cleanup
cleanupTests
diff --git a/tests/spinbox.test b/tests/spinbox.test
index 1f2bdac..28ebe68 100644
--- a/tests/spinbox.test
+++ b/tests/spinbox.test
@@ -526,7 +526,7 @@ test spinbox-1.44 {configuration option: "insertbackground" for spinbox} -setup
} -returnCodes {error} -result {unknown color name "bogus"}
test spinbox-1.45 {configuration option: "insertborderwidth"} -setup {
- spinbox .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12} \
+ spinbox .e -borderwidth 2 -insertwidth 2 -highlightthickness 2 -font {Helvetica -12} \
-relief sunken
pack .e
update
@@ -1163,7 +1163,7 @@ test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} -setu
llength [.e configure]
} -cleanup {
destroy .e
-} -result {49}
+} -result {51}
test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} -setup {
spinbox .e
} -body {
@@ -2881,7 +2881,7 @@ test spinbox-13.9 {GetSpinboxIndex procedure} -setup {
destroy .e
} -result {1 6}
-test spinbox-13.10 {GetSpinboxIndex procedure} -constraints unix -body {
+test spinbox-13.10 {GetSpinboxIndex procedure} -constraints x11 -body {
# On unix, when selection is cleared, spinbox widget's internal
# selection range is reset.
# Previous settings:
@@ -2900,7 +2900,7 @@ test spinbox-13.10 {GetSpinboxIndex procedure} -constraints unix -body {
destroy .e
} -returnCodes error -result {selection isn't in widget .e}
-test spinbox-13.11 {GetSpinboxIndex procedure} -constraints win -body {
+test spinbox-13.11 {GetSpinboxIndex procedure} -constraints aquaOrWin32 -body {
# On mac and pc, when selection is cleared, spinbox widget remembers
# last selected range. When selection ownership is restored to
# spinbox, the old range will be rehighlighted.
@@ -2921,7 +2921,7 @@ test spinbox-13.11 {GetSpinboxIndex procedure} -constraints win -body {
destroy .e
} -result {1}
-test spinbox-13.12 {GetSpinboxIndex procedure} -constraints unix -body {
+test spinbox-13.12 {GetSpinboxIndex procedure} -constraints x11 -body {
# Previous settings:
spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken
pack .e
diff --git a/tests/text.test b/tests/text.test
index 321114d..f5225d9 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -1599,6 +1599,15 @@ test text-8.27 {TextWidgetCmd procedure, "replace" option crash} -setup {
} -cleanup {
destroy .tt
} -result {}
+test text-8.28 {TextWidgetCmd procedure, "replace" option crash} -setup {
+ text .tt
+} -body {
+ .tt insert end "foo\n"
+ .tt tag add sel 1.0 end
+ .tt replace sel.first sel.last "bar"
+} -cleanup {
+ destroy .tt
+} -result {}
test text-9.1 {TextWidgetCmd procedure, "get" option} -setup {
@@ -6408,9 +6417,9 @@ test text-27.14a {<<Modified>> virtual event - propagation to peers} -body {
} -cleanup {
destroy .t .tt
} -result {4}
-test text-27.15 {<<Selection>> virtual event} -body {
+test text-27.15 {<<Selection>> virtual event on sel tagging} -body {
set ::retval no_selection
- pack [text .t -undo 1]
+ pack [text .t]
bind .t <<Selection>> "set ::retval selection_changed"
update idletasks
.t insert end "nothing special\n"
@@ -6420,6 +6429,110 @@ test text-27.15 {<<Selection>> virtual event} -body {
} -cleanup {
destroy .t
} -result {selection_changed}
+test text-27.15a {<<Selection>> virtual event on sel removal} -body {
+ set ::retval no_selection
+ pack [text .t]
+ .t insert end "nothing special\n"
+ .t tag add sel 1.0 1.1
+ bind .t <<Selection>> "set ::retval selection_changed"
+ update idletasks
+ .t tag remove 1.0 end
+ update
+ set ::retval
+} -cleanup {
+ destroy .t
+} -result {selection_changed}
+test text-27.15b {<<Selection>> virtual event on <<PasteSelection>> inside widget selection} -body {
+ pack [text .t]
+ .t insert end "There is a selection in this text widget,\n"
+ .t insert end "and it will be impacted by the <<PasteSelection>> event received.\n"
+ .t insert end "Therefore a <<Selection>> event must fire back."
+ .t tag add sel 1.0 1.28
+ bind .t <<Selection>> "set ::retval <<Selection>>_fired"
+ update
+ set ::retval no_<<Selection>>_event_fired
+ event generate .t <<PasteSelection>> -x 15 -y 3
+ update
+ set ::retval
+} -cleanup {
+ destroy .t
+} -result {<<Selection>>_fired}
+test text-27.15c {No <<Selection>> virtual event on <<PasteSelection>> outside widget selection} -body {
+ pack [text .t]
+ .t insert end "There is a selection in this text widget,\n"
+ .t insert end "but it will not be impacted by the <<PasteSelection>> event received."
+ .t tag add sel 1.0 1.28
+ bind .t <<Selection>> "set ::retval <<Selection>>_fired"
+ update
+ set ::retval no_<<Selection>>_event_fired
+ event generate .t <<PasteSelection>> -x 15 -y 80
+ update
+ set ::retval
+} -cleanup {
+ destroy .t
+} -result {no_<<Selection>>_event_fired}
+test text-27.15d {<<Selection>> virtual event on <Delete> with cursor inside selection} -body {
+ pack [text .t]
+ .t insert end "There is a selection in this text widget,\n"
+ .t insert end "and it will be impacted by the <Delete> event received.\n"
+ .t insert end "Therefore a <<Selection>> event must fire back."
+ .t tag add sel 1.0 1.28
+ bind .t <<Selection>> "set ::retval <<Selection>>_fired"
+ update
+ set ::retval no_<<Selection>>_event_fired
+ .t mark set insert 1.15
+ focus .t
+ event generate .t <Delete>
+ update
+ set ::retval
+} -cleanup {
+ destroy .t
+} -result {<<Selection>>_fired}
+test text-27.15e {No <<Selection>> virtual event on <Delete> with cursor outside selection} -body {
+ pack [text .t]
+ .t insert end "There is a selection in this text widget,\n"
+ .t insert end "but it will not be impacted by the <Delete> event received."
+ .t tag add sel 1.0 1.28
+ bind .t <<Selection>> "set ::retval <<Selection>>_fired"
+ update
+ set ::retval no_<<Selection>>_event_fired
+ .t mark set insert 2.15
+ focus .t
+ event generate .t <Delete>
+ update
+ set ::retval
+} -cleanup {
+ destroy .t
+} -result {no_<<Selection>>_event_fired}
+test text-27.15f {<<Selection>> virtual event on <<Cut>> with a widget selection} -body {
+ pack [text .t]
+ .t insert end "There is a selection in this text widget,\n"
+ .t insert end "and it will be impacted by the <<Cut>> event received.\n"
+ .t insert end "Therefore a <<Selection>> event must fire back."
+ .t tag add sel 1.0 1.28
+ bind .t <<Selection>> "set ::retval <<Selection>>_fired"
+ update
+ set ::retval no_<<Selection>>_event_fired
+ event generate .t <<Cut>>
+ update
+ set ::retval
+} -cleanup {
+ destroy .t
+} -result {<<Selection>>_fired}
+test text-27.15g {No <<Selection>> virtual event on <<Cut>> without widget selection} -body {
+ pack [text .t]
+ .t insert end "There is a selection in this text widget,\n"
+ .t insert end "and it will be impacted by the <<Cut>> event received.\n"
+ .t insert end "Therefore a <<Selection>> event must fire back."
+ bind .t <<Selection>> "set ::retval <<Selection>>_fired"
+ update
+ set ::retval no_<<Selection>>_event_fired
+ event generate .t <<Cut>>
+ update
+ set ::retval
+} -cleanup {
+ destroy .t
+} -result {no_<<Selection>>_event_fired}
test text-27.16 {-maxundo configuration option} -body {
text .t -undo 1 -autoseparators 1 -maxundo 2
pack .t
diff --git a/tests/textTag.test b/tests/textTag.test
index 2c09e1d..8b247b9 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -1493,6 +1493,7 @@ test textTag-18.1 {TkTextPickCurrent tag bindings} -setup {
text .t -width 30 -height 4 -relief sunken -borderwidth 10 \
-highlightthickness 10 -pady 2
pack .t
+ update ; # map the window, otherwise -warp can't be done
.t insert end " Tag here " TAG " no tag here"
.t tag configure TAG -borderwidth 4 -relief raised
@@ -1502,7 +1503,6 @@ test textTag-18.1 {TkTextPickCurrent tag bindings} -setup {
bind .t <Leave> {lappend res Leave}
set res {}
- update
# Bindings must not trigger on the widget border, only over
# the actual tagged characters themselves.
event gen .t <Motion> -warp 1 -x 0 -y 0 ; update
diff --git a/tests/ttk/checkbutton.test b/tests/ttk/checkbutton.test
index 6b79287..15d365f 100644
--- a/tests/ttk/checkbutton.test
+++ b/tests/ttk/checkbutton.test
@@ -61,4 +61,13 @@ test checkbutton-1.7 "Button destroyed by click" -body {
update ; # shall not trigger error invalid command name ".top.b"
} -result {}
+# Bug [fa8de77936]
+test checkbutton-1.8 "Empty -variable" -body {
+ # shall simply not crash
+ ttk::checkbutton .cbev -variable {}
+ .cbev invoke
+} -cleanup {
+ destroy .cbev
+} -result {}
+
tcltest::cleanupTests
diff --git a/tests/ttk/entry.test b/tests/ttk/entry.test
index 0c2f0be..d303446 100644
--- a/tests/ttk/entry.test
+++ b/tests/ttk/entry.test
@@ -85,7 +85,7 @@ test entry-2.2 "Initial scroll position" -body {
# Bounding box / scrolling tests.
test entry-3.0 "Series 3 setup" -body {
ttk::style theme use default
- variable fixed fixed
+ variable fixed TkFixedFont
variable cw [font measure $fixed a]
variable ch [font metrics $fixed -linespace]
variable bd 2 ;# border + padding
@@ -280,4 +280,22 @@ test entry-9.1 "Index range invariants" -setup {
destroy .e
}
+test entry-10.1 {configuration option: "-placeholder"} -setup {
+ pack [ttk::entry .e]
+} -body {
+ .e configure -placeholder {Some text}
+ .e cget -placeholder
+} -cleanup {
+ destroy .e
+} -result {Some text}
+
+test entry-10.2 {configuration option: "-placeholderforeground"} -setup {
+ pack [ttk::entry .e]
+} -body {
+ .e configure -placeholder {Some text} -placeholderforeground red
+ .e cget -placeholderforeground
+} -cleanup {
+ destroy .e
+} -result {red}
+
tcltest::cleanupTests
diff --git a/tests/ttk/scrollbar.test b/tests/ttk/scrollbar.test
index 1f8d158..c7cab13 100644
--- a/tests/ttk/scrollbar.test
+++ b/tests/ttk/scrollbar.test
@@ -65,5 +65,28 @@ test scale-1.0 "Self-destruction" -body {
.s set 1 ; update
} -returnCodes 1 -match glob -result "*"
+test scale-2.1 "-state option" -setup {
+ ttk::scale .s
+ set res ""
+} -body {
+ # defaults
+ lappend res [.s instate disabled] [.s cget -state]
+ # set -state: instate returns accordingly
+ .s configure -state disabled
+ lappend res [.s instate disabled] [.s cget -state]
+ # back to normal
+ .s configure -state normal
+ lappend res [.s instate disabled] [.s cget -state]
+ # use state command: -state does NOT reflect it
+ .s state disabled
+ lappend res [.s instate disabled] [.s cget -state]
+ # further use state command
+ .s state readonly
+ lappend res [.s state] [.s cget -state]
+} -cleanup {
+ destroy .s
+ unset -nocomplain res
+} -result {0 normal 1 disabled 0 normal 1 normal {disabled readonly} normal}
+
tcltest::cleanupTests
diff --git a/tests/unixFont.test b/tests/unixFont.test
index e8ff90e..177dab5 100644
--- a/tests/unixFont.test
+++ b/tests/unixFont.test
@@ -66,58 +66,58 @@ proc getsize {} {
return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}
-test unixfont-1.1 {TkpGetNativeFont procedure: not native} {unix noExceed} {
+test unixfont-1.1 {TkpGetNativeFont procedure: not native} {x11 noExceed} {
list [catch {font measure {} xyz} msg] $msg
} {1 {font "" doesn't exist}}
-test unixfont-1.2 {TkpGetNativeFont procedure: native} unix {
+test unixfont-1.2 {TkpGetNativeFont procedure: native} x11 {
font measure fixed 0
} {6}
-test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} unix {
+test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} x11 {
font actual {-size 10}
set x {}
} {}
test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} \
- {unix noExceed hasTimesNew} {
+ {x11 noExceed hasTimesNew} {
set x {}
lappend x [lindex [font actual {-family "Times New Roman"}] 1]
lappend x [lindex [font actual {-family "New York"}] 1]
lappend x [lindex [font actual {-family "Times"}] 1]
} {times times times}
test unixfont-2.3 {TkpGetFontFromAttributes procedure: Courier relatives} \
- {unix noExceed hasCourierNew} {
+ {x11 noExceed hasCourierNew} {
set x {}
lappend x [lindex [font actual {-family "Courier New"}] 1]
lappend x [lindex [font actual {-family "Monaco"}] 1]
lappend x [lindex [font actual {-family "Courier"}] 1]
} {courier courier courier}
test unixfont-2.4 {TkpGetFontFromAttributes procedure: Helvetica relatives} \
- {unix noExceed hasArial} {
+ {x11 noExceed hasArial} {
set x {}
lappend x [lindex [font actual {-family "Arial"}] 1]
lappend x [lindex [font actual {-family "Geneva"}] 1]
lappend x [lindex [font actual {-family "Helvetica"}] 1]
} {helvetica helvetica helvetica}
-test unixfont-2.5 {TkpGetFontFromAttributes procedure: fallback} unix {
+test unixfont-2.5 {TkpGetFontFromAttributes procedure: fallback} x11 {
font actual {-xyz-xyz-*-*-*-*-*-*-*-*-*-*-*-*}
set x {}
} {}
-test unixfont-2.6 {TkpGetFontFromAttributes: fallback to fixed family} unix {
+test unixfont-2.6 {TkpGetFontFromAttributes: fallback to fixed family} x11 {
lindex [font actual {-family fixed -size 10}] 1
} {fixed}
-test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} unix {
+test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} x11 {
# no test available
} {}
-test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} unix {
+test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} x11 {
lindex [font actual {-family fixed -size 31}] 1
} {fixed}
-test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {unix noExceed} {
+test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {x11 noExceed} {
lindex [font actual {-family courier}] 1
} {courier}
-test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} unix {
+test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} x11 {
lindex [font actual {-family courier -size 37}] 3
} {37}
-test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} unix {
+test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} x11 {
# On Linux, XListFonts() was returning names for fonts that do not
# actually exist, causing the subsequent XLoadQueryFont() to fail
# unexpectedly. Now falls back to another font if that happens.
@@ -126,114 +126,114 @@ test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} unix {
set x {}
} {}
-test unixfont-3.1 {TkpDeleteFont procedure} unix {
+test unixfont-3.1 {TkpDeleteFont procedure} x11 {
font actual {-family xyz}
set x {}
} {}
-test unixfont-4.1 {TkpGetFontFamilies procedure} unix {
+test unixfont-4.1 {TkpGetFontFamilies procedure} x11 {
font families
set x {}
} {}
-test unixfont-5.1 {Tk_MeasureChars procedure: no chars to be measured} unix {
+test unixfont-5.1 {Tk_MeasureChars procedure: no chars to be measured} x11 {
.b.l config -text "000000" -wrap [expr $ax*3]
.b.l config -wrap 0
} {}
-test unixfont-5.2 {Tk_MeasureChars procedure: no right margin} unix {
+test unixfont-5.2 {Tk_MeasureChars procedure: no right margin} x11 {
.b.l config -text "000000"
} {}
-test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} unix {
+test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} x11 {
.b.l config -text "0"
.b.l config -text "\377"
.b.l config -text "0\3770\377"
.b.l config -text "000000000000000"
} {}
.b.l config -wrap [expr $ax*10]
-test unixfont-5.4 {Tk_MeasureChars procedure: reached right edge} unix {
+test unixfont-5.4 {Tk_MeasureChars procedure: reached right edge} x11 {
.b.l config -text "0000000000000"
getsize
} "[expr $ax*10] [expr $ay*2]"
-test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} unix {
+test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} x11 {
.b.l config -text "000000"
getsize
} "[expr $ax*6] $ay"
-test unixfont-5.6 {Tk_MeasureChars procedure: find last word} unix {
+test unixfont-5.6 {Tk_MeasureChars procedure: find last word} x11 {
.b.l config -text "000000 00000"
getsize
} "[expr $ax*6] [expr $ay*2]"
-test unixfont-5.7 {Tk_MeasureChars procedure: already saw space in line} unix {
+test unixfont-5.7 {Tk_MeasureChars procedure: already saw space in line} x11 {
.b.l config -text "000000 00000"
getsize
} "[expr $ax*6] [expr $ay*2]"
-test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} unix {
+test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} x11 {
.b.l config -text "00 000 00000"
getsize
} "[expr $ax*7] [expr $ay*2]"
-test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} unix {
+test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} x11 {
.b.c dchars $t 0 end
.b.c insert $t 0 "0000"
.b.c index $t @[expr int($ax*2.5)],1
} {2}
-test unixfont-5.10 {Tk_MeasureChars procedure: TK_AT_LEAST_ONE} unix {
+test unixfont-5.10 {Tk_MeasureChars procedure: TK_AT_LEAST_ONE} x11 {
.b.l config -text "000000000000"
getsize
} "[expr $ax*10] [expr $ay*2]"
-test unixfont-5.11 {Tk_MeasureChars: TK_AT_LEAST_ONE + not even one char fit!} unix {
+test unixfont-5.11 {Tk_MeasureChars: TK_AT_LEAST_ONE + not even one char fit!} x11 {
set a [.b.l cget -wrap]
.b.l config -text "000000" -wrap 1
set x [getsize]
.b.l config -wrap $a
set x
} "$ax [expr $ay*6]"
-test unixfont-5.12 {Tk_MeasureChars procedure: include eol spaces} unix {
+test unixfont-5.12 {Tk_MeasureChars procedure: include eol spaces} x11 {
.b.l config -text "000 \n000"
getsize
} "[expr $ax*6] [expr $ay*2]"
-test unixfont-6.1 {Tk_DrawChars procedure: loop test} unix {
+test unixfont-6.1 {Tk_DrawChars procedure: loop test} x11 {
.b.l config -text "a"
update
} {}
-test unixfont-6.2 {Tk_DrawChars procedure: loop test} unix {
+test unixfont-6.2 {Tk_DrawChars procedure: loop test} x11 {
.b.l config -text "abcd"
update
} {}
-test unixfont-6.3 {Tk_DrawChars procedure: special char} unix {
+test unixfont-6.3 {Tk_DrawChars procedure: special char} x11 {
.b.l config -text "\001"
update
} {}
-test unixfont-6.4 {Tk_DrawChars procedure: normal then special} unix {
+test unixfont-6.4 {Tk_DrawChars procedure: normal then special} x11 {
.b.l config -text "ab\001"
update
} {}
-test unixfont-6.5 {Tk_DrawChars procedure: ends with special} unix {
+test unixfont-6.5 {Tk_DrawChars procedure: ends with special} x11 {
.b.l config -text "ab\001"
update
} {}
-test unixfont-6.6 {Tk_DrawChars procedure: more normal chars at end} unix {
+test unixfont-6.6 {Tk_DrawChars procedure: more normal chars at end} x11 {
.b.l config -text "ab\001def"
update
} {}
-test unixfont-7.1 {DrawChars procedure: no effects} unix {
+test unixfont-7.1 {DrawChars procedure: no effects} x11 {
.b.l config -text "abc"
update
} {}
-test unixfont-7.2 {DrawChars procedure: underlining} unix {
+test unixfont-7.2 {DrawChars procedure: underlining} x11 {
set f [.b.l cget -font]
.b.l config -text "abc" -font "courier 10 underline"
update
.b.l config -font $f
} {}
-test unixfont-7.3 {DrawChars procedure: overstrike} unix {
+test unixfont-7.3 {DrawChars procedure: overstrike} x11 {
set f [.b.l cget -font]
.b.l config -text "abc" -font "courier 10 overstrike"
update
.b.l config -font $f
} {}
-test unixfont-8.1 {AllocFont procedure: use old font} unix {
+test unixfont-8.1 {AllocFont procedure: use old font} x11 {
font create xyz
button .c -font xyz
font configure xyz -family times
@@ -241,10 +241,10 @@ test unixfont-8.1 {AllocFont procedure: use old font} unix {
destroy .c
font delete xyz
} {}
-test unixfont-8.2 {AllocFont procedure: parse information from XLFD} unix {
+test unixfont-8.2 {AllocFont procedure: parse information from XLFD} x11 {
expr {[lindex [font actual {-family times -size 0}] 3] == 0}
} {0}
-test unixfont-8.3 {AllocFont procedure: can't parse info from name} unix {
+test unixfont-8.3 {AllocFont procedure: can't parse info from name} x11 {
catch {unset fontArray}
# check that font actual returns the correct attributes.
# the values of those attributes are system dependent.
@@ -253,7 +253,7 @@ test unixfont-8.3 {AllocFont procedure: can't parse info from name} unix {
catch {unset fontArray}
set result
} {-family -overstrike -size -slant -underline -weight}
-test unixfont-8.4 {AllocFont procedure: classify characters} unix {
+test unixfont-8.4 {AllocFont procedure: classify characters} x11 {
set x 0
incr x [font measure $courier "\u4000"] ;# 6
incr x [font measure $courier "\002"] ;# 4
@@ -261,38 +261,38 @@ test unixfont-8.4 {AllocFont procedure: classify characters} unix {
incr x [font measure $courier "\101"] ;# 1
set x
} [expr $cx*13]
-test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} unix {
+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} unix {
+test unixfont-8.6 {AllocFont procedure: setup widths of special chars} x11 {
set x 0
incr x [font measure $courier "\001"] ;# 4
incr x [font measure $courier "\002"] ;# 4
incr x [font measure $courier "\012"] ;# 2
set x
} [expr $cx*10]
-test unixfont-8.7 {AllocFont procedure: XA_UNDERLINE_POSITION} unix {
+test unixfont-8.7 {AllocFont procedure: XA_UNDERLINE_POSITION} x11 {
catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
set x {}
} {}
-test unixfont-8.8 {AllocFont procedure: no XA_UNDERLINE_POSITION} unix {
+test unixfont-8.8 {AllocFont procedure: no XA_UNDERLINE_POSITION} x11 {
catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific}
set x {}
} {}
-test unixfont-8.9 {AllocFont procedure: XA_UNDERLINE_THICKNESS} unix {
+test unixfont-8.9 {AllocFont procedure: XA_UNDERLINE_THICKNESS} x11 {
catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
set x {}
} {}
-test unixfont-8.10 {AllocFont procedure: no XA_UNDERLINE_THICKNESS} unix {
+test unixfont-8.10 {AllocFont procedure: no XA_UNDERLINE_THICKNESS} x11 {
catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific}
set x {}
} {}
-test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} unix {
+test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} x11 {
catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
set x {}
} {}
-test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} unix {
+test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} x11 {
.b.c dchars $t 0 end
.b.c insert $t 0 "0\a0"
set x {}
@@ -301,7 +301,7 @@ test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} unix {
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} unix {
+test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} x11 {
.b.c dchars $t 0 end
.b.c insert $t 0 "0\0010"
set x {}
diff --git a/tests/winWm.test b/tests/winWm.test
index b339b2a..d251eb8 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -245,7 +245,7 @@ test winWm-5.2 {UpdateGeometryInfo: menu resizing} -constraints win -setup {
update
set y [winfo rooty .t]
lappend result [winfo height .t]
- menu .t.m
+ menu .t.m -tearoff 1
.t configure -menu .t.m
.t.m add command -label foo
.t.m add command -label "thisisreallylong"
generated by cgit v0.12 at 2025-04-03 19:32:34 (GMT)