tk/tests/textImage.test

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