Import Tk 8.6.11

This commit is contained in:
Steve Dower
2021-03-30 00:54:10 +01:00
parent 42c69189d9
commit 070b8750b0
403 changed files with 21608 additions and 16269 deletions

View File

@@ -7,7 +7,7 @@
# Copyright (c) 2008 Donal K. Fellows
# All rights reserved.
package require tcltest 2.1
package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
imageInit
@@ -537,10 +537,10 @@ test canvas-12.1 {canvas mm obj, patch SF-403327, 102471} -setup {
destroy .c
pack [canvas .c]
} -body {
set qx [expr {1.+1.}]
# qx has type double and no string representation
set qx [expr {1.+1.}]
# qx has type double and no string representation
.c scale all $qx 0 1. 1.
# qx has now type MMRep and no string representation
# qx has now type MMRep and no string representation
list $qx [string length $qx]
} -result {2.0 3}
test canvas-12.2 {canvas mm obj, patch SF-403327, 102471} -setup {
@@ -549,9 +549,9 @@ test canvas-12.2 {canvas mm obj, patch SF-403327, 102471} -setup {
} -body {
set val 10
incr val
# qx has type double and no string representation
# qx has type double and no string representation
.c scale all $val 0 1 1
# qx has now type MMRep and no string representation
# qx has now type MMRep and no string representation
incr val
} -result 12
@@ -727,7 +727,7 @@ test canvas-15.19 "basic coords check: centimeters are larger than pixels" -setu
destroy .c
canvas .c
} -body {
set id [.c create rect 0 0 1cm 1cm]
set id [.c create rect 0 0 1cm 1cm]
expr {[lindex [.c coords $id] 2]>1}
} -result {1}
destroy .c
@@ -950,6 +950,48 @@ test canvas-19.11 {rchars method - errors} -setup {
destroy .c
} -returnCodes error -result {bad index "foo"}
test canvas-20.1 {addtag/dtag - no shuffling of tag sequence} -setup {
canvas .c
.c create text 100 100 -text Hello
} -body {
for {set i 1} {$i < 5} {incr i} {
.c addtag tag$i all
}
# [.c addtags] only adds tags that are not already present
.c addtag tag1 all ; # no effect
set res [list [.c gettags 1]]
.c dtag 1 tag2
lappend res [.c gettags 1]
} -cleanup {
destroy .c
} -result {{tag1 tag2 tag3 tag4} {tag1 tag3 tag4}}
test canvas-20.2 {tag deletion - multiple tags with same name, no shuffling} -setup {
canvas .c
.c create text 100 100 -text Hello
} -body {
# [.c itemconfigure -tags] lets the user add duplicate tags
# this is not a problem although inconsistent with [.c addtags]
.c itemconfigure 1 -tags {tagA tagB tagA tagA tagC tagA}
set res [list [.c gettags 1]]
.c dtag 1 tagA
lappend res [.c gettags 1]
} -cleanup {
destroy .c
} -result {{tagA tagB tagA tagA tagC tagA} {tagB tagC}}
test canvas-20.3 {tag deletion - all tags match} -setup {
canvas .c
.c create text 100 100 -text Hello
} -body {
# [.c itemconfigure -tags] lets the user add duplicate tags
# this is not a problem although inconsistent with [.c addtags]
.c itemconfigure 1 -tags {tagA tagA tagA tagA tagA tagA}
set res [list [.c gettags 1]]
.c dtag 1 tagA
lappend res [.c gettags 1]
} -cleanup {
destroy .c
} -result {{tagA tagA tagA tagA tagA tagA} {}}
# cleanup
imageCleanup
cleanupTests