diff options
Diffstat (limited to 'tests/select.test')
| -rw-r--r-- | tests/select.test | 472 |
1 files changed, 188 insertions, 284 deletions
diff --git a/tests/select.test b/tests/select.test index a55e279..661bd06 100644 --- a/tests/select.test +++ b/tests/select.test @@ -13,102 +13,25 @@ package require tcltest 2.2 namespace import ::tcltest::* -namespace import ::tk::test:loadTkCommand eval tcltest::configure $argv tcltest::loadTestedCommands +# Import utility procs for specific functional areas +testutils import child select + testConstraint cliboardManagerPresent 0 if {![catch {selection get -selection CLIPBOARD_MANAGER -type TARGETS}]} { if {"SAVE_TARGETS" in [selection get -selection CLIPBOARD_MANAGER -type TARGETS]} { testConstraint cliboardManagerPresent 1 } } -testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] - -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} { @@ -117,21 +40,20 @@ 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} { } # Now we start the main body of the test code - + test select-1.1 {Tk_CreateSelHandler procedure} -setup { - setup + selectionSetup } -body { lsort [selection get TARGETS] } -result {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} test select-1.2 {Tk_CreateSelHandler procedure} -setup { - setup + selectionSetup } -body { selection handle .f1 {handler TEST} TEST lsort [selection get TARGETS] } -result {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} test select-1.3 {Tk_CreateSelHandler procedure} -setup { - global selValue selInfo - setup + selectionSetup } -body { selection handle .f1 {handler TEST} TEST set selValue "Test value" @@ -139,22 +61,21 @@ test select-1.3 {Tk_CreateSelHandler procedure} -setup { list [selection get TEST] $selInfo } -result {{Test value} {TEST 0 4000}} test select-1.4.1 {Tk_CreateSelHandler procedure} -constraints unix -setup { - setup + selectionSetup } -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} lsort [selection get TARGETS] } -result {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} test select-1.4.2 {Tk_CreateSelHandler procedure} -constraints win -setup { - setup + selectionSetup } -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} lsort [selection get TARGETS] } -result {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} test select-1.5 {Tk_CreateSelHandler procedure} -setup { - global selValue selInfo - setup + selectionSetup } -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} @@ -163,8 +84,7 @@ test select-1.5 {Tk_CreateSelHandler procedure} -setup { list [selection get] $selInfo } -result {{} {STRING 0 4000}} test select-1.6.1 {Tk_CreateSelHandler procedure} -constraints unix -setup { - global selValue selInfo - setup + selectionSetup } -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} @@ -177,8 +97,7 @@ test select-1.6.1 {Tk_CreateSelHandler procedure} -constraints unix -setup { list $selInfo [lsort [selection get TARGETS]] } -result {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} test select-1.6.2 {Tk_CreateSelHandler procedure} -constraints win -setup { - global selValue selInfo - setup + selectionSetup } -body { selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} @@ -191,7 +110,7 @@ test select-1.6.2 {Tk_CreateSelHandler procedure} -constraints win -setup { list $selInfo [lsort [selection get TARGETS]] } -result {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-1.7.1 {Tk_CreateSelHandler procedure} -constraints unix -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD .f1 selection handle -selection CLIPBOARD .f1 {handler TEST} TEST @@ -200,7 +119,7 @@ test select-1.7.1 {Tk_CreateSelHandler procedure} -constraints unix -setup { [lsort [selection get -selection CLIPBOARD TARGETS]] } -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-1.7.2 {Tk_CreateSelHandler procedure} -constraints win -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD .f1 selection handle -selection CLIPBOARD .f1 {handler TEST} TEST @@ -209,7 +128,7 @@ test select-1.7.2 {Tk_CreateSelHandler procedure} -constraints win -setup { [lsort [selection get -selection CLIPBOARD TARGETS]] } -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-1.8 {Tk_CreateSelHandler procedure} -setup { - setup + selectionSetup } -body { selection handle -format INTEGER -type TEST .f1 {handler TEST} lsort [selection get TARGETS] @@ -218,7 +137,7 @@ test select-1.8 {Tk_CreateSelHandler procedure} -setup { ############################################################################## test select-2.1 {Tk_DeleteSelHandler procedure} -constraints unix -setup { - setup + selectionSetup } -body { selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -228,7 +147,7 @@ test select-2.1 {Tk_DeleteSelHandler procedure} -constraints unix -setup { lappend result [lsort [selection get TARGETS]] } -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}} test select-2.2 {Tk_DeleteSelHandler procedure} -constraints unix -setup { - setup + selectionSetup } -body { selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -238,7 +157,7 @@ test select-2.2 {Tk_DeleteSelHandler procedure} -constraints unix -setup { lappend result [lsort [selection get TARGETS]] } -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} test select-2.3 {Tk_DeleteSelHandler procedure} -constraints unix -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD .f1 selection handle -selection PRIMARY .f1 {handler STRING} @@ -248,7 +167,7 @@ test select-2.3 {Tk_DeleteSelHandler procedure} -constraints unix -setup { [lsort [selection get -selection CLIPBOARD TARGETS]] } -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-2.4 {Tk_DeleteSelHandler procedure} -constraints win -setup { - setup + selectionSetup } -body { selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -258,7 +177,7 @@ test select-2.4 {Tk_DeleteSelHandler procedure} -constraints win -setup { lappend result [lsort [selection get TARGETS]] } -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}} test select-2.5 {Tk_DeleteSelHandler procedure} -constraints win -setup { - setup + selectionSetup } -body { selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -268,7 +187,7 @@ test select-2.5 {Tk_DeleteSelHandler procedure} -constraints win -setup { lappend result [lsort [selection get TARGETS]] } -result {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-2.6 {Tk_DeleteSelHandler procedure} -constraints win -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD .f1 selection handle -selection PRIMARY .f1 {handler STRING} @@ -278,7 +197,7 @@ test select-2.6 {Tk_DeleteSelHandler procedure} -constraints win -setup { [lsort [selection get -selection CLIPBOARD TARGETS]] } -result {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-2.7 {Tk_DeleteSelHandler procedure} -setup { - setup + selectionSetup } -body { selection handle .f1 {handler STRING} list [selection handle .f1 {}] [selection handle .f1 {}] @@ -287,26 +206,26 @@ test select-2.7 {Tk_DeleteSelHandler procedure} -setup { ############################################################################## test select-3.1 {Tk_OwnSelection procedure} -setup { - setup + selectionSetup } -body { selection own } -result {.f1} test select-3.2 {Tk_OwnSelection procedure} -body { - setup .f1 + selectionSetup .f1 set result [selection own] - setup .f2 + selectionSetup .f2 lappend result [selection own] } -result {.f1 .f2} test select-3.3 {Tk_OwnSelection procedure} -setup { - setup .f1 - setup .f2 + selectionSetup .f1 + selectionSetup .f2 } -body { selection own -selection CLIPBOARD .f1 list [selection own] [selection own -selection CLIPBOARD] } -result {.f2 .f1} test select-3.4 {Tk_OwnSelection procedure} -setup { global lostSel - setup + selectionSetup } -body { set lostSel {owned} selection own -command { set lostSel {lost} } .f1 @@ -315,8 +234,8 @@ test select-3.4 {Tk_OwnSelection procedure} -setup { } -result {lost} test select-3.5 {Tk_OwnSelection procedure} -setup { global lostSel - setup .f1 - setup .f2 + selectionSetup .f1 + selectionSetup .f2 } -body { set lostSel {owned} selection own -command { set lostSel {lost1} } .f1 @@ -325,7 +244,7 @@ test select-3.5 {Tk_OwnSelection procedure} -setup { } -result {lost1 .f2} test select-3.6 {Tk_OwnSelection procedure} -setup { global lostSel - setup + selectionSetup } -body { set lostSel {owned} selection own -command { set lostSel {lost1} } .f1 @@ -336,29 +255,29 @@ test select-3.6 {Tk_OwnSelection procedure} -setup { } -result {owned lost2} test select-3.7 {Tk_OwnSelection procedure} -constraints x11 -setup { global lostSel - setup - setupbg + selectionSetup + childTkProcess create } -body { set lostSel {owned} selection own -command { set lostSel {lost1} } .f1 update set result {} - lappend result [dobg { selection own . }] - lappend result [dobg {selection own}] + lappend result [childTkProcess eval { selection own . }] + lappend result [childTkProcess eval {selection own}] update - cleanupbg + childTkProcess exit lappend result $lostSel } -result {{} . lost1} # check reentrancy on selection replacement test select-3.8 {Tk_OwnSelection procedure} -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD -command { destroy .f1 } .f1 selection own -selection CLIPBOARD . } -result {} test select-3.9 {Tk_OwnSelection procedure} -setup { - setup .f2 - setup .f1 + selectionSetup .f2 + selectionSetup .f1 } -body { selection own -selection CLIPBOARD -command { destroy .f2 } .f1 selection own -selection CLIPBOARD .f2 @@ -367,59 +286,59 @@ test select-3.9 {Tk_OwnSelection procedure} -setup { test select-3.10 {Tk_OwnSelection procedure} -constraints { altDisplay } -body { - setup .f1 - setup .f2 $env(TK_ALT_DISPLAY) + selectionSetup .f1 + selectionSetup .f2 $env(TK_ALT_DISPLAY) list [selection own -displayof .f1] [selection own -displayof .f2] } -result {.f1 .f2} test select-3.11 {Tk_OwnSelection procedure} -constraints { altDisplay } -setup { - setup .f1 - setup .f2 $env(TK_ALT_DISPLAY) - setupbg + selectionSetup .f1 + selectionSetup .f2 $env(TK_ALT_DISPLAY) + childTkProcess create update set result "" } -body { - lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection own .t; update"] + lappend result [childTkProcess eval "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection own .t; update"] lappend result [selection own -displayof .f1] \ [selection own -displayof .f2] } -cleanup { - cleanupbg + childTkProcess exit } -result {{} .f1 {}} ############################################################################## test select-4.1 {Tk_ClearSelection procedure} -setup { - setup + selectionSetup } -body { set result [selection own] selection clear .f1 lappend result [selection own] } -result {.f1 {}} test select-4.2 {Tk_ClearSelection procedure} -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD .f1 selection clear .f1 selection own -selection CLIPBOARD } -result {.f1} test select-4.3 {Tk_ClearSelection procedure} -setup { - setup + selectionSetup } -body { list [selection clear .f1] [selection clear .f1] } -result {{} {}} test select-4.4 {Tk_ClearSelection procedure} -constraints x11 -setup { global lostSel - setup - setupbg + selectionSetup + childTkProcess create } -body { set lostSel {owned} selection own -command { set lostSel {lost1} } .f1 update set result {} - lappend result [dobg {selection clear; update}] + lappend result [childTkProcess eval {selection clear; update}] update - cleanupbg + childTkProcess exit lappend result [selection own] } -result {{} {}} # multiple display tests @@ -427,8 +346,8 @@ test select-4.5 {Tk_ClearSelection procedure} -constraints { altDisplay } -setup { global lostSel lostSel2 - setup .f1 - setup .f2 $env(TK_ALT_DISPLAY) + selectionSetup .f1 + selectionSetup .f2 $env(TK_ALT_DISPLAY) } -body { set lostSel {owned} set lostSel2 {owned2} @@ -442,9 +361,9 @@ test select-4.5 {Tk_ClearSelection procedure} -constraints { test select-4.6 {Tk_ClearSelection procedure} -constraints { x11 altDisplay } -setup { - setup .f1 - setup .f2 $env(TK_ALT_DISPLAY) - setupbg + selectionSetup .f1 + selectionSetup .f2 $env(TK_ALT_DISPLAY) + childTkProcess create } -body { set lostSel {owned} set lostSel2 {owned2} @@ -452,27 +371,27 @@ test select-4.6 {Tk_ClearSelection procedure} -constraints { selection own -command { set lostSel2 {lost2} } .f2 update set result "" - lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection own .t; update"] + lappend result [childTkProcess eval "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection own .t; update"] lappend result [selection own -displayof .f1] \ [selection own -displayof .f2] $lostSel $lostSel2 - cleanupbg + childTkProcess exit set result } -result {{} .f1 {} owned lost2} ############################################################################## test select-5.1 {Tk_GetSelection procedure} -returnCodes error -setup { - setup + selectionSetup } -body { selection get TEST } -result {PRIMARY selection doesn't exist or form "TEST" not defined} test select-5.2 {Tk_GetSelection procedure} -setup { - setup + selectionSetup } -body { selection get TK_WINDOW } -result {.f1} test select-5.3 {Tk_GetSelection procedure} -setup { - setup + selectionSetup } -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST set selValue "Test value" @@ -480,13 +399,13 @@ test select-5.3 {Tk_GetSelection procedure} -setup { list [selection get TEST] $selInfo } -result {{Test value} {TEST 0 4000}} test select-5.4 {Tk_GetSelection procedure} -setup { - setup + selectionSetup } -returnCodes error -body { selection handle .f1 ERROR errHandler selection get ERROR } -result {PRIMARY selection doesn't exist or form "ERROR" not defined} test select-5.5 {Tk_GetSelection procedure} -setup { - setup + selectionSetup } -body { set selValue $longValue set selInfo "" @@ -494,7 +413,7 @@ test select-5.5 {Tk_GetSelection procedure} -setup { list [selection get] $selInfo } -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000}" test select-5.6 {Tk_GetSelection procedure} -setup { - setup + selectionSetup } -returnCodes error -body { set selValue $longValue set selInfo "" @@ -505,7 +424,7 @@ test select-5.6 {Tk_GetSelection procedure} -setup { selection get } -result {PRIMARY selection doesn't exist or form "STRING" not defined} test select-5.7 {Tk_GetSelection procedure} -setup { - setup + selectionSetup } -returnCodes error -body { set selValue "Test Value" set selInfo "" @@ -516,7 +435,7 @@ test select-5.7 {Tk_GetSelection procedure} -setup { selection get } -result {PRIMARY selection doesn't exist or form "STRING" not defined} test select-5.8 {Tk_GetSelection procedure} -setup { - setup + selectionSetup } -body { set selValue $longValue set selInfo "" @@ -527,21 +446,21 @@ test select-5.8 {Tk_GetSelection procedure} -setup { list [selection get] $selInfo [catch {selection get} msg] $msg } -result "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}" test select-5.9 {Tk_GetSelection procedure} -constraints x11 -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST update set selValue "Test value" set selInfo "" set result "" - lappend result [dobg {selection get TEST}] - cleanupbg + lappend result [childTkProcess eval {selection get TEST}] + childTkProcess exit lappend result $selInfo } -result {{Test value} {TEST 0 4000}} test select-5.10 {Tk_GetSelection procedure} -constraints x11 -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST update @@ -549,16 +468,16 @@ test select-5.10 {Tk_GetSelection procedure} -constraints x11 -setup { set selInfo "" selection own .f1 set result "" - lappend result [dobg {selection get TEST} 1] - cleanupbg + lappend result [childTkProcess eval {selection get TEST} 1] + childTkProcess exit lappend result $selInfo } -result {{selection owner didn't respond} {}} # multiple display tests test select-5.11 {Tk_GetSelection procedure} -constraints { altDisplay } -setup { - setup .f1 - setup .f2 $env(TK_ALT_DISPLAY) + selectionSetup .f1 + selectionSetup .f2 $env(TK_ALT_DISPLAY) } -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST selection handle -selection PRIMARY .f2 {handler TEST2} TEST @@ -573,8 +492,8 @@ test select-5.12 {Tk_GetSelection procedure} -constraints { altDisplay } -setup { global lostSel lostSel2 - setup .f1 - setup .f2 $env(TK_ALT_DISPLAY) + selectionSetup .f1 + selectionSetup .f2 $env(TK_ALT_DISPLAY) } -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST selection handle -selection PRIMARY .f2 {} TEST @@ -589,9 +508,9 @@ test select-5.12 {Tk_GetSelection procedure} -constraints { test select-5.13 {Tk_GetSelection procedure} -constraints { x11 altDisplay } -setup { - setup .f1 - setup .f2 $env(TK_ALT_DISPLAY) - setupbg + selectionSetup .f1 + selectionSetup .f2 $env(TK_ALT_DISPLAY) + childTkProcess create } -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST selection own .f1 @@ -601,18 +520,18 @@ test select-5.13 {Tk_GetSelection procedure} -constraints { set selInfo "" update set result "" - lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"] + lappend result [childTkProcess eval "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"] set selValue "Test value2" - lappend result [dobg "selection get TEST"] - cleanupbg + lappend result [childTkProcess eval "selection get TEST"] + childTkProcess exit lappend result $selInfo } -result {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}} test select-5.14 {Tk_GetSelection procedure} -constraints { x11 altDisplay } -setup { - setup .f1 - setup .f2 $env(TK_ALT_DISPLAY) - setupbg + selectionSetup .f1 + selectionSetup .f2 $env(TK_ALT_DISPLAY) + childTkProcess create } -body { selection handle -selection PRIMARY .f1 {handler TEST} TEST selection own .f1 @@ -622,14 +541,14 @@ test select-5.14 {Tk_GetSelection procedure} -constraints { set selInfo "" update set result "" - lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"] + lappend result [childTkProcess eval "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"] set selValue "Test value2" - lappend result [dobg "selection get TEST"] - cleanupbg + lappend result [childTkProcess eval "selection get TEST"] + childTkProcess exit lappend result $selInfo } -result {{PRIMARY selection doesn't exist or form "TEST" not defined} {Test value2} {TEST 0 4000}} test select-5.15 {Tk_GetSelection procedure} -setup { - setup + selectionSetup if {[llength [info command ::bgerror]]} { rename ::bgerror ::TMPbgerror } @@ -655,7 +574,7 @@ test select-6.2 {Tk_SelectionCmd procedure} -body { selection clear -selection } -returnCodes error -result {value for "-selection" missing} test select-6.3 {Tk_SelectionCmd procedure} -setup { - setup + selectionSetup } -body { selection own . set result [selection own] @@ -663,7 +582,7 @@ test select-6.3 {Tk_SelectionCmd procedure} -setup { lappend result [selection own] } -result {. {}} test select-6.4 {Tk_SelectionCmd procedure} -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD .f1 set result [list [selection own] [selection own -selection CLIPBOARD]] @@ -671,7 +590,7 @@ test select-6.4 {Tk_SelectionCmd procedure} -setup { lappend result [selection own] [selection own -selection CLIPBOARD] } -result {.f1 .f1 .f1 {}} test select-6.5 {Tk_SelectionCmd procedure} -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD . set result [list [selection own] [selection own -selection CLIPBOARD]] @@ -693,14 +612,14 @@ test select-6.9 {Tk_SelectionCmd procedure} -body { selection clear .f2 } -returnCodes error -result {bad window path name ".f2"} test select-6.10 {Tk_SelectionCmd procedure} -setup { - setup + selectionSetup } -body { set result [selection own -selection PRIMARY] selection clear lappend result [selection own -selection PRIMARY] } -result {.f1 {}} test select-6.11 {Tk_SelectionCmd procedure} -setup { - setup + selectionSetup } -body { selection own -selection CLIPBOARD .f1 set result [selection own -selection CLIPBOARD] @@ -715,8 +634,7 @@ test select-6.13 {Tk_SelectionCmd procedure} -body { selection get -selection } -returnCodes error -result {value for "-selection" missing} test select-6.14 {Tk_SelectionCmd procedure} -setup { - global selValue selInfo - setup + selectionSetup } -body { selection handle .f1 {handler TEST} set selValue "Test value" @@ -724,8 +642,7 @@ test select-6.14 {Tk_SelectionCmd procedure} -setup { list [selection get -displayof .f1] $selInfo } -result {{Test value} {TEST 0 4000}} test select-6.15 {Tk_SelectionCmd procedure} -setup { - global selValue selInfo - setup + selectionSetup } -body { selection handle .f1 {handler STRING} selection handle -selection CLIPBOARD .f1 {handler TEST} @@ -735,8 +652,7 @@ test select-6.15 {Tk_SelectionCmd procedure} -setup { list [selection get -selection CLIPBOARD] $selInfo } -result {{Test value} {TEST 0 4000}} test select-6.16 {Tk_SelectionCmd procedure} -setup { - global selValue selInfo - setup + selectionSetup } -body { selection handle -type TEST .f1 {handler TEST} selection handle -type STRING .f1 {handler STRING} @@ -758,8 +674,7 @@ test select-6.20 {Tk_SelectionCmd procedure} -returnCodes error -body { selection get foo bar } -result {wrong # args: should be "selection get ?-option value ...?"} test select-6.21 {Tk_SelectionCmd procedure} -setup { - global selValue selInfo - setup + selectionSetup } -body { selection handle -type TEST .f1 {handler TEST} selection handle -type STRING .f1 {handler STRING} @@ -773,8 +688,7 @@ test select-6.22 {Tk_SelectionCmd procedure} -body { selection handle -selection } -returnCodes error -result {value for "-selection" missing} test select-6.23 {Tk_SelectionCmd procedure} -setup { - global selValue selInfo - setup + selectionSetup } -body { set selValue "Test value" set selInfo "" @@ -804,13 +718,13 @@ test select-6.30 {Tk_SelectionCmd procedure} -body { selection own -selection } -returnCodes error -result {value for "-selection" missing} test select-6.31 {Tk_SelectionCmd procedure} -setup { - setup + selectionSetup } -body { selection own . selection own -displayof .f1 } -result {.} test select-6.32 {Tk_SelectionCmd procedure} -setup { - setup + selectionSetup } -body { selection own . selection own -selection CLIPBOARD .f1 @@ -818,7 +732,7 @@ test select-6.32 {Tk_SelectionCmd procedure} -setup { } -result {. .f1} test select-6.33 {Tk_SelectionCmd procedure} -setup { global lostSel - setup + selectionSetup } -body { set lostSel owned selection own -command { set lostSel lost } . @@ -854,7 +768,7 @@ test select-6.39 {Tk_SelectionCmd procedure} -returnCodes error -body { # selection request when the window doesn't exist, which causes a different # error message. test select-7.1 {TkSelDeadWindow procedure} -constraints nonPortable -setup { - setup + selectionSetup } -body { selection handle .f1 { handler TEST } set result [selection own] @@ -866,22 +780,22 @@ test select-7.1 {TkSelDeadWindow procedure} -constraints nonPortable -setup { # Check reentrancy on losing selection test select-8.1 {TkSelEventProc procedure} -constraints x11 -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { selection own -selection CLIPBOARD -command {destroy .f1} .f1 update - dobg {selection own -selection CLIPBOARD .} + childTkProcess eval {selection own -selection CLIPBOARD .} winfo children . } -cleanup { - cleanupbg + childTkProcess exit } -result {} ############################################################################## test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup { - setup - setupbg + selectionSetup + childTkProcess create } -constraints x11 -body { set selValue "1024" set selInfo "" @@ -889,52 +803,52 @@ test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup { .f1 {handler TEST} update set result "" - lappend result [dobg {selection get TEST}] - cleanupbg + lappend result [childTkProcess eval {selection get TEST}] + childTkProcess exit lappend result $selInfo } -result {{0x400 } {TEST 0 4000}} test select-9.2 {SelCvtToX and SelCvtFromX procedures} -setup { - setup - setupbg + selectionSetup + childTkProcess create } -constraints {x11 failsOnUbuntu} -body { set selValue "1024 0xffff 2048 -2 " set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ .f1 {handler TEST} set result "" - lappend result [dobg {selection get TEST}] - cleanupbg + lappend result [childTkProcess eval {selection get TEST}] + childTkProcess exit lappend result $selInfo } -result {{0x400 0xffff 0x800 0xfffffffe } {TEST 0 4000}} test select-9.3 {SelCvtToX and SelCvtFromX procedures} -setup { - setup - setupbg + selectionSetup + childTkProcess create } -constraints {x11 failsOnUbuntu} -body { set selValue " " set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ .f1 {handler TEST} set result "" - lappend result [dobg {selection get TEST}] - cleanupbg + lappend result [childTkProcess eval {selection get TEST}] + childTkProcess exit lappend result $selInfo } -result {{ } {TEST 0 4000}} test select-9.4 {SelCvtToX and SelCvtFromX procedures} -setup { - setup - setupbg + selectionSetup + childTkProcess create } -constraints {x11 failsOnUbuntu} -body { set selValue "16 foobar 32" set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ .f1 {handler TEST} set result "" - lappend result [dobg {selection get TEST}] - cleanupbg + lappend result [childTkProcess eval {selection get TEST}] + childTkProcess exit lappend result $selInfo } -result {{0x10 0x0 0x20 } {TEST 0 4000}} test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup { - setup - setupbg + selectionSetup + childTkProcess create } -constraints x11 -body { # Ensure that lists of atoms are constructed correctly, even when the # atom names have spaces in. [Bug 1353414] @@ -943,9 +857,9 @@ test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup { set selType {text/x-tk-test;detail="foo bar"} selection handle -selection PRIMARY -format STRING -type $selType \ .f1 [list handler $selType] - lsort [dobg {selection get TARGETS}] + lsort [childTkProcess eval {selection get TARGETS}] } -cleanup { - cleanupbg + childTkProcess exit } -result {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW {text/x-tk-test;detail="foo bar"}} ############################################################################## @@ -955,7 +869,7 @@ test select-9.5 {SelCvtToX and SelCvtFromX procedures} -setup { test select-10.1 {ConvertSelection procedure, race with selection clear} -constraints { x11 } -setup { - setup + selectionSetup } -body { proc Ready {fd} { variable x @@ -984,63 +898,63 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} -constr lappend x $selInfo } -result {{1:PRIMARY selection doesn't exist or form "STRING" not defined} {}} test select-10.2 {ConvertSelection procedure} -constraints x11 -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { set selValue [string range $longValue 0 3999] set selInfo "" selection handle .f1 {handler STRING} set result "" - lappend result [dobg {selection get}] - cleanupbg + lappend result [childTkProcess eval {selection get}] + childTkProcess exit lappend result $selInfo } -result [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}] test select-10.3 {ConvertSelection procedure} -constraints x11 -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { selection handle .f1 ERROR errHandler - dobg {selection get ERROR} + childTkProcess eval {selection get ERROR} } -cleanup { - cleanupbg + childTkProcess exit } -result {PRIMARY selection doesn't exist or form "ERROR" not defined} # testing timers # This one hangs in Exceed test select-10.4 {ConvertSelection procedure} -constraints { x11 failsOnUbuntu } -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { set selValue $longValue set selInfo "" selection handle .f1 {errIncrHandler STRING} set result "" set pass 0 - lappend result [dobg {selection get}] - cleanupbg + lappend result [childTkProcess eval {selection get}] + childTkProcess exit lappend result $selInfo } -result {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}} test select-10.5 {ConvertSelection procedure, reentrancy issues} -constraints { x11 failsOnUbuntu } -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { set selValue "Test value" set selInfo "" selection handle -type TEST .f1 { handler TEST } selection handle -type STRING .f1 { badHandler .f1 STRING } set result "" - lappend result [dobg {selection get}] - cleanupbg + lappend result [childTkProcess eval {selection get}] + childTkProcess exit lappend result $selInfo } -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}} test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints { x11 failsOnUbuntu } -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { proc weirdHandler {type offset count} { destroy .f1 @@ -1050,8 +964,8 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints { set selInfo "" selection handle .f1 {weirdHandler STRING} set result "" - lappend result [dobg {selection get}] - cleanupbg + lappend result [childTkProcess eval {selection get}] + childTkProcess exit lappend result $selInfo } -cleanup { rename weirdHandler {} @@ -1061,8 +975,8 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints { # testing reentrancy test select-11.1 {TkSelPropProc procedure} -constraints {x11 failsOnUbuntu} -setup { - setup - setupbg + selectionSetup + childTkProcess create } -body { set selValue $longValue set selInfo "" @@ -1070,8 +984,8 @@ test select-11.1 {TkSelPropProc procedure} -constraints {x11 failsOnUbuntu} -set selection handle -type STRING .f1 { reallyBadHandler .f1 STRING } set result "" set pass 0 - lappend result [dobg {selection get}] - cleanupbg + lappend result [childTkProcess eval {selection get}] + childTkProcess exit lappend result $selInfo } -result {{selection owner didn't respond} {.f1 STRING 0 4000 .f1 STRING 4000 4000 .f1 STRING 8000 4000 .f1 STRING 12000 4000 .f1 STRING 16000 4000 .f1 STRING 0 4000 .f1 STRING 4000 4000}} @@ -1079,50 +993,50 @@ test select-11.1 {TkSelPropProc procedure} -constraints {x11 failsOnUbuntu} -set # Note, this assumes we are using CurrentTtime test select-12.1 {DefaultSelection procedure} -constraints x11 -body { - setup + selectionSetup set result [selection get -type TIMESTAMP] - setupbg - lappend result [dobg {selection get -type TIMESTAMP}] - cleanupbg + childTkProcess create + lappend result [childTkProcess eval {selection get -type TIMESTAMP}] + childTkProcess exit set result } -result {0x0 {0x0 }} test select-12.2 {DefaultSelection procedure} -constraints x11 -body { - setup + selectionSetup set result [lsort [list [selection get -type TARGETS]]] - setupbg - lappend result [dobg {lsort [selection get -type TARGETS]}] - cleanupbg + childTkProcess create + lappend result [childTkProcess eval {lsort [selection get -type TARGETS]}] + childTkProcess exit set result } -result {{MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-12.3 {DefaultSelection procedure} -constraints x11 -body { - setup + selectionSetup selection handle .f1 {handler TEST} TEST set result [list [lsort [selection get -type TARGETS]]] - setupbg - lappend result [dobg {lsort [selection get -type TARGETS]}] - cleanupbg + childTkProcess create + lappend result [childTkProcess eval {lsort [selection get -type TARGETS]}] + childTkProcess exit set result } -result {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-12.4 {DefaultSelection procedure} -constraints x11 -setup { - setup + selectionSetup set result "" } -body { lappend result [selection get -type TK_APPLICATION] - setupbg - lappend result [dobg {selection get -type TK_APPLICATION}] - cleanupbg + childTkProcess create + lappend result [childTkProcess eval {selection get -type TK_APPLICATION}] + childTkProcess exit set result } -result [list [winfo name .] [winfo name .]] test select-12.5 {DefaultSelection procedure} -constraints x11 -body { - setup + selectionSetup set result [selection get -type TK_WINDOW] - setupbg - lappend result [dobg {selection get -type TK_WINDOW}] - cleanupbg + childTkProcess create + lappend result [childTkProcess eval {selection get -type TK_WINDOW}] + childTkProcess exit set result } -result {.f1 .f1} test select-12.6 {DefaultSelection procedure} -body { - setup + selectionSetup selection handle .f1 {handler TARGETS.f1} TARGETS set selValue "Targets value" set selInfo "" @@ -1134,29 +1048,16 @@ test select-12.6 {DefaultSelection procedure} -body { test select-13.1 {SelectionSize procedure, handler deleted} -constraints { x11 failsOnUbuntu } -setup { - setup - setupbg -} -body { - proc badHandler {path type offset count} { - global selValue selInfo abortCount - incr abortCount -1 - if {$abortCount == 0} { - 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}] - } + selectionSetup + childTkProcess create +} -body { set selValue $longValue set selInfo "" - selection handle .f1 {badHandler .f1 STRING} + selection handle .f1 {badHandler2 .f1 STRING} set result "" set abortCount 2 - lappend result [dobg {selection get}] - cleanupbg + lappend result [childTkProcess eval {selection get}] + childTkProcess exit lappend result $selInfo } -result {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}} @@ -1172,9 +1073,12 @@ test select-14.1 {Bug [73ba07efcd]: Use correct property type when handling MULT } -cleanup { rename get_clip {} } -result {abcd} - -# cleanup +# +# CLEANUP +# + +testutils forget child select cleanupTests return |