1# This file contains tests for the tkUnixSelect.c file. 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) 1999 by Scriptics Corporation. 8# 9# See the file "license.terms" for information on usage and redistribution 10# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11# 12# RCS: @(#) $Id: unixSelect.test,v 1.8 2003/01/14 19:24:51 jenglish Exp $ 13 14package require tcltest 2.1 15namespace import -force tcltest::configure 16namespace import -force tcltest::testsDirectory 17configure -testdir [file join [pwd] [file dirname [info script]]] 18configure -loadfile [file join [testsDirectory] constraints.tcl] 19tcltest::loadTestedCommands 20 21global longValue selValue selInfo 22 23set selValue {} 24set selInfo {} 25 26proc handler {type offset count} { 27 global selValue selInfo 28 lappend selInfo $type $offset $count 29 set numBytes [expr {[string length $selValue] - $offset}] 30 if {$numBytes <= 0} { 31 return "" 32 } 33 string range $selValue $offset [expr $numBytes+$offset] 34} 35 36proc errIncrHandler {type offset count} { 37 global selValue selInfo pass 38 if {$offset == 4000} { 39 if {$pass == 0} { 40 # Just sizing the selection; don't do anything here. 41 set pass 1 42 } else { 43 # Fetching the selection; wait long enough to cause a timeout. 44 after 6000 45 } 46 } 47 lappend selInfo $type $offset $count 48 set numBytes [expr {[string length $selValue] - $offset}] 49 if {$numBytes <= 0} { 50 return "" 51 } 52 string range $selValue $offset [expr $numBytes+$offset] 53} 54 55proc errHandler args { 56 error "selection handler aborted" 57} 58 59proc badHandler {path type offset count} { 60 global selValue selInfo 61 selection handle -type $type $path {} 62 lappend selInfo $path $type $offset $count 63 set numBytes [expr {[string length $selValue] - $offset}] 64 if {$numBytes <= 0} { 65 return "" 66 } 67 string range $selValue $offset [expr $numBytes+$offset] 68} 69proc reallyBadHandler {path type offset count} { 70 global selValue selInfo pass 71 if {$offset == 4000} { 72 if {$pass == 0} { 73 set pass 1 74 } else { 75 selection handle -type $type $path {} 76 } 77 } 78 lappend selInfo $path $type $offset $count 79 set numBytes [expr {[string length $selValue] - $offset}] 80 if {$numBytes <= 0} { 81 return "" 82 } 83 string range $selValue $offset [expr $numBytes+$offset] 84} 85 86# Eliminate any existing selection on the screen. This is needed in case 87# there is a selection in some other application, in order to prevent races 88# from causing false errors in the tests below. 89 90selection clear . 91after 1500 92 93# common setup code 94proc setup {{path .f1} {display {}}} { 95 catch {destroy $path} 96 if {$display == {}} { 97 frame $path 98 } else { 99 toplevel $path -screen $display 100 wm geom $path +0+0 101 } 102 selection own $path 103} 104 105# set up a very large buffer to test INCR retrievals 106set longValue "" 107foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} { 108 set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14 109 append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j 110} 111 112test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} {unixOnly} { 113 setupbg 114 entry .e 115 pack .e 116 update 117 .e insert 0 [encoding convertfrom identity \u00fcber] 118 .e selection range 0 end 119 set result [dobg {string bytelength [selection get]}] 120 cleanupbg 121 destroy .e 122 set result 123} {5} 124test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} {unixOnly} { 125 setupbg 126 dobg { 127 entry .e; pack .e; update 128 .e insert 0 \u00fc\u0444 129 .e selection range 0 end 130 } 131 set x [selection get] 132 cleanupbg 133 list [string equal \u00fc? $x] \ 134 [string length $x] [string bytelength $x] 135} {1 2 3} 136test unixSelect-1.4 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} { 137 setupbg 138 setup 139 selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ 140 {handler COMPOUND_TEXT} 141 selection own . 142 set selValue \u00fc\u0444 143 set selInfo {} 144 set result [dobg { 145 set x [selection get -type COMPOUND_TEXT] 146 list [string equal \u00fc\u0444 $x] \ 147 [string length $x] [string bytelength $x] 148 }] 149 cleanupbg 150 lappend result $selInfo 151} {1 2 4 {COMPOUND_TEXT 0 4000}} 152test unixSelect-1.5 {TkSelGetSelection procedure: INCR i18n text, iso2022} {unixOnly} { 153 154 # This test is subtle. The selection ends up getting fetched twice by 155 # Tk: once to compute the length, and again to actually send the data. 156 # The first time through, we don't convert the data to ISO2022, so the 157 # buffer boundaries end up being different in the two passes. 158 159 setupbg 160 setup 161 selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ 162 {handler COMPOUND_TEXT} 163 selection own . 164 set selValue [string repeat x 3999]\u00fc\u0444[string repeat x 3999] 165 set selInfo {} 166 set result [dobg { 167 set x [selection get -type COMPOUND_TEXT] 168 list [string equal \ 169 [string repeat x 3999]\u00fc\u0444[string repeat x 3999] $x] \ 170 [string length $x] [string bytelength $x] 171 }] 172 cleanupbg 173 lappend result $selInfo 174} {1 8000 8002 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3999 COMPOUND_TEXT 7998 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}} 175test unixSelect-1.6 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} { 176 setupbg 177 setup 178 selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ 179 {handler COMPOUND_TEXT} 180 selection own . 181 set selValue \u00fc\u0444 182 set selInfo {} 183 set result [dobg { 184 set x [selection get -type COMPOUND_TEXT] 185 list [string equal \u00fc\u0444 $x] \ 186 [string length $x] [string bytelength $x] 187 }] 188 cleanupbg 189 lappend result $selInfo 190} {1 2 4 {COMPOUND_TEXT 0 4000}} 191test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { 192 setupbg 193 dobg "entry .e; pack .e; update 194 .e insert 0 \[encoding convertfrom identity \\u00fcber\]$longValue 195 .e selection range 0 end" 196 set result [string bytelength [selection get]] 197 cleanupbg 198 set result 199} [expr {5 + [string bytelength $longValue]}] 200test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { 201 setupbg 202 dobg { 203 entry .e; pack .e; update 204 .e insert 0 [string repeat x 3999]\u00fc 205 .e selection range 0 end 206 } 207 set x [selection get] 208 cleanupbg 209 list [string equal [string repeat x 3999]\u00fc $x] \ 210 [string length $x] [string bytelength $x] 211} {1 4000 4001} 212test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { 213 setupbg 214 dobg { 215 entry .e; pack .e; update 216 .e insert 0 \u00fc[string repeat x 3999] 217 .e selection range 0 end 218 } 219 set x [selection get] 220 cleanupbg 221 list [string equal \u00fc[string repeat x 3999] $x] \ 222 [string length $x] [string bytelength $x] 223} {1 4000 4001} 224test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { 225 setupbg 226 dobg { 227 entry .e; pack .e; update 228 .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000] 229 .e selection range 0 end 230 } 231 set x [selection get] 232 cleanupbg 233 list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \ 234 [string length $x] [string bytelength $x] 235} {1 8000 8001} 236# Now some tests to make sure that the right thing is done when 237# transferring UTF8 selections, to prevent [Bug 614650] and its ilk 238# from rearing its ugly head again. 239test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { 240 setupbg 241 dobg { 242 entry .e; pack .e; update 243 .e insert 0 [string repeat x 3999]\u00fc 244 .e selection range 0 end 245 } 246 set x [selection get -type UTF8_STRING] 247 cleanupbg 248 list [string equal [string repeat x 3999]\u00fc $x] \ 249 [string length $x] [string bytelength $x] 250} {1 4000 4001} 251test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { 252 setupbg 253 dobg { 254 entry .e; pack .e; update 255 .e insert 0 \u00fc[string repeat x 3999] 256 .e selection range 0 end 257 } 258 set x [selection get -type UTF8_STRING] 259 cleanupbg 260 list [string equal \u00fc[string repeat x 3999] $x] \ 261 [string length $x] [string bytelength $x] 262} {1 4000 4001} 263test unixSelect-1.13 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { 264 setupbg 265 dobg { 266 entry .e; pack .e; update 267 .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000] 268 .e selection range 0 end 269 } 270 set x [selection get -type UTF8_STRING] 271 cleanupbg 272 list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \ 273 [string length $x] [string bytelength $x] 274} {1 8000 8001} 275test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} {unixOnly} { 276 setupbg 277 entry .e 278 pack .e 279 update 280 .e insert 0 [encoding convertfrom identity \u00fcber\u0444] 281 .e selection range 0 end 282 set result [dobg {string bytelength [selection get -type UTF8_STRING]}] 283 cleanupbg 284 destroy .e 285 set result 286} {5} 287test unixSelect-1.15 {TkSelGetSelection procedure: simple i18n text, utf-8} {unixOnly} { 288 setupbg 289 dobg { 290 entry .e; pack .e; update 291 .e insert 0 \u00fc\u0444 292 .e selection range 0 end 293 } 294 set x [selection get -type UTF8_STRING] 295 cleanupbg 296 list [string equal \u00fc\u0444 $x] \ 297 [string length $x] [string bytelength $x] 298} {1 2 4} 299test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { 300 setupbg 301 dobg { 302 entry .e; pack .e; update 303 .e insert 0 [string repeat [string repeat \u00c4\u00e4 50]\n 21] 304 .e selection range 0 end 305 } 306 set x [selection get -type UTF8_STRING] 307 cleanupbg 308 list [string equal [string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ 309 [string length $x] [string bytelength $x] 310} {1 2121 4221} 311test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { 312 setupbg 313 dobg { 314 entry .e; pack .e; update 315 .e insert 0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21] 316 .e selection range 0 end 317 } 318 set x [selection get -type UTF8_STRING] 319 cleanupbg 320 list [string equal i[string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ 321 [string length $x] [string bytelength $x] 322} {1 2122 4222} 323test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { 324 setupbg 325 dobg { 326 text .t; pack .t; update 327 .t insert 1.0 [string repeat [string repeat \u00c4\u00e4 50]\n 21] 328 # Has to be selected in a separate stage 329 .t tag add sel 1.0 21.end+1c 330 } 331 after 10 332 set x [selection get -type UTF8_STRING] 333 cleanupbg 334 list [string equal [string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ 335 [string length $x] [string bytelength $x] 336} {1 2121 4221} 337test unixSelect-1.19 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { 338 setupbg 339 dobg { 340 text .t; pack .t; update 341 .t insert 1.0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21] 342 # Has to be selected in a separate stage 343 .t tag add sel 1.0 21.end+1c 344 } 345 after 10 346 set x [selection get -type UTF8_STRING] 347 cleanupbg 348 list [string equal i[string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ 349 [string length $x] [string bytelength $x] 350} {1 2122 4222} 351test unixSelect-1.20 {Automatic UTF8_STRING support for selection handle} {unixOnly} { 352 # See Bug #666346 "Selection handling crashes under KDE 3.0" 353 label .l 354 selection handle .l [list handler STRING] 355 set selValue "This is the selection value" 356 selection own .l 357 set result [selection get -type UTF8_STRING] 358 destroy .l 359 set result 360} "This is the selection value" 361 362# cleanup 363::tcltest::cleanupTests 364return 365