Initial revision

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