diff options
Diffstat (limited to 'tests/textImage.test')
| -rw-r--r-- | tests/textImage.test | 353 |
1 files changed, 353 insertions, 0 deletions
diff --git a/tests/textImage.test b/tests/textImage.test new file mode 100644 index 0000000..80d083c --- /dev/null +++ b/tests/textImage.test @@ -0,0 +1,353 @@ +# SCCS: @(#) textImage.test 1.8 97/07/01 18:11:54 + +if {[string compare test [info procs test]] == 1} then \ + {source ../tests/defs} + +# Test Arguments: +# name - Name of test, in the form foo-1.2. +# description - Short textual description of the test, to +# help humans understand what it does. +# constraints - A list of one or more keywords, each of +# which must be the name of an element in +# the array "testConfig". If any of these +# elements is zero, the test is skipped. +# This argument may be omitted. +# script - Script to run to carry out the test. It must +# return a result that can be checked for +# correctness. +# answer - Expected result from script. + +# One time setup. Create a font to insure the tests are font metric invariant. + +wm geometry . {} +catch {destroy .t} +font create test_font -family courier -size 14 +text .t -font test_font +destroy .t + +test textImage-1.1 {basic argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image} msg] $msg +} {1 {wrong # args: should be ".t image option ?arg arg ...?"}} + +test textImage-1.2 {basic argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image c} msg] $msg +} {1 {bad image option "c": must be cget, configure, create, or names}} + +test textImage-1.3 {cget argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image cget} msg] $msg +} {1 {wrong # args: should be ".t image cget index option"}} + +test textImage-1.4 {cget argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image cget blurf -flurp} msg] $msg +} {1 {bad text index "blurf"}} + +test textImage-1.5 {cget argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image cget 1.1 -flurp} msg] $msg +} {1 {no embedded image at index "1.1"}} + +test textImage-1.6 {configure argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image configure } msg] $msg +} {1 {wrong # args: should be ".t image configure index ?option value ...?"}} + +test textImage-1.7 {configure argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image configure blurf } msg] $msg +} {1 {bad text index "blurf"}} + +test textImage-1.8 {configure argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image configure 1.1 } msg] $msg +} {1 {no embedded image at index "1.1"}} + +test textImage-1.9 {create argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image create} msg] $msg +} {1 {wrong # args: should be ".t image create index ?option value ...?"}} + +test textImage-1.10 {create argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image create blurf } msg] $msg +} {1 {bad text index "blurf"}} + +test textImage-1.11 {basic argument checking} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image create 1000.1000 -image small} msg] $msg +} {0 small} + +test textImage-1.12 {names argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image names dates places} msg] $msg +} {1 {wrong # args: should be ".t image names"}} + + +test textImage-1.13 {names argument checking} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + set result "" + lappend result [.t image names] + .t image create insert -image small + lappend result [.t image names] + .t image create insert -image small + lappend result [.t image names] + .t image create insert -image small -name little + lappend result [.t image names] +} {{} small {small#1 small} {small#1 small little}} + +test textImage-1.14 {basic argument checking} { + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image huh} msg] $msg +} {1 {bad image option "huh": must be cget, configure, create, or names}} + +test textImage-1.15 {align argument checking} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + list [catch {.t image create end -image small -align wrong} msg] $msg +} {1 {bad alignment "wrong": must be baseline, bottom, center, or top}} + +test textImage-1.16 {configure} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small + .t image configure small +} {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}} + +test textImage-1.17 {basic cget options} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small + set result "" + foreach i {align padx pady image name} { + lappend result $i:[.t image cget small -$i] + } + set result +} {align:center padx:0 pady:0 image:small name:} + +test textImage-1.18 {basic configure options} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small + set result "" + foreach {option value} {align top padx 5 pady 7 image large name none} { + .t image configure small -$option $value + } + update + .t image configure small +} {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}} + +test textImage-1.19 {basic image naming} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image small + .t image create end -image small -name small + .t image create end -image small -name small#6342 + .t image create end -image small -name small + lsort [.t image names] +} {small small#1 small#6342 small#6343} + +test textImage-2.1 {debug} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t debug 1 + .t insert end front + .t image create end -image small + .t insert end back + .t delete small + .t image names + .t debug 0 +} {} + +test textImage-3.1 {image change propagation} { + catch { + image create photo vary -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image vary -align top + update + set result "" + lappend result base:[.t bbox vary] + foreach i {10 20 40} { + vary configure -width $i -height $i + update + lappend result $i:[.t bbox vary] + } + set result +} {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}} + +test textImage-3.2 {delayed image management} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -name test + update + set result "" + lappend result [.t bbox test] + .t image configure test -image small -align top + update + lappend result [.t bbox test] +} {{} {0 0 5 5}} + +# some temporary random tests + +test textImage-4.1 {alignment checking - except baseline} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image large + .t image create end -image small + .t insert end test + update + set result "" + lappend result default:[.t bbox small] + foreach i {top bottom center} { + .t image configure small -align $i + update + lappend result [.t image cget small -align]:[.t bbox small] + } + set result +} {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}} + +test textImage-4.2 {alignment checking - baseline} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 + } + catch {destroy .t} + font create test_font2 -size 5 + text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image large + .t image create end -image small -align baseline + .t insert end test + set result "" + foreach size {10 15 20 30} { + font configure test_font2 -size $size + array set Metrics [font metrics test_font2] + update + foreach {x y w h} [.t bbox small] {} + set norm [expr { + (([image height large] - $Metrics(-linespace))/2 + + $Metrics(-ascent) - [image height small] - $y) + }] + lappend result "$size $norm" + } + font delete test_font2 + unset Metrics + set result +} {{10 0} {15 0} {20 0} {30 0}} + +test textImage-4.3 {alignment and padding checking} {fonts} { + catch { + image create photo small -width 5 -height 5 + small put red -to 0 0 4 4 + image create photo large -width 50 -height 50 + large put green -to 0 0 50 50 + } + catch {destroy .t} + text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + pack .t + .t image create end -image large + .t image create end -image small -padx 5 -pady 10 + .t insert end test + update + set result "" + lappend result default:[.t bbox small] + foreach i {top bottom center baseline} { + .t image configure small -align $i + update + lappend result $i:[.t bbox small] + } + set result +} {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}} +# cleanup + +catch {destroy .t} +foreach image [image names] {image delete $image} +font delete test_font |