1# textImage.test -- test images embedded in text widgets 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright (c) 1998-1999 by Scriptics Corporation. 8# All rights reserved. 9# 10# RCS: @(#) $Id$ 11 12package require tcltest 2.1 13eval tcltest::configure $argv 14tcltest::loadTestedCommands 15 16# One time setup. Create a font to insure the tests are font metric invariant. 17 18catch {destroy .t} 19font create test_font -family courier -size 14 20text .t -font test_font 21destroy .t 22 23test textImage-1.1 {basic argument checking} { 24 catch {destroy .t} 25 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 26 pack .t 27 list [catch {.t image} msg] $msg 28} {1 {wrong # args: should be ".t image option ?arg arg ...?"}} 29 30test textImage-1.2 {basic argument checking} { 31 catch {destroy .t} 32 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 33 pack .t 34 list [catch {.t image c} msg] $msg 35} {1 {ambiguous option "c": must be cget, configure, create, or names}} 36 37test textImage-1.3 {cget argument checking} { 38 catch {destroy .t} 39 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 40 pack .t 41 list [catch {.t image cget} msg] $msg 42} {1 {wrong # args: should be ".t image cget index option"}} 43 44test textImage-1.4 {cget argument checking} { 45 catch {destroy .t} 46 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 47 pack .t 48 list [catch {.t image cget blurf -flurp} msg] $msg 49} {1 {bad text index "blurf"}} 50 51test textImage-1.5 {cget argument checking} { 52 catch {destroy .t} 53 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 54 pack .t 55 list [catch {.t image cget 1.1 -flurp} msg] $msg 56} {1 {no embedded image at index "1.1"}} 57 58test textImage-1.6 {configure argument checking} { 59 catch {destroy .t} 60 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 61 pack .t 62 list [catch {.t image configure } msg] $msg 63} {1 {wrong # args: should be ".t image configure index ?option value ...?"}} 64 65test textImage-1.7 {configure argument checking} { 66 catch {destroy .t} 67 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 68 pack .t 69 list [catch {.t image configure blurf } msg] $msg 70} {1 {bad text index "blurf"}} 71 72test textImage-1.8 {configure argument checking} { 73 catch {destroy .t} 74 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 75 pack .t 76 list [catch {.t image configure 1.1 } msg] $msg 77} {1 {no embedded image at index "1.1"}} 78 79test textImage-1.9 {create argument checking} { 80 catch {destroy .t} 81 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 82 pack .t 83 list [catch {.t image create} msg] $msg 84} {1 {wrong # args: should be ".t image create index ?option value ...?"}} 85 86test textImage-1.10 {create argument checking} { 87 catch {destroy .t} 88 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 89 pack .t 90 list [catch {.t image create blurf } msg] $msg 91} {1 {bad text index "blurf"}} 92 93test textImage-1.11 {basic argument checking} { 94 catch { 95 image create photo small -width 5 -height 5 96 small put red -to 0 0 4 4 97 } 98 catch {destroy .t} 99 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 100 pack .t 101 list [catch {.t image create 1000.1000 -image small} msg] $msg 102} {0 small} 103 104test textImage-1.12 {names argument checking} { 105 catch {destroy .t} 106 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 107 pack .t 108 list [catch {.t image names dates places} msg] $msg 109} {1 {wrong # args: should be ".t image names"}} 110 111 112test textImage-1.13 {names argument checking} { 113 catch { 114 image create photo small -width 5 -height 5 115 small put red -to 0 0 4 4 116 } 117 catch {destroy .t} 118 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 119 pack .t 120 set result "" 121 lappend result [.t image names] 122 .t image create insert -image small 123 lappend result [.t image names] 124 .t image create insert -image small 125 lappend result [.t image names] 126 .t image create insert -image small -name little 127 lappend result [.t image names] 128} {{} small {small#1 small} {small#1 small little}} 129 130test textImage-1.14 {basic argument checking} { 131 catch {destroy .t} 132 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 133 pack .t 134 list [catch {.t image huh} msg] $msg 135} {1 {bad option "huh": must be cget, configure, create, or names}} 136 137test textImage-1.15 {align argument checking} { 138 catch { 139 image create photo small -width 5 -height 5 140 small put red -to 0 0 4 4 141 } 142 catch {destroy .t} 143 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 144 pack .t 145 list [catch {.t image create end -image small -align wrong} msg] $msg 146} {1 {bad align "wrong": must be baseline, bottom, center, or top}} 147 148test textImage-1.16 {configure} { 149 catch { 150 image create photo small -width 5 -height 5 151 small put red -to 0 0 4 4 152 } 153 catch {destroy .t} 154 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 155 pack .t 156 .t image create end -image small 157 .t image configure small 158} {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}} 159 160test textImage-1.17 {basic cget options} { 161 catch { 162 image create photo small -width 5 -height 5 163 small put red -to 0 0 4 4 164 } 165 catch {destroy .t} 166 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 167 pack .t 168 .t image create end -image small 169 set result "" 170 foreach i {align padx pady image name} { 171 lappend result $i:[.t image cget small -$i] 172 } 173 set result 174} {align:center padx:0 pady:0 image:small name:} 175 176test textImage-1.18 {basic configure options} { 177 catch { 178 image create photo small -width 5 -height 5 179 small put red -to 0 0 4 4 180 image create photo large -width 50 -height 50 181 large put green -to 0 0 50 50 182 } 183 catch {destroy .t} 184 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 185 pack .t 186 .t image create end -image small 187 set result "" 188 foreach {option value} {align top padx 5 pady 7 image large name none} { 189 .t image configure small -$option $value 190 } 191 update 192 .t image configure small 193} {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}} 194 195test textImage-1.19 {basic image naming} { 196 catch { 197 image create photo small -width 5 -height 5 198 small put red -to 0 0 4 4 199 } 200 catch {destroy .t} 201 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 202 pack .t 203 .t image create end -image small 204 .t image create end -image small -name small 205 .t image create end -image small -name small#6342 206 .t image create end -image small -name small 207 lsort [.t image names] 208} {small small#1 small#6342 small#6343} 209 210test textImage-2.1 {debug} { 211 catch { 212 image create photo small -width 5 -height 5 213 small put red -to 0 0 4 4 214 } 215 catch {destroy .t} 216 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 217 pack .t 218 .t debug 1 219 .t insert end front 220 .t image create end -image small 221 .t insert end back 222 .t delete small 223 .t image names 224 .t debug 0 225} {} 226 227test textImage-3.1 {image change propagation} { 228 catch { 229 image create photo vary -width 5 -height 5 230 small put red -to 0 0 4 4 231 } 232 catch {destroy .t} 233 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 234 pack .t 235 .t image create end -image vary -align top 236 update 237 set result "" 238 lappend result base:[.t bbox vary] 239 foreach i {10 20 40} { 240 vary configure -width $i -height $i 241 update 242 lappend result $i:[.t bbox vary] 243 } 244 set result 245} {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}} 246 247test textImage-3.2 {delayed image management} { 248 catch { 249 image create photo small -width 5 -height 5 250 small put red -to 0 0 4 4 251 } 252 catch {destroy .t} 253 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 254 pack .t 255 .t image create end -name test 256 update 257 set result "" 258 lappend result [.t bbox test] 259 .t image configure test -image small -align top 260 update 261 lappend result [.t bbox test] 262} {{} {0 0 5 5}} 263 264# some temporary random tests 265 266test textImage-4.1 {alignment checking - except baseline} { 267 catch { 268 image create photo small -width 5 -height 5 269 small put red -to 0 0 4 4 270 image create photo large -width 50 -height 50 271 large put green -to 0 0 50 50 272 } 273 catch {destroy .t} 274 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 275 pack .t 276 .t image create end -image large 277 .t image create end -image small 278 .t insert end test 279 update 280 set result "" 281 lappend result default:[.t bbox small] 282 foreach i {top bottom center} { 283 .t image configure small -align $i 284 update 285 lappend result [.t image cget small -align]:[.t bbox small] 286 } 287 set result 288} {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}} 289 290test textImage-4.2 {alignment checking - baseline} { 291 catch { 292 image create photo small -width 5 -height 5 293 small put red -to 0 0 4 4 294 image create photo large -width 50 -height 50 295 large put green -to 0 0 50 50 296 } 297 catch {destroy .t} 298 font create test_font2 -size 5 299 text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0 300 pack .t 301 .t image create end -image large 302 .t image create end -image small -align baseline 303 .t insert end test 304 set result "" 305 # Sizes larger than 25 can be too big and lead to a negative 'norm', 306 # at least on Windows XP with certain settings. 307 foreach size {10 15 20 25} { 308 font configure test_font2 -size $size 309 array set Metrics [font metrics test_font2] 310 update 311 foreach {x y w h} [.t bbox small] {} 312 set norm [expr { 313 (([image height large] - $Metrics(-linespace))/2 314 + $Metrics(-ascent) - [image height small] - $y) 315 }] 316 lappend result "$size $norm" 317 } 318 font delete test_font2 319 unset Metrics 320 set result 321} {{10 0} {15 0} {20 0} {25 0}} 322 323test textImage-4.3 {alignment and padding checking} {fonts} { 324 catch { 325 image create photo small -width 5 -height 5 326 small put red -to 0 0 4 4 327 image create photo large -width 50 -height 50 328 large put green -to 0 0 50 50 329 } 330 catch {destroy .t} 331 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 332 pack .t 333 .t image create end -image large 334 .t image create end -image small -padx 5 -pady 10 335 .t insert end test 336 update 337 set result "" 338 lappend result default:[.t bbox small] 339 foreach i {top bottom center baseline} { 340 .t image configure small -align $i 341 update 342 lappend result $i:[.t bbox small] 343 } 344 set result 345} {{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}} 346 347test textImage-5.0 {peer widget images} { 348 catch { 349 image create photo small -width 5 -height 5 350 small put red -to 0 0 4 4 351 image create photo large -width 50 -height 50 352 large put green -to 0 0 50 50 353 } 354 catch {destroy .t .tt} 355 pack [text .t] 356 toplevel .tt 357 pack [.t peer create .tt.t] 358 .t image create end -image large 359 .t image create end -image small -padx 5 -pady 10 360 .t insert end test 361 update 362 destroy .t .tt 363} {} 364 365# cleanup 366catch {destroy .t} 367foreach image [image names] {image delete $image} 368font delete test_font 369 370# cleanup 371cleanupTests 372return 373