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

1 files changed, 29 insertions, 55 deletions

diff --git a/tests/safePrimarySelection.test b/tests/safePrimarySelection.test
index 4605735..84d2d0f 100644
--- a/tests/safePrimarySelection.test
+++ b/tests/safePrimarySelection.test
@@ -11,6 +11,9 @@ namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
+# Import utility procs for specific functional areas
+testutils import child
+
 # ------------------------------------------------------------------------------
 # Tests that a Safe Base interpreter cannot write to the PRIMARY selection.
 # ------------------------------------------------------------------------------
@@ -26,42 +29,12 @@ tcltest::loadTestedCommands
 #   PRIMARY selection.
 # - A safe interpreter must not write to the PRIMARY selection.
 # - The spinbox, ttk::spinbox are variants of entry, ttk::entry respectively.
+# - The command "childTkInterp" is not needed for Safe Base children because
+#   safe::loadTk does something similar and works correctly.
 # ------------------------------------------------------------------------------
 
 namespace eval ::_test_tmp {}
 
-# ------------------------------------------------------------------------------
-#  Proc ::_test_tmp::unsafeInterp
-# ------------------------------------------------------------------------------
-# Command that creates an child interpreter and tries to load Tk.
-# - This is necessary for loading Tk if the tests are done in the build
-#   directory without installing Tk.  In that case the usual auto_path loading
-#   mechanism cannot work because the tk binary is not where pkgIndex.tcl says
-#   it is.
-# - This command is not needed for Safe Base children because safe::loadTk does
-#   something similar and works correctly.
-# - Based on scripts in winSend.test.
-# ------------------------------------------------------------------------------
-
-namespace eval ::_test_tmp {
-    variable TkLoadCmd
-}
-
-foreach pkg [info loaded] {
-    if {[lindex $pkg 1] eq "Tk"} {
-	set ::_test_tmp::TkLoadCmd [list load {*}$pkg]
-	break
-    }
-}
-
-proc ::_test_tmp::unsafeInterp {name} {
-    variable TkLoadCmd
-    interp create $name
-    $name eval [list set argv [list -name $name]]
-    catch {{*}$TkLoadCmd $name}
-}
-
-
 set ::_test_tmp::script {
     package require tk
     namespace eval ::_test_tmp {}
@@ -337,7 +310,7 @@ test safePrimarySelection-2.1 {child interpreter, text, no existing selection} -
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryText
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -354,7 +327,7 @@ test safePrimarySelection-2.2 {child interpreter, entry, no existing selection}
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryEntry
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -371,7 +344,7 @@ test safePrimarySelection-2.3 {child interpreter, ttk::entry, no existing select
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryTtkEntry
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -388,7 +361,7 @@ test safePrimarySelection-2.4 {child interpreter, listbox, no existing selection
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryListbox
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -405,7 +378,7 @@ test safePrimarySelection-2.5 {child interpreter, spinbox as entry, no existing
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::trySpinbox 1
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -422,7 +395,7 @@ test safePrimarySelection-2.6 {child interpreter, spinbox spun, no existing sele
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::trySpinbox 2
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -439,7 +412,7 @@ test safePrimarySelection-2.7 {child interpreter, spinbox spun/selected/spun, no
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::trySpinbox 3
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -456,7 +429,7 @@ test safePrimarySelection-2.8 {child interpreter, ttk::spinbox as entry, no exis
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryTtkSpinbox 1
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -473,7 +446,7 @@ test safePrimarySelection-2.9 {child interpreter, ttk::spinbox spun, no existing
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryTtkSpinbox 2
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -490,7 +463,7 @@ test safePrimarySelection-2.10 {child interpreter, ttk::spinbox spun/selected/sp
     ::_test_tmp::clearPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryTtkSpinbox 3
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -837,7 +810,7 @@ test safePrimarySelection-5.1 {child interpreter, text, existing selection} -set
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryText
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -854,7 +827,7 @@ test safePrimarySelection-5.2 {child interpreter, entry, existing selection} -se
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryEntry
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -871,7 +844,7 @@ test safePrimarySelection-5.3 {child interpreter, ttk::entry, existing selection
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryTtkEntry
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -888,7 +861,7 @@ test safePrimarySelection-5.4 {child interpreter, listbox, existing selection} -
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryListbox
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -905,7 +878,7 @@ test safePrimarySelection-5.5 {child interpreter, spinbox as entry, existing sel
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::trySpinbox 1
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -922,7 +895,7 @@ test safePrimarySelection-5.6 {child interpreter, spinbox spun, existing selecti
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::trySpinbox 2
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -939,7 +912,7 @@ test safePrimarySelection-5.7 {child interpreter, spinbox spun/selected/spun, ex
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::trySpinbox 3
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -956,7 +929,7 @@ test safePrimarySelection-5.8 {child interpreter, ttk::spinbox as entry, existin
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryTtkSpinbox 1
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -973,7 +946,7 @@ test safePrimarySelection-5.9 {child interpreter, ttk::spinbox spun, existing se
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryTtkSpinbox 2
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -990,7 +963,7 @@ test safePrimarySelection-5.10 {child interpreter, ttk::spinbox spun/selected/sp
     ::_test_tmp::setPrimarySelection
 } -body {
     set int2 child2
-    ::_test_tmp::unsafeInterp $int2
+    childTkInterp $int2
     $int2 eval $::_test_tmp::script
     $int2 eval ::_test_tmp::tryTtkSpinbox 3
     $int2 eval ::_test_tmp::getPrimarySelection
@@ -1211,10 +1184,11 @@ test safePrimarySelection-6.10 {IMPORTANT, safe interpreter, ttk::spinbox spun/s
     ::_test_tmp::clearPrimarySelection
 } -result {OLD_VALUE----OLD_VALUE}
 
+#
+# CLEANUP
+#
 
 namespace delete ::_test_tmp
-
-# option clear
-# cleanup
+testutils forget child
 cleanupTests
 return