summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/canvText.test6
-rw-r--r--tests/font.test73
-rw-r--r--tests/imgPPM.test75
-rw-r--r--tests/listbox.test11
-rw-r--r--tests/option.file11
-rw-r--r--tests/option.test7
-rw-r--r--tests/scale.test39
-rw-r--r--tests/textDisp.test22
-rw-r--r--tests/textIndex.test22
9 files changed, 218 insertions, 38 deletions
diff --git a/tests/canvText.test b/tests/canvText.test
index 070011b..20a39b0 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -501,7 +501,7 @@ end
%%EOF
"
-test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} {
+test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -body {
catch {destroy .c}
canvas .c
pack .c
@@ -513,7 +513,9 @@ test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} {
incr y2
update
.c find enclosed 99 99 [expr $x2 + $i] [expr $y2 + 1]
-} 1
+} -cleanup {
+ unset -nocomplain bbox x2 y2
+} -result 1
test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} {
catch {destroy .c}
diff --git a/tests/font.test b/tests/font.test
index 34e4b83..a02cc2e 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -15,9 +15,28 @@ toplevel .b
wm geom .b +0+0
update idletasks
+set defaultfontlist [font names]
+
+proc getnondefaultfonts {} {
+ global defaultfontlist
+ set nondeffonts [list ]
+ foreach afont [font names] {
+ if {$afont ni $defaultfontlist} {
+ lappend nondeffonts $afont
+ }
+ }
+ set nondeffonts
+}
+
+proc clearnondefaultfonts {} {
+ foreach afont [getnondefaultfonts] {
+ font delete $afont
+ }
+}
+
proc setup {} {
catch {destroy .b.f}
- catch {eval font delete [font names]}
+ clearnondefaultfonts
label .b.f
pack .b.f
update
@@ -46,10 +65,9 @@ proc csetup {{str ""}} {
setup
-case [tk windowingsystem] {
+switch [tk windowingsystem] {
x11 {set fixed "fixed"}
win32 {set fixed "courier 12"}
- classic -
aqua {set fixed "monaco 9"}
}
@@ -194,20 +212,20 @@ test font-6.1 {font command: create: make up name} {
# (objc < 3) so name = NULL
setup
font create
- font names
-} {font1}
+ expr {"font1" in [font names]}
+} {1}
test font-6.2 {font command: create: name specified} {
# not (objc < 3)
setup
font create xyz
- font names
-} {xyz}
+ expr {"xyz" in [font names]}
+} {1}
test font-6.3 {font command: create: name not really specified} {
# (name[0] == '-') so name = NULL
setup
font create -family xyz
- font names
-} {font1}
+ expr {"font1" in [font names]}
+} {1}
test font-6.4 {font command: create: generate name} {
# (name == NULL)
setup
@@ -248,9 +266,9 @@ test font-7.2 {font command: delete: loop test} {
font create c -underline 1
font create d -underline 1
font create e -underline 1
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
font delete a e c b
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
} {{a b c d e} d}
test font-7.3 {font command: delete: loop test} {
# (namedHashPtr == NULL) in middle of loop
@@ -261,9 +279,9 @@ test font-7.3 {font command: delete: loop test} {
font create c -underline 1
font create d -underline 1
font create e -underline 1
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
catch {font delete a d q c e b}
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
} {{a b c d e} {b c e}}
test font-7.4 {font command: delete: non-existent} {
# (namedHashPtr == NULL)
@@ -383,19 +401,19 @@ test font-11.1 {font command: names: arguments} {
} {1 {wrong # args: should be "font names"}}
test font-11.2 {font command: names: loop test: no passes} {
setup
- font names
+ getnondefaultfonts
} {}
test font-11.3 {font command: names: loop test: one pass} {
setup
font create
- font names
+ getnondefaultfonts
} {font1}
test font-11.4 {font command: names: loop test: multiple passes} {
setup
font create xyz
font create abc
font create def
- lsort [font names]
+ lsort [getnondefaultfonts]
} {abc def xyz}
test font-11.5 {font command: names: skip deletePending fonts} {
# (nfPtr->deletePending == 0)
@@ -403,10 +421,10 @@ test font-11.5 {font command: names: skip deletePending fonts} {
set x {}
font create xyz
font create abc
- lappend x [lsort [font names]]
+ lappend x [lsort [getnondefaultfonts]]
.b.f config -font xyz
font delete xyz
- lappend x [font names]
+ lappend x [getnondefaultfonts]
} {{abc xyz} abc}
test font-12.1 {UpdateDependantFonts procedure: no users} {
@@ -433,9 +451,9 @@ test font-13.1 {CreateNamedFont: new named font} {
# not (new == 0)
setup
set x {}
- lappend x [font names]
+ lappend x [getnondefaultfonts]
font create xyz
- lappend x [font names]
+ lappend x [getnondefaultfonts]
} {{} xyz}
test font-13.2 {CreateNamedFont: named font already exists} {
# (new == 0)
@@ -587,8 +605,8 @@ test font-17.4 {Tk_FreeFont procedure: named font} {
font create xyz
.b.f config -font xyz
destroy .b.f
- font names
-} {xyz}
+ expr {"xyz" in [font names]}
+} {1}
test font-17.5 {Tk_FreeFont procedure: named font} {
# not (fontPtr->refCount == 0)
setup
@@ -1381,6 +1399,17 @@ setup
destroy .b
+test font-47.1 {Bug f214b8ad5b} -body {
+ interp create one
+ interp create two
+ load {} Tk one
+ load {} Tk two
+ one eval menu .menubar
+ two eval menu .menubar
+ interp delete one
+ interp delete two
+} -result {}
+
# cleanup
cleanupTests
return
diff --git a/tests/imgPPM.test b/tests/imgPPM.test
index a9e9dc0..8dec8c2 100644
--- a/tests/imgPPM.test
+++ b/tests/imgPPM.test
@@ -20,7 +20,7 @@ proc put {file data} {
puts -nonewline $f $data
close $f
}
-
+
test imgPPM-1.1 {FileReadPPM procedure} {
put test.ppm "P6\n0 256\n255\nabcdef"
list [catch {image create photo p1 -file test.ppm} msg] $msg
@@ -38,9 +38,9 @@ test imgPPM-1.4 {FileReadPPM procedure} {
list [catch {image create photo p1 -file test.ppm} msg] $msg
} {1 {PPM image file "test.ppm" has dimension(s) <= 0}}
test imgPPM-1.5 {FileReadPPM procedure} {
- put test.ppm "P6\n10 20\n256\nabcdef"
+ put test.ppm "P6\n10 20\n100000\nabcdef"
list [catch {image create photo p1 -file test.ppm} msg] $msg
-} {1 {PPM image file "test.ppm" has bad maximum intensity value 256}}
+} {1 {PPM image file "test.ppm" has bad maximum intensity value 100000}}
test imgPPM-1.6 {FileReadPPM procedure} {
put test.ppm "P6\n10 20\n0\nabcdef"
list [catch {image create photo p1 -file test.ppm} msg] $msg
@@ -157,9 +157,78 @@ test imgPPM-4.1 {StringReadPPM procedure, data too short [Bug 1822391]} \
-returnCodes error \
-result {truncated PPM data}
+test imgPPM-5.1 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n0 256\n255\nabcdef"
+} -returnCodes error -cleanup {
+ image delete ppm
+} -result {PPM image data has dimension(s) <= 0}
+test imgPPM-5.2 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n-2 256\n255\nabcdef"
+} -returnCodes error -cleanup {
+ image delete ppm
+} -result {PPM image data has dimension(s) <= 0}
+test imgPPM-5.3 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n10 0\n255\nabcdef"
+} -returnCodes error -cleanup {
+ image delete ppm
+} -result {PPM image data has dimension(s) <= 0}
+test imgPPM-5.4 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n10 -2\n255\nabcdef"
+} -returnCodes error -cleanup {
+ image delete ppm
+} -result {PPM image data has dimension(s) <= 0}
+test imgPPM-5.5 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n10 20\n100000\nabcdef"
+} -returnCodes error -cleanup {
+ image delete ppm
+} -result {PPM image data has bad maximum intensity value 100000}
+test imgPPM-5.6 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n10 20\n0\nabcdef"
+} -returnCodes error -cleanup {
+ image delete ppm
+} -result {PPM image data has bad maximum intensity value 0}
+test imgPPM-5.7 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n10 10\n255\nabcdef"
+} -returnCodes error -cleanup {
+ image delete ppm
+} -result {truncated PPM data}
+test imgPPM-5.8 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n5 4\n255\n01234567890123456789012345678901234567890123456789012345678"
+} -returnCodes error -cleanup {
+ image delete ppm
+} -result {truncated PPM data}
+test imgPPM-5.9 {StringReadPPM procedure} -setup {
+ image create photo ppm
+} -body {
+ ppm put "P6\n5 4\n150\n012345678901234567890123456789012345678901234567890123456789"
+ list [image width ppm] [image height ppm]
+} -cleanup {
+ image delete ppm
+} -result {5 4}
+
eval image delete [image names]
# cleanup
catch {file delete test.ppm}
cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/listbox.test b/tests/listbox.test
index 25bc606..b4046b6 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -2158,6 +2158,17 @@ test listbox-29.1 {listbox selection behavior, -state disabled} {
lappend out [.l selection includes 2] [.l curselection]
} {1 1 2}
+test listbox-30.1 {Bug 3607326} -setup {
+ destroy .l
+ unset -nocomplain a
+} -body {
+ array set a {}
+ listbox .l -listvariable a
+} -cleanup {
+ destroy .l
+ unset -nocomplain a
+} -result * -match glob -returnCodes error
+
resetGridInfo
deleteWindows
option clear
diff --git a/tests/option.file1 b/tests/option.file1
index e64b6cc..32b4a18 100644
--- a/tests/option.file1
+++ b/tests/option.file1
@@ -14,4 +14,5 @@ ple
# More comments, this time delimited by hash-marks.
# Comment-line with space.
*x6:
+*x9: \ \ \\\101\n
# comment line as last line of file.
diff --git a/tests/option.test b/tests/option.test
index 49d2975..1bfcb7c 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -197,13 +197,14 @@ test option-15.3 {database files} appNameIsTktest {option get . x2 color} green
test option-15.4 {database files} {option get . x3 color} purple
test option-15.5 {database files} {option get . {x 4} color} brown
test option-15.6 {database files} {option get . x6 color} {}
-test option-15.7 {database files} {
+test option-15.7 {database files} {option get . x9 color} " \t\\A\n"
+test option-15.8 {database files} {
list [catch {option read $option1 widget foo} msg] $msg
} {1 {wrong # args: should be "option readfile fileName ?priority?"}}
option add *x3 burgundy
catch {option read $option1 userDefault}
-test option-15.8 {database files} {option get . x3 color} burgundy
-test option-15.9 {database files} {
+test option-15.9 {database files} {option get . x3 color} burgundy
+test option-15.10 {database files} {
list [catch {option read $option2} msg] $msg
} {1 {missing colon on line 2}}
diff --git a/tests/scale.test b/tests/scale.test
index 657f668..f8e58bb 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -387,6 +387,11 @@ test scale-6.20 {ComputeFormat procedure} {
.s set 1001.23456789
.s get
} {1001.235}
+test scale-6.21 {ComputeFormat procedure} {
+ .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 200
+ .s set 1001.23456789
+ .s get
+} {1001.235}
test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} {
catch {destroy .s}
@@ -862,6 +867,40 @@ test scale-18.3 {Scale button 2 events [Bug 787065]} \
} \
-result {0 {}}
+test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \
+ -setup {
+ catch {destroy .s}
+ catch {destroy .s1 .s2 .s3 .s4}
+ unset -nocomplain x1 x2 x3 x4 x y
+ scale .s1 -from 0 -to 100 -resolution 1 -variable x1 -digits 4 -orient horizontal -length 100
+ scale .s2 -from 0 -to 100 -resolution -1 -variable x2 -digits 4 -orient horizontal -length 100
+ scale .s3 -from 100 -to 0 -resolution 1 -variable x3 -digits 4 -orient horizontal -length 100
+ scale .s4 -from 100 -to 0 -resolution -1 -variable x4 -digits 4 -orient horizontal -length 100
+ pack .s1 .s2 .s3 .s4 -side left
+ update
+ } \
+ -body {
+ foreach {x y} [.s1 coord 50] {}
+ event generate .s1 <1> -x $x -y $y
+ event generate .s1 <ButtonRelease-1> -x $x -y $y
+ foreach {x y} [.s2 coord 50] {}
+ event generate .s2 <1> -x $x -y $y
+ event generate .s2 <ButtonRelease-1> -x $x -y $y
+ foreach {x y} [.s3 coord 50] {}
+ event generate .s3 <1> -x $x -y $y
+ event generate .s3 <ButtonRelease-1> -x $x -y $y
+ foreach {x y} [.s4 coord 50] {}
+ event generate .s4 <1> -x $x -y $y
+ event generate .s4 <ButtonRelease-1> -x $x -y $y
+ update
+ list $x1 $x2 $x3 $x4
+ } \
+ -cleanup {
+ unset x1 x2 x3 x4 x y
+ destroy .s1 .s2 .s3 .s4
+ } \
+ -result {1.0 1.0 1.0 1.0}
+
catch {destroy .s}
option clear
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 8e99eff..70c7208 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -27,9 +27,10 @@ proc scrollError args {
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
-
-option add *Text.borderWidth 2
-option add *Text.highlightThickness 2
+set twbw 2
+set twht 2
+option add *Text.borderWidth $twbw
+option add *Text.highlightThickness $twht
# The frame .f is needed to make sure that the overall window is always
# fairly wide, even if the text window is very narrow. This is needed
@@ -3366,7 +3367,7 @@ test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {textfonts
.t2.t window create 1.1 -window .t2.t.f
update
list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list 0.0 [expr {14.0/30}]] 300x50+5+[expr {$fixedDiff + 18}] [list 12 [expr {$fixedDiff + 68}] 7 $fixedHeight]]
+} [list [list 0.0 [expr {20.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]]
test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts} {
catch {destroy .t2}
toplevel .t2
@@ -3379,10 +3380,11 @@ test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts
.t2.t insert end 123
frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
.t2.t window create 1.1 -window .t2.t.f
+ update
.t2.t xview scroll 1 unit
update
list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list [expr {7.0/300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]]
+} [list [list [expr {1.0*$fixedWidth/300}] [expr {21.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1 - $fixedWidth}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1 - $fixedWidth}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]]
test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfonts} {
catch {destroy .t2}
toplevel .t2
@@ -3394,6 +3396,7 @@ test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfon
pack .t2.s -side bottom -fill x
.t2.t insert end 1\n
.t2.t insert end [string repeat "abc" 30]
+ update
.t2.t xview scroll 5 unit
update
.t2.t xview
@@ -3410,10 +3413,11 @@ test textDisp-29.2.2 {miscellaneous: lines wrap but are still too long} {textfon
.t2.t insert end 123
frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
.t2.t window create 1.1 -window .t2.t.f
+ update
.t2.t xview scroll 2 unit
update
list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list [expr {14.0/300}] [expr {154.0/300}]] 300x50+-9+[expr {$fixedDiff + 18}] {}]
+} [list [list [expr {2.0*$fixedWidth/300}] [expr {22.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1 - 2*$fixedWidth}]+[expr {$twbw + $twht + $fixedHeight + 1}] {}]
test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfonts} {
catch {destroy .t2}
toplevel .t2
@@ -3426,10 +3430,11 @@ test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfon
.t2.t insert end 123
frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
.t2.t window create 1.1 -window .t2.t.f
+ update
.t2.t xview scroll 7 pixels
update
list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list [expr {7.0/300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]]
+} [list [list [expr {7.0/300}] [expr {(20.0*$fixedWidth + 7)/300}]] 300x50+[expr {$twbw + $twht + 1 - 7}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1 - 7}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]]
test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfonts} {
catch {destroy .t2}
toplevel .t2
@@ -3442,10 +3447,11 @@ test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfon
.t2.t insert end 123
frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
.t2.t window create 1.1 -window .t2.t.f
+ update
.t2.t xview scroll 17 pixels
update
list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list [expr {17.0/300}] [expr {157.0/300}]] 300x50+-12+[expr {$fixedDiff + 18}] {}]
+} [list [list [expr {17.0/300}] [expr {(20.0*$fixedWidth + 17)/300}]] 300x50+[expr {$twbw + $twht + 1 - 17}]+[expr {$twbw + $twht + $fixedHeight + 1}] {}]
test textDisp-29.2.5 {miscellaneous: can show last character} {
catch {destroy .t2}
toplevel .t2
diff --git a/tests/textIndex.test b/tests/textIndex.test
index 6341b6d..28dc0df 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -214,9 +214,31 @@ set weirdTag "funny . +- 22.1\n\t{"
set weirdMark "asdf \n{-+ 66.2\t"
.t mark set $weirdMark 4.0
.t tag config y -relief raised
+set weirdImage "foo-1"
+.t image create 2.1 -image [image create photo $weirdImage]
+set weirdEmbWin ".t.bar-1"
+entry $weirdEmbWin
+.t window create 3.1 -window $weirdEmbWin
test textIndex-3.1 {TkTextGetIndex, weird mark names} {
list [catch {.t index $weirdMark} msg] $msg
} {0 4.0}
+test textIndex-3.2 {TkTextGetIndex, weird mark names} knownBug {
+ list [catch {.t index "$weirdMark -1char"} msg] $msg
+} {0 4.0}
+test textIndex-3.3 {TkTextGetIndex, weird embedded window names} {
+ list [catch {.t index $weirdEmbWin} msg] $msg
+} {0 3.1}
+test textIndex-3.4 {TkTextGetIndex, weird embedded window names} knownBug {
+ list [catch {.t index "$weirdEmbWin -1char"} msg] $msg
+} {0 3.0}
+test textIndex-3.5 {TkTextGetIndex, weird image names} {
+ list [catch {.t index $weirdImage} msg] $msg
+} {0 2.1}
+test textIndex-3.6 {TkTextGetIndex, weird image names} knownBug {
+ list [catch {.t index "$weirdImage -1char"} msg] $msg
+} {0 2.0}
+.t delete 3.1 ; # remove the weirdEmbWin
+.t delete 2.1 ; # remove the weirdImage
test textIndex-4.1 {TkTextGetIndex, tags} {
list [catch {.t index x.first} msg] $msg