Merge core-9-0-branchcore-tip-716

1 files changed, 64 insertions, 135 deletions

diff --git a/tests/unixSelect.test b/tests/unixSelect.test
index ece8a95..59d02c6 100644
--- a/tests/unixSelect.test
+++ b/tests/unixSelect.test
@@ -14,90 +14,15 @@ 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]
-}
+# Import utility procs for specific functional areas
+testutils import child select
 
 # 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} {
@@ -111,24 +36,24 @@ test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} -constraints
     x11
 } -setup {
     destroy .e
-    setupbg
+    childTkProcess create
 } -body {
     pack [entry .e]
     update
     .e insert 0 über
     .e selection range 0 end
-    dobg {string length [selection get]}
+    childTkProcess eval {string length [selection get]}
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
     destroy .e
 } -result 4
 
 test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 üф
@@ -136,34 +61,34 @@ test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} -
     }
     selection get
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result ü?
 
 test unixSelect-1.3 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints {
     x11
 } -setup {
-    setupbg
-    setup
+    childTkProcess create
+    selectionSetup
 } -body {
     selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
 	{handler COMPOUND_TEXT}
     selection own .
     set selValue üф
     set selInfo {}
-    set result [dobg {
+    set result [childTkProcess eval {
 	set x [selection get -type COMPOUND_TEXT]
 	list [string equal üф $x] [string length $x]
     }]
     lappend result $selInfo
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result {1 2 {COMPOUND_TEXT 0 4000}}
 
 test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -constraints {
     x11
 } -setup {
-    setupbg
-    setup
+    childTkProcess create
+    selectionSetup
 } -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.
@@ -174,7 +99,7 @@ test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -cons
     selection own .
     set selValue [string repeat x 3999]üф[string repeat x 3999]
     set selInfo {}
-    set result [dobg {
+    set result [childTkProcess eval {
 	set x [selection get -type COMPOUND_TEXT]
 	list [string equal \
 	    [string repeat x 3999]üф[string repeat x 3999] $x] \
@@ -182,48 +107,48 @@ test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -cons
     }]
     lappend result $selInfo
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -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
+    childTkProcess create
+    selectionSetup
 } -body {
     selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
 	{handler COMPOUND_TEXT}
     selection own .
     set selValue üф
     set selInfo {}
-    set result [dobg {
+    set result [childTkProcess eval {
 	set x [selection get -type COMPOUND_TEXT]
 	list [string equal üф $x] [string length $x]
     }]
     lappend result $selInfo
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result {1 2 {COMPOUND_TEXT 0 4000}}
 
 test unixSelect-1.6 {TkSelGetSelection procedure: INCR i18n text} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg [subst -nobackslashes {entry .e; pack .e; update
+    childTkProcess eval [subst -nobackslashes {entry .e; pack .e; update
     .e insert 0 über$longValue
     .e selection range 0 end}]
     string length [selection get]
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result [expr {4 + [string length $longValue]}]
 
 test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 [string repeat x 3999]ü
@@ -231,15 +156,15 @@ test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} -constraints {
     }
     selection get
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result [string repeat x 3999]ü
 
 test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 ü[string repeat x 3999]
@@ -247,15 +172,15 @@ test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints {
     }
     selection get
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result ü[string repeat x 3999]
 
 test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 [string repeat x 3999]ü[string repeat x 4000]
@@ -263,7 +188,7 @@ test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints {
     }
     selection get
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result [string repeat x 3999]ü[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
@@ -272,9 +197,9 @@ test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints {
 test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 [string repeat x 3999]ü
@@ -282,15 +207,15 @@ test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
     }
     selection get -type UTF8_STRING
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result [string repeat x 3999]ü
 
 test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 ü[string repeat x 3999]
@@ -298,15 +223,15 @@ test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
     }
     selection get -type UTF8_STRING
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result ü[string repeat x 3999]
 
 test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 [string repeat x 3999]ü[string repeat x 4000]
@@ -314,31 +239,31 @@ test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
     }
     selection get -type UTF8_STRING
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result [string repeat x 3999]ü[string repeat x 4000]
 
 test unixSelect-1.13 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints {
     x11
 } -setup {
     destroy .e
-    setupbg
+    childTkProcess create
 } -body {
     pack [entry .e]
     update
     .e insert 0 überф
     .e selection range 0 end
-    dobg {string length [selection get -type UTF8_STRING]}
+    childTkProcess eval {string length [selection get -type UTF8_STRING]}
 } -cleanup {
     destroy .e
-    cleanupbg
+    childTkProcess exit
 } -result 5
 
 test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 üф
@@ -346,15 +271,15 @@ test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} -con
     }
     selection get -type UTF8_STRING
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result üф
 
 test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 [string repeat [string repeat Ää 50]\n 21]
@@ -362,15 +287,15 @@ test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
     }
     selection get -type UTF8_STRING
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result [string repeat [string repeat Ää 50]\n 21]
 
 test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [entry .e]
 	update
 	.e insert 0 i[string repeat [string repeat Ää 50]\n 21]
@@ -378,15 +303,15 @@ test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
     }
     selection get -type UTF8_STRING
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result i[string repeat [string repeat Ää 50]\n 21]
 
 test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [text .t]
 	update
 	.t insert 1.0 [string repeat [string repeat Ää 50]\n 21]
@@ -396,15 +321,15 @@ test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
     after 10
     selection get -type UTF8_STRING
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result [string repeat [string repeat Ää 50]\n 21]
 
 test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
     x11
 } -setup {
-    setupbg
+    childTkProcess create
 } -body {
-    dobg {
+    childTkProcess eval {
 	pack [text .t]
 	update
 	.t insert 1.0 i[string repeat [string repeat Ää 50]\n 21]
@@ -414,7 +339,7 @@ test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
     after 10
     selection get -type UTF8_STRING
 } -cleanup {
-    cleanupbg
+    childTkProcess exit
 } -result i[string repeat [string repeat Ää 50]\n 21]
 
 test unixSelect-1.19 {Automatic UTF8_STRING support for selection handle} -constraints {
@@ -432,6 +357,10 @@ test unixSelect-1.19 {Automatic UTF8_STRING support for selection handle} -const
     destroy .l
 } -result {This is the selection value}
 
-# cleanup
+#
+# CLEANUP
+#
+
+testutils forget child select
 cleanupTests
 return