summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/bevel.tcl41
-rw-r--r--tests/entry.test35
-rw-r--r--tests/event.test4
-rw-r--r--tests/font.test3
-rw-r--r--tests/listbox.test39
-rw-r--r--tests/menu.test18
-rw-r--r--tests/panedwindow.test23
-rw-r--r--tests/scrollbar.test30
-rw-r--r--tests/spinbox.test26
-rw-r--r--tests/text.test126
-rw-r--r--tests/textDisp.test82
-rw-r--r--tests/textIndex.test13
-rw-r--r--tests/textWind.test14
-rw-r--r--tests/ttk/notebook.test21
-rw-r--r--tests/ttk/spinbox.test2
-rw-r--r--tests/winButton.test8
16 files changed, 431 insertions, 54 deletions
diff --git a/tests/bevel.tcl b/tests/bevel.tcl
index 950b714..4af60f3 100644
--- a/tests/bevel.tcl
+++ b/tests/bevel.tcl
@@ -42,6 +42,7 @@ significance:
r - should appear raised
u - should appear raised and also slightly offset vertically
s - should appear sunken
+S - should appear solid
n - preceding relief should extend right to end of line.
* - should appear "normal"
x - extra long lines to allow horizontal scrolling.
@@ -125,15 +126,33 @@ foreach i {1 2 3} {
.t.t insert end *****
.t.t insert end rrr r1
-
-
-
-
-
-
-
-
-
-
-
+font configure TkFixedFont -size 20
+.t.t tag configure sol100 -relief solid -borderwidth 100 \
+ -foreground red -font TkFixedFont
+.t.t tag configure sol12 -relief solid -borderwidth 12 \
+ -foreground red -font TkFixedFont
+.t.t tag configure big -font TkFixedFont
+set ind [.t.t index end]
+
+.t.t insert end "\n\nBorders do not leak on the neighbour chars"
+.t.t insert end "\nOnly \"S\" is on dark background"
+.t.t insert end {
+ xxx
+ x} {} S sol100 {x
+ xxx}
+
+.t.t insert end "\n\nA very thick border grows toward the inside of the tagged area only"
+.t.t insert end "\nOnly \"S\" is on dark background"
+.t.t insert end {
+ xxxx} {} SSSSS sol100 {xxxx
+ x} {} SSSSSSSSSSSSSSSSSS sol100 {x
+ xxx} {} SSSSSSSSS sol100 xxxx {}
+
+.t.t insert end "\n\nA thinner border is continuous"
+.t.t insert end {
+ xxxx} {} SSSSS sol12 {xxxx
+ x} {} SSSSSSSSSSSSSSSSSS sol12 {x
+ xxx} {} SSSSSSSSS sol12 xxxx {}
+
+.t.t tag add big $ind end
diff --git a/tests/entry.test b/tests/entry.test
index ffdbf45..da3637d 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -778,6 +778,14 @@ test entry-6.11 {EntryComputeGeometry procedure} win {
[expr 8+5*[font measure {helvetica 12} .]] \
[expr 8+5*[font measure {helvetica 12} X]] \
[expr 8+[font measure {helvetica 12} 12345]]]
+test entry-6.12 {EntryComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief raised -width 20
+ pack .e
+ .e insert end "012\t456\t"
+ update
+ list [.e index @81] [.e index @82] [.e index @116] [.e index @117]
+} {6 7 7 8}
catch {destroy .e}
entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
@@ -1613,13 +1621,32 @@ test entry-22.1 {lost namespaced textvar} {
namespace eval test { variable foo {a b} }
entry .e -textvariable ::test::foo
namespace delete test
- .e insert end "more stuff"
- .e delete 5 end
- catch {set ::test::foo} result
- list [.e get] [.e cget -textvar] $result
+ catch {.e insert end "more stuff"} result1
+ catch {.e delete 5 end} result2
+ catch {set ::test::foo} result3
+ list [.e get] [.e cget -textvar] $result1 $result2 $result3
} [list "a bmo" ::test::foo \
+ {can't set "::test::foo": parent namespace doesn't exist} \
+ {can't set "::test::foo": parent namespace doesn't exist} \
{can't read "::test::foo": no such variable}]
+test entry-23.1 {error in trace proc attached to the textvariable} {
+ destroy .e
+ trace variable myvar w traceit
+ proc traceit args {error "Intentional error here!"}
+ entry .e -textvariable myvar
+ catch {.e insert end mystring} result1
+ catch {.e delete 0} result2
+ list $result1 $result2
+} [list {can't set "myvar": Intentional error here!} \
+ {can't set "myvar": Intentional error here!}]
+
+test entry-24.1 {textvariable lives in a non-existing namespace} {
+ destroy .e
+ catch {entry .e -textvariable thisnsdoesntexist::myvar} result1
+ set result1
+} {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist}
+
destroy .e
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
diff --git a/tests/event.test b/tests/event.test
index fa75610..95be5f4 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -705,7 +705,7 @@ test event-7.1(double-click) {A double click on a lone character
set result
} {1.3 A 1.3 A}
test event-7.2(double-click) {A double click on a lone character\
- in an entry widget should select that character} {knownBug} {
+ in an entry widget should select that character} {
destroy .t
set t [toplevel .t]
set e [entry $t.e]
@@ -766,7 +766,7 @@ test event-7.2(double-click) {A double click on a lone character\
lappend result [_get_selection $e]
set result
-} {3 A 4 A}
+} {4 A 4 A}
# cleanup
diff --git a/tests/font.test b/tests/font.test
index a02cc2e..2defb29 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -829,7 +829,7 @@ test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
lappend x [getsize]
.b.l config -wrap 0
set x
-} "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
+} "{[expr $ax*8] $ay} {[expr $ax*8] [expr $ay*2]}"
test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
set x {}
.b.l config -text "000 000" -wrap [expr $ax*5]
@@ -1162,6 +1162,7 @@ test font-33.1 {Tk_TextWidth procedure} {
test font-34.1 {ConfigAttributesObj procedure: arguments} {
# (Tcl_GetIndexFromObj() != TCL_OK)
+ set x {}
setup
list [catch {font create xyz -xyz} msg] $msg
} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
diff --git a/tests/listbox.test b/tests/listbox.test
index b4046b6..62b8cc1 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -2169,6 +2169,45 @@ test listbox-30.1 {Bug 3607326} -setup {
unset -nocomplain a
} -result * -match glob -returnCodes error
+test listbox-31.1 {<<ListboxSelect>> event} -setup {
+ destroy .l
+ unset -nocomplain res
+} -body {
+ pack [listbox .l -state normal]
+ update
+ bind .l <<ListboxSelect>> {lappend res [%W curselection]}
+ .l insert end a b c
+ focus -force .l
+ event generate .l <1> -x 5 -y 5 ; # <<ListboxSelect>> fires
+ .l configure -state disabled
+ focus -force .l
+ event generate .l <Control-Home> ; # <<ListboxSelect>> does NOT fire
+ .l configure -state normal
+ focus -force .l
+ event generate .l <Control-End> ; # <<ListboxSelect>> fires
+ .l selection clear 0 end ; # <<ListboxSelect>> does NOT fire
+ .l selection set 1 1 ; # <<ListboxSelect>> does NOT fire
+ lappend res [.l curselection]
+} -cleanup {
+ destroy .l
+ unset -nocomplain res
+} -result {0 2 1}
+
+test listbox-31.2 {<<ListboxSelect>> event on lost selection} -setup {
+ destroy .l
+} -body {
+ pack [listbox .l -exportselection true]
+ update
+ bind .l <<ListboxSelect>> {lappend res [list [selection own] [%W curselection]]}
+ .l insert end a b c
+ focus -force .l
+ event generate .l <1> -x 5 -y 5 ; # <<ListboxSelect>> fires
+ selection clear ; # <<ListboxSelect>> fires again
+ set res
+} -cleanup {
+ destroy .l
+} -result {{.l 0} {{} {}}}
+
resetGridInfo
deleteWindows
option clear
diff --git a/tests/menu.test b/tests/menu.test
index 3cb47c3..c797281 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -754,8 +754,13 @@ test menu-3.41 {MenuWidgetCmd procedure, "index" option} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
- list [catch {.m1 index "test"} msg] $msg [destroy .m1]
-} {0 1 {}}
+ .m1 add command -label "3"
+ .m1 add command -label "another label"
+ .m1 add command -label "end"
+ .m1 add command -label "3a"
+ .m1 add command -label "final entry"
+ list [.m1 index "test"] [.m1 index "3"] [.m1 index "3a"] [.m1 index "end"] [destroy .m1]
+} {1 3 5 6 {}}
test menu-3.42 {MenuWidgetCmd procedure, "insert" option} {
catch {destroy .m1}
menu .m1
@@ -2561,6 +2566,15 @@ test menu-36.1 {menu -underline string overruns Bug 1599877} {} {
tk::TraverseToMenu . "e"
} {}
+test menu-37.1 {menubar menues cannot be posted - bug 2160206} {} {
+ # On Linux the following used to panic
+ # It now returns an error (on all platforms)
+ catch {destroy .m}
+ menu .m -type menubar
+ list [catch ".m post 1 1" msg] $msg
+} {1 {a menubar menu cannot be posted}}
+
+
# cleanup
deleteWindows
cleanupTests
diff --git a/tests/panedwindow.test b/tests/panedwindow.test
index 724b40d..b075e18 100644
--- a/tests/panedwindow.test
+++ b/tests/panedwindow.test
@@ -29,24 +29,31 @@ foreach {testName testData} {
20 20 badValue {bad screen distance "badValue"}}
panedwindow-1.8 {-opaqueresize
true 1 foo {expected boolean value but got "foo"}}
- panedwindow-1.9 {-orient
+ panedwindow-1.9 {-proxybackground
+ "#f0a0a0" "#f0a0a0" non-existent {unknown color name "non-existent"}}
+ panedwindow-1.10 {-proxyborderwidth
+ 1.3 1.3 badValue {bad screen distance "badValue"}}
+ panedwindow-1.11 {-proxyrelief
+ groove groove
+ 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ panedwindow-1.12 {-orient
horizontal horizontal
badValue {bad orient "badValue": must be horizontal or vertical}}
- panedwindow-1.10 {-relief
+ panedwindow-1.13 {-relief
groove groove
1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
- panedwindow-1.11 {-sashcursor
+ panedwindow-1.14 {-sashcursor
arrow arrow badValue {bad cursor spec "badValue"}}
- panedwindow-1.12 {-sashpad
+ panedwindow-1.15 {-sashpad
1.3 1 badValue {bad screen distance "badValue"}}
- panedwindow-1.13 {-sashrelief
+ panedwindow-1.16 {-sashrelief
groove groove
1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
- panedwindow-1.14 {-sashwidth
+ panedwindow-1.17 {-sashwidth
10 10 badValue {bad screen distance "badValue"}}
- panedwindow-1.15 {-showhandle
+ panedwindow-1.18 {-showhandle
true 1 foo {expected boolean value but got "foo"}}
- panedwindow-1.16 {-width
+ panedwindow-1.19 {-width
402 402 badValue {bad screen distance "badValue"}}
} {
lassign $testData optionName goodIn goodOut badIn badOut
diff --git a/tests/scrollbar.test b/tests/scrollbar.test
index 5d4334f..35f48bd 100644
--- a/tests/scrollbar.test
+++ b/tests/scrollbar.test
@@ -632,6 +632,36 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} {
list [winfo children .] [interp hidden]
} [list {} $l]
+test scrollbar-10.1 {<MouseWheel> event on scrollbar} -constraints {win|unix} -setup {
+ destroy .t .s
+} -body {
+ pack [text .t -yscrollcommand {.s set}] -side left
+ for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"}
+ pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left
+ update
+ focus -force .s
+ event generate .s <MouseWheel> -delta -120
+ after 200 {set eventprocessed 1} ; vwait eventprocessed
+ .t index @0,0
+} -cleanup {
+ destroy .t .s
+} -result {5.0}
+
+test scrollbar-10.2 {<MouseWheel> event on scrollbar} -constraints {win|unix} -setup {
+ destroy .t .s
+} -body {
+ pack [text .t -xscrollcommand {.s set} -wrap none] -side top
+ for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "}
+ pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top
+ update
+ focus -force .s
+ event generate .s <Shift-MouseWheel> -delta -120
+ after 200 {set eventprocessed 1} ; vwait eventprocessed
+ .t index @0,0
+} -cleanup {
+ destroy .t .s
+} -result {1.4}
+
catch {destroy .s}
catch {destroy .t}
diff --git a/tests/spinbox.test b/tests/spinbox.test
index 430e176..68c6fae 100644
--- a/tests/spinbox.test
+++ b/tests/spinbox.test
@@ -1568,9 +1568,9 @@ test spinbox-22.3 {spinbox config, -from changes SF bug 559078} {
set val
} {6}
-test entry-23.1 {selection present while disabled, bug 637828} {
+test spinbox-23.1 {selection present while disabled, bug 637828} {
destroy .e
- entry .e
+ spinbox .e
.e insert end 0123456789
.e select from 3
.e select to 6
@@ -1583,6 +1583,28 @@ test entry-23.1 {selection present while disabled, bug 637828} {
} {1 1 345}
destroy .e
+
+test spinbox-24.1 {error in trace proc attached to the textvariable} {
+ destroy .s
+ trace variable myvar w traceit
+ proc traceit args {error "Intentional error here!"}
+ spinbox .s -textvariable myvar -from 1 -to 10
+ catch {.s set mystring} result1
+ catch {.s insert 0 mystring} result2
+ catch {.s delete 0} result3
+ catch {.s invoke buttonup} result4
+ list $result1 $result2 $result3 $result4
+} [list {can't set "myvar": Intentional error here!} \
+ {can't set "myvar": Intentional error here!} \
+ {can't set "myvar": Intentional error here!} \
+ {can't set "myvar": Intentional error here!}]
+
+test spinbox-25.1 {textvariable lives in a non-existing namespace} {
+ destroy .s
+ catch {spinbox .s -textvariable thisnsdoesntexist::myvar} result1
+ set result1
+} {can't trace "thisnsdoesntexist::myvar": parent namespace doesn't exist}
+
catch {unset ::e ::vVals}
##
diff --git a/tests/text.test b/tests/text.test
index e75f38a..2ca5d54 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -714,22 +714,23 @@ test text-9.2.45 {TextWidgetCmd procedure, "count" option} -setup {
} -result {0}
test text-9.2.46 {TextWidgetCmd procedure, "count" option} -setup {
toplevel .mytop
- pack [text .mytop.t]
- wm geometry .mytop 100x300+0+0
+ pack [text .mytop.t -font TkFixedFont -bd 0 -padx 0 -wrap char]
+ set spec [font measure TkFixedFont "Line 1+++Line 1---Li"] ; # 20 chars
+ append spec x300+0+0
+ wm geometry .mytop $spec
.mytop.t delete 1.0 end
update
set res {}
} -body {
for {set i 1} {$i < 5} {incr i} {
- # 0 1 2 3 4
- # 012345 678901234 567890123 456789012 34567890123456789
+ # 0 1 2 3 4
+ # 012345 678901234 567890123 456789012 34567890123456789
.mytop.t insert end "Line $i+++Line $i---Line $i///Line $i - This is Line [format %c [expr 64+$i]]\n"
}
.mytop.t tag configure hidden -elide true
- .mytop.t tag add hidden 2.15 3.10
- .mytop.t configure -wrap char
+ .mytop.t tag add hidden 2.30 3.10
lappend res [.mytop.t count -displaylines 2.0 3.0]
- lappend res [.mytop.t count -displaylines 2.0 3.40]
+ lappend res [.mytop.t count -displaylines 2.0 3.50]
} -cleanup {
destroy .mytop
} -result {1 3}
@@ -744,6 +745,10 @@ test text-9.2.47 {TextWidgetCmd procedure, "count" option} -setup {
.t tag configure hidden -elide true
.t tag add hidden 5.7 11.0
update
+ # next line to be fully sure that asynchronous line heights calculation is
+ # up-to-date otherwise this test may fail (depending on the computer
+ # performance), especially when the . toplevel has small height
+ .t count -update -ypixels 1.0 end
set y1 [lindex [.t yview] 1]
.t count -displaylines 5.0 11.0
set y2 [lindex [.t yview] 1]
@@ -2780,6 +2785,24 @@ test text-20.185 {TextSearchCmd, elide up to match} {
lappend res [.t2 search -regexp bc 1.0]
lappend res [.t2 search -regexp c 1.0]
} {{} {} 1.0 2.1 2.0 3.1 2.0 3.0}
+test text-20.185.1 {TextSearchCmd, elide up to match, with UTF-8 chars before the match} {
+ deleteWindows
+ pack [text .t2]
+ .t2 tag configure e -elide 0
+ .t2 insert end A {} xyz e bb\n
+ .t2 insert end \u00c4 {} xyz e bb
+ set res {}
+ lappend res [.t2 search bb 1.0 "1.0 lineend"]
+ lappend res [.t2 search bb 2.0 "2.0 lineend"]
+ lappend res [.t2 search -regexp bb 1.0 "1.0 lineend"]
+ lappend res [.t2 search -regexp bb 2.0 "2.0 lineend"]
+ .t2 tag configure e -elide 1
+ lappend res [.t2 search bb 1.0 "1.0 lineend"]
+ lappend res [.t2 search bb 2.0 "2.0 lineend"]
+ lappend res [.t2 search -regexp bb 1.0 "1.0 lineend"]
+ lappend res [.t2 search -regexp -elide bb 2.0 "2.0 lineend"]
+ lappend res [.t2 search -regexp bb 2.0 "2.0 lineend"]
+} {1.4 2.4 1.4 2.4 1.4 2.4 1.4 2.4 2.4}
test text-20.186 {TextSearchCmd, strict limits} {
deleteWindows
pack [text .t2]
@@ -3204,6 +3227,95 @@ test text-25.18 {patch 1469210 - inserting after undo} -setup {
} -cleanup {
destroy .t
} -result 1
+test text-25.19 {patch 1669632 (i) - undo after <Control-1>} -setup {
+ destroy .t
+} -body {
+ text .t -undo 1
+ .t insert end foo\nbar
+ .t edit reset
+ .t insert 2.2 WORLD
+ event generate .t <Control-1> -x 1 -y 1
+ .t insert insert HELLO
+ .t edit undo
+ .t get 2.2 2.7
+} -cleanup {
+ destroy .t
+} -result WORLD
+test text-25.20 {patch 1669632 (iv) - undo after <Control-backslash>} -setup {
+ destroy .t
+} -body {
+ toplevel .top
+ pack [text .top.t -undo 1]
+ .top.t insert end "This is an example text"
+ .top.t edit reset
+ .top.t mark set insert 1.5
+ .top.t insert 1.5 HELLO
+ .top.t tag add sel 1.10 1.12
+ update
+ focus -force .top.t
+ event generate .top.t <Control-backslash>
+ .top.t insert insert " WORLD "
+ .top.t edit undo
+ .top.t get 1.5 1.10
+} -cleanup {
+ destroy .top.t .top
+} -result HELLO
+test text-25.21 {patch 1669632 (vii) - <<Undo>> shall not remove separators} -setup {
+ destroy .t
+} -body {
+ text .t -undo 1
+ .t insert end "This is an example text"
+ .t edit reset
+ .t insert 1.5 "WORLD "
+ event generate .t <Control-1> -x 1 -y 1
+ .t insert insert HELLO
+ event generate .t <<Undo>>
+ .t insert insert E
+ event generate .t <<Undo>>
+ .t get 1.0 "1.0 lineend"
+} -cleanup {
+ destroy .t
+} -result "This WORLD is an example text"
+test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup {
+ destroy .t
+} -body {
+ toplevel .top
+ pack [text .top.t -undo 1]
+ .top.t insert end "This is an example text"
+ .top.t edit reset
+ .top.t mark set insert 1.5
+ .top.t insert 1.5 "A"
+ update
+ focus -force .top.t
+ event generate .top.t <Delete>
+ event generate .top.t <Shift-Right>
+ event generate .top.t <<Clear>>
+ event generate .top.t <Delete>
+ event generate .top.t <<Undo>>
+ .top.t get 1.0 "1.0 lineend"
+} -cleanup {
+ destroy .top.t .top
+} -result "This A an example text"
+ test text-25.23 {patch 1669632 (v) - <<Cut>> is atomic} -setup {
+ destroy .t
+} -body {
+ toplevel .top
+ pack [text .top.t -undo 1]
+ .top.t insert end "This is an example text"
+ .top.t edit reset
+ .top.t mark set insert 1.5
+ .top.t insert 1.5 "A"
+ update
+ focus -force .top.t
+ event generate .top.t <Delete>
+ event generate .top.t <Shift-Right>
+ event generate .top.t <<Cut>>
+ event generate .top.t <Delete>
+ event generate .top.t <<Undo>>
+ .top.t get 1.0 "1.0 lineend"
+} -cleanup {
+ destroy .top.t .top
+} -result "This A an example text"
test text-26.1 {bug fix - 624372, ControlUtfProc long lines} {
destroy .t
diff --git a/tests/textDisp.test b/tests/textDisp.test
index aed842c..bb009ad 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -615,6 +615,10 @@ catch {destroy .f2}
.t configure -borderwidth 0 -wrap char
wm geom . {}
update
+set bw [.t cget -borderwidth]
+set px [.t cget -padx]
+set py [.t cget -pady]
+set hlth [.t cget -highlightthickness]
test textDisp-4.7 {UpdateDisplayInfo, filling in extra vertical space} {
# This test was failing on Windows because the title bar on .
# was a certain minimum size and it was interfering with the size
@@ -653,7 +657,7 @@ test textDisp-4.9 {UpdateDisplayInfo, filling in extra vertical space} {textfont
update
.t delete 15.0 end
list [.t bbox 7.0] [.t bbox 12.0]
-} [list [list 3 [expr {2*$fixedDiff + 29}] 7 $fixedHeight] [list 3 [expr {7*$fixedDiff + 94}] 7 $fixedHeight]]
+} [list [list [expr {$hlth + $px + $bw}] [expr {$hlth + $py + $bw + 2 * $fixedHeight}] $fixedWidth $fixedHeight] [list [expr {$hlth + $px + $bw}] [expr {$hlth + $py + $bw + 7 * $fixedHeight}] $fixedWidth $fixedHeight]]
test textDisp-4.10 {UpdateDisplayInfo, filling in extra vertical space} {
.t delete 1.0 end
.t insert end "1\n2\n3\n4\n5\nLine 6 is such a long line that it wraps around.\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17"
@@ -1177,16 +1181,15 @@ test textDisp-8.12 {TkTextChanged, moving the insert cursor redraws only past an
.t mark set insert 3.8 ; # within the same line
update
lappend res $tk_textRedraw
- # This last one is tricky: correct result really is {2.0 3.0} when
- # calling .t mark set insert, two calls to TkTextChanged are done:
- # (a) to redraw the line of the past position of the cursor
- # (b) to redraw the line of the new position of the cursor
- # During (a) the display line showing the cursor gets unlinked,
- # which leads TkTextChanged in (b) to schedule a redraw starting
- # one line _before_ the line containing the insert cursor. This is
- # because during (b) findDLine cannot return the display line the
- # cursor is in since this display line was just unlinked in (a).
-} {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {2.0 3.0}}
+} {{8.0 9.0} {8.0 12.0} {8.0 12.0} {3.0 8.0} {3.0 4.0}}
+test textDisp-8.13 {TkTextChanged, used to crash, see [06c1433906]} {
+ .t delete 1.0 end
+ .t insert 1.0 \nLine2\nLine3\n
+ update
+ .t insert 3.0 ""
+ .t delete 1.0 2.0
+ update idletasks
+} {}
test textDisp-9.1 {TkTextRedrawTag} {
.t configure -wrap char
@@ -1329,6 +1332,30 @@ test textDisp-9.13 {TkTextRedrawTag} {
update
list $tk_textRelayout $tk_textRedraw
} {{2.0 6.0 7.0} {2.0 6.0 7.0}}
+test textDisp-9.14 {TkTextRedrawTag} {
+ pack [text .tnocrash]
+ for {set i 1} {$i < 6} {incr i} {
+ .tnocrash insert end \nfoo$i
+ }
+ .tnocrash tag configure mytag1 -relief raised
+ .tnocrash tag configure mytag2 -relief solid
+ update
+ proc doit {} {
+ .tnocrash tag add mytag1 4.0 5.0
+ .tnocrash tag add mytag2 4.0 5.0
+ after idle {
+ .tnocrash tag remove mytag1 1.0 end
+ .tnocrash tag remove mytag2 1.0 end
+ }
+ .tnocrash delete 1.0 2.0
+ }
+ doit ; # must not crash
+ after 500 {
+ destroy .tnocrash
+ set done 1
+ }
+ vwait done
+} {}
test textDisp-10.1 {TkTextRelayoutWindow} {
.t configure -wrap char
@@ -1570,6 +1597,17 @@ test textDisp-11.20 {TkTextSetYView, see in elided lines} {
# this shall not crash (null chunkPtr in TkTextSeeCmd is tested)
.top.t see 3.0
} {}
+test textDisp-11.21 {TkTextSetYView, window height smaller than the line height} {
+ .top.t delete 1.0 end
+ for {set i 1} {$i <= 10} {incr i} {
+ .top.t insert end "Line $i\n"
+ }
+ set lineheight [font metrics [.top.t cget -font] -linespace]
+ wm geometry .top 200x[expr {$lineheight / 2}]
+ update
+ .top.t see 1.0
+ .top.t index @0,[expr {$lineheight - 2}]
+} {1.0}
.t configure -wrap word
.t delete 50.0 51.0
@@ -2006,9 +2044,9 @@ test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {textfonts} {
wm geometry .top1 +0+0
text .top1.t -height 3 -width 4 -wrap none -setgrid 1 -padx 6 \
-spacing3 6
- .top1.t insert end "1\n2\n3\n4\n5\n6"
pack .top1.t
update
+ .top1.t insert end "1\n2\n3\n4\n5\n6"
.top1.t yview moveto 0.3333
set result [.top1.t yview]
destroy .top1
@@ -4100,7 +4138,7 @@ test textDisp-33.2 {one line longer than fits in the widget} {
.tt debug 1
set tk_textHeightCalc ""
.tt insert 1.0 [string repeat "more wrap + " 1]
- after 100 ; update
+ after 100 ; update idletasks
# Nothing should have been recalculated.
set tk_textHeightCalc
} {}
@@ -4180,7 +4218,23 @@ test textDisp-34.1 {Text widgets multi-scrolling problem: Bug 2677890} -setup {
return $result
} -cleanup {
destroy .t1 .sy
-} -result {{0.0 1.0} {0.0 1.0} {0.0 1.0} {0.0 0.24}}
+} -result {{0.0 0.24} {0.0 0.24} {0.0 0.24} {0.0 0.24}}
+
+test textDisp-35.1 {Init value of charHeight - Dancing scrollbar bug 1499165} -setup {
+ pack [text .t1] -fill both -expand y -side left
+ .t insert end "[string repeat a\nb\nc\n 500000]THE END\n"
+ set res {}
+} -body {
+ .t see 10000.0
+ after 300 {set fr1 [.t yview] ; set done 1}
+ vwait done
+ after 300 {set fr2 [.t yview] ; set done 1}
+ vwait done
+ lappend res [expr {[lindex $fr1 0] == [lindex $fr2 0]}]
+ lappend res [expr {[lindex $fr1 1] == [lindex $fr2 1]}]
+} -cleanup {
+ destroy .t1
+} -result {1 1}
deleteWindows
option clear
diff --git a/tests/textIndex.test b/tests/textIndex.test
index abed3d4..e78e54b 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -943,6 +943,19 @@ test textIndex-24.1 {text mark prev} {
set res
} {1.0}
+test textIndex-25.1 {IndexCountBytesOrdered, bug [3f1f79abcf]} {
+ pack [text .t2]
+ .t2 tag configure elided -elide 1
+ .t2 insert end "01\n02\n03\n04\n05\n06\n07\n08\n09\n10\n"
+ .t2 insert end "11\n12\n13\n14\n15\n16\n17\n18\n19\n20\n"
+ .t2 insert end "21\n22\n23\n25\n26\n27\n28\n29\n30\n31"
+ .t2 insert end "32\n33\n34\n36\n37\n38\n39" elided
+ # then this used to crash Tk:
+ .t2 see end
+ focus -force .t2 ; # to see the cursor blink
+ destroy .t2
+} {}
+
# cleanup
rename textimage {}
catch {destroy .t}
diff --git a/tests/textWind.test b/tests/textWind.test
index 79dca50..2e16f7b 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -1023,6 +1023,20 @@ test textWind-17.9 {peer widget window configuration} {
set res
} {{-window {} {} {} {}} {-window {} {} {} {}} {-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}}
+test textWind-18.1 {embedded window deletion triggered by a script bound to <Map>} {
+ catch {destroy .t .f}
+ pack [text .t]
+ for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"}
+ .t window create end -window [frame .f -background red -width 80 -height 80]
+ .t window create end -window [frame .f2 -background blue -width 80 -height 80]
+ bind .f <Map> {.t delete .f}
+ update
+ # this shall not crash (bug 1501749)
+ after 100 {.t yview end}
+ tkwait visibility .f2
+ update
+} {}
+
catch {destroy .t}
option clear
diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test
index cdce020..3a2a6ff 100644
--- a/tests/ttk/notebook.test
+++ b/tests/ttk/notebook.test
@@ -468,6 +468,27 @@ test notebook-1817596-3 "insert/configure" -body {
} -result [list [list .nb.l2 .nb.l0 .nb.l1] L2 L0 L1] -cleanup { destroy .nb }
+test notebook-readd-1 "add same widget twice" -body {
+ pack [ttk::notebook .nb]
+ .nb add [ttk::button .nb.b1] -text "Button"
+ .nb add .nb.b1
+ .nb tabs
+} -result [list .nb.b1] -cleanup { destroy .nb }
+
+test notebook-readd-2 "add same widget twice, with options" -body {
+ pack [ttk::notebook .nb]
+ .nb add [ttk::button .nb.b1] -text "Tab label"
+ .nb add .nb.b1 -text "Changed tab label"
+ .nb tabs
+} -result [list .nb.b1] -cleanup { destroy .nb }
+
+test notebook-readd-3 "insert same widget twice, with options" -body {
+ pack [ttk::notebook .nb]
+ .nb insert end [ttk::button .nb.b1] -text "Tab label"
+ .nb insert end .nb.b1 -text "Changed tab label"
+ .nb tabs
+} -result [list .nb.b1] -cleanup { destroy .nb }
+
# See #1343984
test notebook-1343984-1 "don't autoselect on destroy - setup" -body {
diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test
index f7741c6..32b77af 100644
--- a/tests/ttk/spinbox.test
+++ b/tests/ttk/spinbox.test
@@ -143,7 +143,7 @@ test spinbox-1.8.4 "-validate option: " -setup {
.sb configure -validate all -validatecommand {lappend ::spinbox_test %P}
pack .sb
.sb set 50
- focus .sb
+ focus -force .sb
after 500 {set ::spinbox_wait 1} ; vwait ::spinbox_wait
set ::spinbox_test
} -cleanup {
diff --git a/tests/winButton.test b/tests/winButton.test
index 5bf6867..5e3dcfb 100644
--- a/tests/winButton.test
+++ b/tests/winButton.test
@@ -29,7 +29,9 @@ radiobutton .r -text Radiobutton
pack .l .b .c .r
update
-test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win} {
+test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win nonPortable} {
+ # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen
+ # the smallest size (i.e. 8) is not available for "MS Sans Serif" font
deleteWindows
image create test image1
image1 changed 0 0 0 0 60 40
@@ -46,7 +48,9 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win} {
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} {68 48 70 50 90 52 90 52}
-test winbutton-1.2 {TkpComputeButtonGeometry procedure} win {
+test winbutton-1.2 {TkpComputeButtonGeometry procedure} {win nonPortable} {
+ # nonPortable because of [3e3e25f483]: on Win7 first started with a high DPI screen
+ # the smallest size (i.e. 8) is not available for "MS Sans Serif" font
deleteWindows
label .b1 -bitmap question -bd 3 -padx 0 -pady 2
button .b2 -bitmap question -bd 3 -padx 0 -pady 2
generated by cgit v0.12 at 2024-07-21 01:20:47 (GMT)