path: root/tk/tests/unixSelect.test

# 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$

package require tcltest 2.1
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
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} {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} {

    # 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.

    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 4000 3999 COMPOUND_TEXT 7998 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}
# 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.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} {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 -type UTF8_STRING]
    cleanupbg
    list [string equal [string repeat x 3999]\u00fc $x] \
	    [string length $x] [string bytelength $x]
} {1 4000 4001}
test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} {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 -type UTF8_STRING]
    cleanupbg
    list [string equal \u00fc[string repeat x 3999] $x] \
	    [string length $x] [string bytelength $x]
} {1 4000 4001}
test unixSelect-1.13 {TkSelGetSelection procedure: INCR i18n text, utf-8} {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 -type UTF8_STRING]
    cleanupbg
    list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \
	    [string length $x] [string bytelength $x]
} {1 8000 8001}
test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} {unixOnly} {
    setupbg
    entry .e
    pack .e
    update
    .e insert 0 [encoding convertfrom identity \u00fcber\u0444]
    .e selection range 0 end
    set result [dobg {string bytelength [selection get -type UTF8_STRING]}]
    cleanupbg
    destroy .e
    set result
} {5}
test unixSelect-1.15 {TkSelGetSelection procedure: simple i18n text, utf-8} {unixOnly} {
    setupbg
    dobg {
	entry .e; pack .e; update
	.e insert 0 \u00fc\u0444
	.e selection range 0 end
    }
    set x [selection get -type UTF8_STRING]
    cleanupbg
    list [string equal \u00fc\u0444 $x] \
	    [string length $x] [string bytelength $x]
} {1 2 4}
test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} {
    setupbg
    dobg {
	entry .e; pack .e; update
	.e insert 0 [string repeat [string repeat \u00c4\u00e4 50]\n 21]
	.e selection range 0 end
    }
    set x [selection get -type UTF8_STRING]
    cleanupbg
    list [string equal [string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \
	    [string length $x] [string bytelength $x]
} {1 2121 4221}
test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} {
    setupbg
    dobg {
	entry .e; pack .e; update
	.e insert 0 i[string repeat [string repeat \u00c4\u00e4 50]\n 21]
	.e selection range 0 end
    }
    set x [selection get -type UTF8_STRING]
    cleanupbg
    list [string equal i[string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \
	    [string length $x] [string bytelength $x]
} {1 2122 4222}
test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} {
    setupbg
    dobg {
	text .t; pack .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
    set x [selection get -type UTF8_STRING]
    cleanupbg
    list [string equal [string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \
	    [string length $x] [string bytelength $x]
} {1 2121 4221}
test unixSelect-1.19 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} {
    setupbg
    dobg {
	text .t; pack .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
    set x [selection get -type UTF8_STRING]
    cleanupbg
    list [string equal i[string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \
	    [string length $x] [string bytelength $x]
} {1 2122 4222}

# cleanup
::tcltest::cleanupTests
return