summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2003-11-21 17:29:12 (GMT)
committervincentdarley <vincentdarley>2003-11-21 17:29:12 (GMT)
commitfdda3361d0bfd7bf2eaab1a47112b09989cc707a (patch)
tree5b5625a9b5e39969bff8edf848405b321ff2e41c /tests
parent3dd9ffd03db6bdc61177f3470f1524e95ba22892 (diff)
downloadtk-fdda3361d0bfd7bf2eaab1a47112b09989cc707a.zip
tk-fdda3361d0bfd7bf2eaab1a47112b09989cc707a.tar.gz
tk-fdda3361d0bfd7bf2eaab1a47112b09989cc707a.tar.bz2
fix to two test suite bugs
Diffstat (limited to 'tests')
-rw-r--r--tests/textDisp.test91
-rw-r--r--tests/textWind.test14
2 files changed, 82 insertions, 23 deletions
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 4fad84b..48a4567 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textDisp.test,v 1.20 2003/11/15 16:57:57 vincentdarley Exp $
+# RCS: @(#) $Id: textDisp.test,v 1.21 2003/11/21 17:29:13 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -3150,11 +3150,43 @@ test textDisp-27.6 {SizeOfTab procedure, center alignment} {textfonts} {
} [list [list 32 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 39 [expr {$fixedDiff + 18}] 7 $fixedHeight]]
test textDisp-27.7 {SizeOfTab procedure, center alignment, wrap -none (potential numerical problems)} {textfonts} {
.t delete 1.0 end
- .t configure -tabs {1c 2c center 3c 4c} -wrap none -width 40
+ set cm [winfo fpixels .t 1c]
+ .t configure -tabs {1c 2c center 3c 4c 5c 6c 7c 8c} -wrap none -width 40
.t insert 1.0 a\tb\tc\td\te\n012345678934567890a\tbb\tcc\tdd
+ set width [expr {$fixedWidth * 19}]
+ set tab $cm
+ while {$tab < $width} {
+ set tab [expr {$tab + $cm}]
+ }
+ # Now we've calculated to the end of the tab after 'a', add one
+ # more for 'bb\t' and we're there, with 4 for the border
+ set tab [expr {4 + int($tab + $cm)}]
update
- .t bbox 2.24
-} [list 200 [expr {$fixedDiff + 18}] 7 $fixedHeight]
+ set res [.t bbox 2.23]
+ lset res 0 [expr {[lindex $res 0] - $tab}]
+ set res
+} [list 0 [expr {$fixedDiff + 18}] 7 $fixedHeight]
+test textDisp-27.7.1 {SizeOfTab procedure, fractional tab interpolation problem} {knownBug textfonts} {
+ .t delete 1.0 end
+ set cm [winfo fpixels .t 1c]
+ .t configure -tabs {1c 2c 3c 4c} -wrap none -width 40
+ .t insert 1.0 a\tb\tc\td\te\n012345678934567890a\tbb\tcc\tdd
+ set width [expr {$fixedWidth * 19}]
+ set tab $cm
+ while {$tab < $width} {
+ set tab [expr {$tab + $cm}]
+ }
+ # Now we've calculated to the end of the tab after 'a', add one
+ # more for 'bb\t' and we're there, with 4 for the border
+ set tab [expr {4 + int($tab + $cm)}]
+ update
+ set res [.t bbox 2.23]
+ # Now, on some platforms Tk interpolated from 3c-4c->5c but that
+ # interpolation doesn't use fractional pixels and so this result
+ # might be off by one.
+ lset res 0 [expr {[lindex $res 0] - $tab}]
+ set res
+} [list 0 [expr {$fixedDiff + 18}] 7 $fixedHeight]
.t configure -wrap char -tabs {} -width 20
update
@@ -3325,10 +3357,10 @@ test textDisp-29.2.5 {miscellaneous: can show last character} {
.t2.t xview scroll 2 units
set iWidth2 [lindex [.t2.t bbox end-2c] 2]
- if {($iWidth == $iWidth2) && $iWidth > 2} {
+ if {($iWidth == $iWidth2) && $iWidth >= 2} {
set result "correct"
} else {
- set result "not correct"
+ set result "last character is not completely visible when it should be"
}
} {correct}
test textDisp-29.3 {miscellaneous: lines wrap but are still too long} {textfonts} {
@@ -3494,24 +3526,63 @@ test textDisp-32.1 {everything elided} {
test textDisp-33.0 {one line longer than fits in the widget} {
pack [text .tt -wrap char]
- .tt insert 1.0 [string repeat "hello there " 2500]
+ .tt insert 1.0 [string repeat "more wrap + " 300]
update ; update ; update
.tt see 1.0
lindex [.tt yview] 0
} {0.0}
-
test textDisp-33.1 {one line longer than fits in the widget} {
destroy .tt
pack [text .tt -wrap char]
- .tt insert 1.0 [string repeat "hello there " 2500]
+ .tt insert 1.0 [string repeat "more wrap + " 300]
update ; update ; update
.tt yview "1.0 +1 displaylines"
if {[lindex [.tt yview] 0] > 0.1} {
- set result "bad result"
+ set result "window should be scrolled to the top"
+ } else {
+ set result "ok"
+ }
+} {ok}
+test textDisp-33.2 {one line longer than fits in the widget} {
+ destroy .tt
+ pack [text .tt -wrap char]
+ .tt debug 1
+ set tk_textHeightCalc ""
+ .tt insert 1.0 [string repeat "more wrap + " 1]
+ after 100 ; update
+ # Nothing should have been recalculated.
+ set tk_textHeightCalc
+} {}
+test textDisp-33.3 {one line longer than fits in the widget} {
+ destroy .tt
+ pack [text .tt -wrap char]
+ .tt debug 1
+ set tk_textHeightCalc ""
+ .tt insert 1.0 [string repeat "more wrap + " 300]
+ after 100 ; update
+ # Each line should have been recalculated just once
+ .tt debug 0
+ expr {[llength $tk_textHeightCalc] == [.tt count -displaylines 1.0 end]}
+} {1}
+test textDisp-33.4 {one line longer than fits in the widget} {
+ destroy .tt
+ pack [text .tt -wrap char]
+ .tt debug 1
+ set tk_textHeightCalc ""
+ .tt insert 1.0 [string repeat "more wrap + " 300]
+ update ; update ; update
+ set idx [.tt index "1.0 + 1 displaylines"]
+ .tt yview $idx
+ if {[lindex [.tt yview] 0] > 0.1} {
+ set result "window should be scrolled to the top"
} else {
set result "ok"
}
+ set idx [.tt index "1.0 + 1 displaylines"]
+ .tt debug 0
+ set result
} {ok}
+destroy .tt
deleteWindows
option clear
diff --git a/tests/textWind.test b/tests/textWind.test
index 7c006ff..f5816a7 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textWind.test,v 1.12 2003/11/07 15:36:27 vincentdarley Exp $
+# RCS: @(#) $Id: textWind.test,v 1.13 2003/11/21 17:29:13 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -482,18 +482,6 @@ test textWind-10.4.1 {EmbWinLayoutProc procedure, error in creating window} {tex
update idletasks
lappend msg [winfo exists .t.f.f]
} [list {{can't embed .t.f.f relative to .t}} 1]
-test textWind-10.4.2 {EmbWinLayoutProc procedure, error in creating window} {textfonts} {
- .t delete 1.0 end
- .t insert 1.0 "Some sample text"
- catch {destroy .t.f}
- .t window create 1.5 -create {
- frame .t.f
- frame .t.f.f -width 10 -height 20 -bg $color
- }
- set msg {}
- update
- lappend msg [winfo exists .t.f.f]
-} {{{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} 1}
catch {destroy .t.f}
test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} {textfonts} {
.t delete 1.0 end