438 lines
11 KiB
Plaintext
438 lines
11 KiB
Plaintext
# 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.
|
|
|
|
package require tcltest 2.2
|
|
namespace import ::tcltest::*
|
|
tcltest::configure {*}$argv
|
|
tcltest::loadTestedCommands
|
|
|
|
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} -constraints {
|
|
x11
|
|
} -setup {
|
|
destroy .e
|
|
setupbg
|
|
} -body {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 \u00fcber
|
|
.e selection range 0 end
|
|
dobg {string length [selection get]}
|
|
} -cleanup {
|
|
cleanupbg
|
|
destroy .e
|
|
} -result {4}
|
|
|
|
test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 \u00fc\u0444
|
|
.e selection range 0 end
|
|
}
|
|
selection get
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result \u00fc?
|
|
|
|
test unixSelect-1.3 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
setup
|
|
} -body {
|
|
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]
|
|
}]
|
|
lappend result $selInfo
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result {1 2 {COMPOUND_TEXT 0 4000}}
|
|
|
|
test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
setup
|
|
} -body {
|
|
# This test is subtle. The selection ends up getting fetched twice by
|
|
# Tk: once to compute the length, and again to actually send the data.
|
|
# The first time through, we don't convert the data to ISO2022, so the
|
|
# buffer boundaries end up being different in the two passes.
|
|
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]
|
|
}]
|
|
lappend result $selInfo
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result {1 8000 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3999 COMPOUND_TEXT 7998 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}}
|
|
|
|
test unixSelect-1.5 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
setup
|
|
} -body {
|
|
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]
|
|
}]
|
|
lappend result $selInfo
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result {1 2 {COMPOUND_TEXT 0 4000}}
|
|
|
|
test unixSelect-1.6 {TkSelGetSelection procedure: INCR i18n text} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg [subst -nobackslashes {entry .e; pack .e; update
|
|
.e insert 0 \u00fcber$longValue
|
|
.e selection range 0 end}]
|
|
string length [selection get]
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result [expr {4 + [string length $longValue]}]
|
|
|
|
test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 [string repeat x 3999]\u00fc
|
|
.e selection range 0 end
|
|
}
|
|
selection get
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result [string repeat x 3999]\u00fc
|
|
|
|
test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 \u00fc[string repeat x 3999]
|
|
.e selection range 0 end
|
|
}
|
|
selection get
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result \u00fc[string repeat x 3999]
|
|
|
|
test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000]
|
|
.e selection range 0 end
|
|
}
|
|
selection get
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result [string repeat x 3999]\u00fc[string repeat x 4000]
|
|
# Now some tests to make sure that the right thing is done when
|
|
# transferring UTF8 selections, to prevent [Bug 614650] and its ilk
|
|
# from rearing its ugly head again.
|
|
|
|
test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 [string repeat x 3999]\u00fc
|
|
.e selection range 0 end
|
|
}
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result [string repeat x 3999]\u00fc
|
|
|
|
test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 \u00fc[string repeat x 3999]
|
|
.e selection range 0 end
|
|
}
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result \u00fc[string repeat x 3999]
|
|
|
|
test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 [string repeat x 3999]\u00fc[string repeat x 4000]
|
|
.e selection range 0 end
|
|
}
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result [string repeat x 3999]\u00fc[string repeat x 4000]
|
|
|
|
test unixSelect-1.13 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
destroy .e
|
|
setupbg
|
|
} -body {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 \u00fcber\u0444
|
|
.e selection range 0 end
|
|
dobg {string length [selection get -type UTF8_STRING]}
|
|
} -cleanup {
|
|
destroy .e
|
|
cleanupbg
|
|
} -result {5}
|
|
|
|
test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 \u00fc\u0444
|
|
.e selection range 0 end
|
|
}
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result \u00fc\u0444
|
|
|
|
test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 [string repeat [string repeat \u00c4\u00e4 50]\n 21]
|
|
.e selection range 0 end
|
|
}
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result [string repeat [string repeat \u00c4\u00e4 50]\n 21]
|
|
|
|
test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [entry .e]
|
|
update
|
|
.e insert 0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21]
|
|
.e selection range 0 end
|
|
}
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result i[string repeat [string repeat \u00c4\u00e4 50]\n 21]
|
|
|
|
test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [text .t]
|
|
update
|
|
.t insert 1.0 [string repeat [string repeat \u00c4\u00e4 50]\n 21]
|
|
# Has to be selected in a separate stage
|
|
.t tag add sel 1.0 21.end+1c
|
|
}
|
|
after 10
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result [string repeat [string repeat \u00c4\u00e4 50]\n 21]
|
|
|
|
test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
|
|
x11
|
|
} -setup {
|
|
setupbg
|
|
} -body {
|
|
dobg {
|
|
pack [text .t]
|
|
update
|
|
.t insert 1.0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21]
|
|
# Has to be selected in a separate stage
|
|
.t tag add sel 1.0 21.end+1c
|
|
}
|
|
after 10
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
cleanupbg
|
|
} -result i[string repeat [string repeat \u00c4\u00e4 50]\n 21]
|
|
|
|
test unixSelect-1.19 {Automatic UTF8_STRING support for selection handle} -constraints {
|
|
unix
|
|
} -setup {
|
|
destroy .l
|
|
} -body {
|
|
# See Bug #666346 "Selection handling crashes under KDE 3.0"
|
|
label .l
|
|
selection handle .l [list handler STRING]
|
|
set selValue "This is the selection value"
|
|
selection own .l
|
|
selection get -type UTF8_STRING
|
|
} -cleanup {
|
|
destroy .l
|
|
} -result {This is the selection value}
|
|
|
|
# cleanup
|
|
cleanupTests
|
|
return
|