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