diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/unixSelect.test | 238 |
1 files changed, 238 insertions, 0 deletions
diff --git a/tests/unixSelect.test b/tests/unixSelect.test new file mode 100644 index 0000000..4cc0921 --- /dev/null +++ b/tests/unixSelect.test @@ -0,0 +1,238 @@ +# This file contains tests for the tkUnixSelect.c file. +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: unixSelect.test,v 1.1 1999/06/03 18:50:46 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {$tcl_platform(platform) != "unix"} { + puts "skipping: Unix only tests..." + ::tcltest::cleanupTests + return +} + +eval destroy [winfo child .] + +global longValue selValue selInfo + +set selValue {} +set selInfo {} + +proc handler {type offset count} { + global selValue selInfo + lappend selInfo $type $offset $count + set numBytes [expr {[string length $selValue] - $offset}] + if {$numBytes <= 0} { + return "" + } + string range $selValue $offset [expr $numBytes+$offset] +} + +proc errIncrHandler {type offset count} { + global selValue selInfo pass + if {$offset == 4000} { + if {$pass == 0} { + # Just sizing the selection; don't do anything here. + set pass 1 + } else { + # Fetching the selection; wait long enough to cause a timeout. + after 6000 + } + } + lappend selInfo $type $offset $count + set numBytes [expr {[string length $selValue] - $offset}] + if {$numBytes <= 0} { + return "" + } + string range $selValue $offset [expr $numBytes+$offset] +} + +proc errHandler args { + error "selection handler aborted" +} + +proc badHandler {path type offset count} { + global selValue selInfo + selection handle -type $type $path {} + lappend selInfo $path $type $offset $count + set numBytes [expr {[string length $selValue] - $offset}] + if {$numBytes <= 0} { + return "" + } + string range $selValue $offset [expr $numBytes+$offset] +} +proc reallyBadHandler {path type offset count} { + global selValue selInfo pass + if {$offset == 4000} { + if {$pass == 0} { + set pass 1 + } else { + selection handle -type $type $path {} + } + } + lappend selInfo $path $type $offset $count + set numBytes [expr {[string length $selValue] - $offset}] + if {$numBytes <= 0} { + return "" + } + string range $selValue $offset [expr $numBytes+$offset] +} + +# Eliminate any existing selection on the screen. This is needed in case +# there is a selection in some other application, in order to prevent races +# from causing false errors in the tests below. + +selection clear . +after 1500 + +# common setup code +proc setup {{path .f1} {display {}}} { + catch {destroy $path} + if {$display == {}} { + frame $path + } else { + toplevel $path -screen $display + wm geom $path +0+0 + } + selection own $path +} + +# set up a very large buffer to test INCR retrievals +set longValue "" +foreach 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} { + 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 + 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 +} + +test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} {unixOnly} { + setupbg + entry .e + pack .e + update + .e insert 0 [encoding convertfrom identity \u00fcber] + .e selection range 0 end + set result [dobg {string bytelength [selection get]}] + cleanupbg + destroy .e + set result +} {5} +test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} {unixOnly} { + setupbg + dobg { + entry .e; pack .e; update + .e insert 0 \u00fc\u0444 + .e selection range 0 end + } + set x [selection get] + cleanupbg + list [string equal \u00fc? $x] \ + [string length $x] [string bytelength $x] +} {1 2 3} +test unixSelect-1.4 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} { + setupbg + setup + selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ + {handler COMPOUND_TEXT} + selection own . + set selValue \u00fc\u0444 + set selInfo {} + set result [dobg { + set x [selection get -type COMPOUND_TEXT] + list [string equal \u00fc\u0444 $x] \ + [string length $x] [string bytelength $x] + }] + cleanupbg + lappend result $selInfo +} {1 2 4 {COMPOUND_TEXT 0 4000}} +test unixSelect-1.5 {TkSelGetSelection procedure: INCR i18n text, iso2022} {unixOnly} { + setupbg + setup + selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ + {handler COMPOUND_TEXT} + selection own . + set selValue [string repeat x 3999]\u00fc\u0444[string repeat x 3999] + set selInfo {} + set result [dobg { + set x [selection get -type COMPOUND_TEXT] + list [string equal \ + [string repeat x 3999]\u00fc\u0444[string repeat x 3999] $x] \ + [string length $x] [string bytelength $x] + }] + cleanupbg + lappend result $selInfo +} {1 8000 8002 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}} +test unixSelect-1.6 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} { + setupbg + setup + selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ + {handler COMPOUND_TEXT} + selection own . + set selValue \u00fc\u0444 + set selInfo {} + set result [dobg { + set x [selection get -type COMPOUND_TEXT] + list [string equal \u00fc\u0444 $x] \ + [string length $x] [string bytelength $x] + }] + cleanupbg + lappend result $selInfo +} {1 2 4 {COMPOUND_TEXT 0 4000}} +test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { + setupbg + dobg "entry .e; pack .e; update + .e insert 0 \[encoding convertfrom identity \\u00fcber\]$longValue + .e selection range 0 end" + set result [string bytelength [selection get]] + cleanupbg + set result +} [expr {5 + [string bytelength $longValue]}] +test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { + setupbg + dobg { + entry .e; pack .e; update + .e insert 0 [string repeat x 3999]\u00fc + .e selection range 0 end + } + set x [selection get] + cleanupbg + list [string equal [string repeat x 3999]\u00fc $x] \ + [string length $x] [string bytelength $x] +} {1 4000 4001} +test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { + setupbg + dobg { + entry .e; pack .e; update + .e insert 0 \u00fc[string repeat x 3999] + .e selection range 0 end + } + set x [selection get] + cleanupbg + list [string equal \u00fc[string repeat x 3999] $x] \ + [string length $x] [string bytelength $x] +} {1 4000 4001} +test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { + setupbg + dobg { + entry .e; pack .e; update + .e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000] + .e selection range 0 end + } + set x [selection get] + cleanupbg + list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \ + [string length $x] [string bytelength $x] +} {1 8000 8001} + +# cleanup +::tcltest::cleanupTests +return |