Remove dependencies between tests in env.test.

1 files changed, 232 insertions, 167 deletions

diff --git a/tests/env.test b/tests/env.test
index 0dd4f98..2c077b1 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -16,49 +16,96 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import -force ::tcltest::*
 }
 
-# Some tests require the "exec" command.
-# Skip them if exec is not defined.
-testConstraint exec [llength [info commands exec]]
+package require tcltests
+
+# [exec] is required here to see the actual environment received by child
+# processes.
+proc getenv {} {
+    global printenvScript
+    catch {exec [interpreter] $printenvScript} out
+    if {$out eq "child process exited abnormally"} {
+	set out {}
+    }
+    return $out
+}
+
+
+proc envrestore {} {
+    # Restore the environment variables at the end of the test.
+    global env
+    variable env2
+
+    foreach name [array names env] {
+	unset env($name)
+    }
+    array set env $env2
+    return
+}
+
+
+proc envprep {} {
+    # Save the current environment variables at the start of the test.
+    global env
+    variable keep
+    variable env2
+
+    set env2 [array get env]
+    foreach name [array names env] {
+	# Keep some environment variables that support operation of the tcltest
+	# package.
+	if {[string toupper $name] ni $keep} {
+	    unset env($name)
+	}
+    }
+    return
+}
+
+
+proc encodingrestore {} {
+    variable sysenc
+    encoding system $sysenc
+    return
+}
+
+
+proc encodingswitch encoding {
+    variable sysenc
+    # Need to run [getenv] in known encoding, so save the current one here...
+    set sysenc [encoding system]
+    encoding system $encoding
+    return
+}
+
+
+proc setup1 {} {
+    global env
+    envprep
+    encodingswitch iso8859-1
+}
+
+proc setup2 {} {
+    global env
+    setup1
+    set env(NAME1) {test string}
+    set env(NAME2) {new value}
+    set env(XYZZY) {garbage}
+}
+
+
+proc cleanup1 {} {
+    encodingrestore
+    envrestore
+}
 
-#
-# These tests will run on any platform (and indeed crashed on the Mac). So put
-# them before you test for the existance of exec.
-#
-test env-1.1 {propagation of env values to child interpreters} -setup {
-    catch {interp delete child}
-    catch {unset env(test)}
-} -body {
-    interp create child
-    set env(test) garbage
-    child eval {set env(test)}
-} -cleanup {
-    interp delete child
-    unset env(test)
-} -result {garbage}
-#
-# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
-# runs.
-#
-test env-1.2 {lappend to env value} -setup {
-    catch {unset env(test)}
-} -body {
-    set env(test) aaaaaaaaaaaaaaaa
-    append env(test) bbbbbbbbbbbbbb
-    unset env(test)
+variable keep {
+    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
+    SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
+    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
+    SECURITYSESSIONID LANG WINDIR TERM
+    CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
 }
-test env-1.3 {reflection of env by "array names"} -setup {
-    catch {interp delete child}
-    catch {unset env(test)}
-} -body {
-    interp create child
-    child eval {set env(test) garbage}
-    expr {"test" in [array names env]}
-} -cleanup {
-    interp delete child
-    catch {unset env(test)}
-} -result {1}
 
-set printenvScript [makeFile {
+variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
     encoding system iso8859-1
     proc lrem {listname name} {
 	upvar $listname list
@@ -70,7 +117,7 @@ set printenvScript [makeFile {
     }
     proc mangle s {
 	regsub -all {\[|\\|\]} $s {\\&} s
-	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
+	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar {&}]} s
 	return [subst -novariables $s]
     }
     proc manglechar c {
@@ -84,161 +131,154 @@ set printenvScript [makeFile {
 	lrem names ComSpec
 	lrem names ""
     }
-    foreach name {
-	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
-	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
-	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
-	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
-	CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
-    } {
+    foreach name @keep@ {
 	lrem names $name
     }
     foreach p $names {
-	puts "[mangle $p]=[mangle $env($p)]"
+	puts [mangle $p]=[mangle $env($p)]
     }
     exit
-} printenv]
+}] printenv]
 
-# [exec] is required here to see the actual environment received by child
-# processes.
-proc getenv {} {
-    global printenvScript tcltest
-    catch {exec [interpreter] $printenvScript} out
-    if {$out eq "child process exited abnormally"} {
-	set out {}
-    }
-    return $out
-}
 
-# Save the current environment variables at the start of the test.
-
-set env2 [array get env]
-foreach name [array names env] {
-    # Keep some environment variables that support operation of the tcltest
-    # package.
-    if {[string toupper $name] ni {
-	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
-	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
-	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
-	SECURITYSESSIONID LANG WINDIR TERM
-	CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
-    }} {
-	unset env($name)
-    }
+test env-1.1 {propagation of env values to child interpreters} -setup {
+    catch {interp delete child}
+    catch {unset env(test)}
+} -body {
+    interp create child
+    set env(test) garbage
+    child eval {set env(test)}
+} -cleanup {
+    interp delete child
+    unset env(test)
+} -result {garbage}
+
+
+# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
+# runs.
+test env-1.2 {lappend to env value} -setup {
+    catch {unset env(test)}
+} -body {
+    set env(test) aaaaaaaaaaaaaaaa
+    append env(test) bbbbbbbbbbbbbb
+    unset env(test)
 }
 
-# Need to run 'getenv' in known encoding, so save the current one here...
-set sysenc [encoding system]
 
-test env-2.1 {adding environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
-    getenv
+test env-1.3 {reflection of env by "array names"} -setup {
+    catch {interp delete child}
+    catch {unset env(test)}
+} -body {
+    interp create child
+    child eval {set env(test) garbage}
+    expr {"test" in [array names env]}
 } -cleanup {
-    encoding system $sysenc
-} -result {}
-test env-2.2 {adding environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+    interp delete child
+    catch {unset env(test)}
+} -result 1
+
+
+test env-2.1 {
+    adding environment variables
+} -constraints exec -setup setup1 -body {
+    getenv
+} -cleanup cleanup1 -result {}
+
+
+test env-2.2 {
+    adding environment variables
+} -constraints exec -setup setup1 -body {
     set env(NAME1) "test string"
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {NAME1=test string}
-test env-2.3 {adding environment variables} -setup {
-    encoding system iso8859-1
+} -cleanup cleanup1 -result {NAME1=test string}
+
+
+test env-2.3 {adding environment variables} -constraints exec -setup {
+    setup1
     set env(NAME1) "test string"
-} -constraints {exec} -body {
+} -body {
     set env(NAME2) "more"
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {NAME1=test string
+} -cleanup cleanup1 -result {NAME1=test string
 NAME2=more}
-test env-2.4 {adding environment variables} -setup {
-    encoding system iso8859-1
+
+
+test env-2.4 {
+    adding environment variables
+} -constraints exec -setup {
+    setup1
     set env(NAME1) "test string"
     set env(NAME2) "more"
-} -constraints {exec} -body {
+} -body {
     set env(XYZZY) "garbage"
     getenv
-} -cleanup {
-    encoding system $sysenc
+} -cleanup { cleanup1
 } -result {NAME1=test string
 NAME2=more
 XYZZY=garbage}
 
-set env(NAME1) "test string"
-set env(NAME2) "new value"
-set env(XYZZY) "garbage"
-test env-3.1 {changing environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+
+test env-3.1 {
+    changing environment variables
+} -constraints exec -setup setup2 -body {
     set result [getenv]
     unset env(NAME2)
     set result
 } -cleanup {
-    encoding system $sysenc
+    cleanup1
 } -result {NAME1=test string
 NAME2=new value
 XYZZY=garbage}
-unset -nocomplain env(NAME2)
 
-test env-4.1 {unsetting environment variables: default} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+
+test env-4.1 {
+    unsetting environment variables
+} -constraints exec -setup setup2 -body {
+    unset -nocomplain env(NAME2)
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {NAME1=test string
+} -cleanup cleanup1 -result {NAME1=test string
 XYZZY=garbage}
-test env-4.2 {unsetting environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
-    unset env(NAME1)
-    getenv
-} -cleanup {
-    unset env(XYZZY)
-    encoding system $sysenc
-} -result {XYZZY=garbage}
-unset -nocomplain env(NAME1) env(XYZZY)
-test env-4.3 {setting international environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+
+# env-4.2 is deleted
+
+test env-4.3 {
+    setting international environment variables
+} -constraints exec -setup setup1 -body {
     set env(\ua7) \ub6
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {\u00a7=\u00b6}
-test env-4.4 {changing international environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+} -cleanup cleanup1 -result {\u00a7=\u00b6}
+
+
+test env-4.4 {
+    changing international environment variables
+} -constraints exec -setup setup1 -body {
     set env(\ua7) \ua7
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {\u00a7=\u00a7}
-test env-4.5 {unsetting international environment variables} -setup {
-    encoding system iso8859-1
+} -cleanup cleanup1 -result {\u00a7=\u00a7}
+
+
+test env-4.5 {
+    unsetting international environment variables
+} -constraints exec -setup {
+    setup1
     set env(\ua7) \ua7
 } -body {
     set env(\ub6) \ua7
     unset env(\ua7)
     getenv
-} -constraints {exec} -cleanup {
-    unset env(\ub6)
-    encoding system $sysenc
-} -result {\u00b6=\u00a7}
+} -cleanup cleanup1 -result {\u00b6=\u00a7}
 
-test env-5.0 {corner cases - set a value, it should exist} -body {
+test env-5.0 {
+    corner cases - set a value, it should exist
+} -setup setup1 -body {
     set env(temp) a
     set env(temp)
-} -cleanup {
-    unset env(temp)
-} -result {a}
-test env-5.1 {corner cases - remove one elem at a time} -setup {
-    set x [array get env]
-} -body {
+} -cleanup cleanup1 -result a
+
+
+test env-5.1 {
+    corner cases - remove one elem at a time
+} -setup setup1 -body {
     # When no environment variables exist, the env var will contain no
     # entries. The "array names" call synchs up the C-level environ array with
     # the Tcl level env array. Make sure an empty Tcl array is created.
@@ -246,9 +286,9 @@ test env-5.1 {corner cases - remove one elem at a time} -setup {
 	unset env($e)
     }
     array size env
-} -cleanup {
-    array set env $x
-} -result {0}
+} -cleanup cleanup1 -result 0
+
+
 test env-5.2 {corner cases - unset the env array} -setup {
     interp create i
 } -body {
@@ -262,42 +302,54 @@ test env-5.2 {corner cases - unset the env array} -setup {
 } -cleanup {
     interp delete i
 } -result {0}
+
+
 test env-5.3 {corner cases: unset the env in master should unset child} -setup {
+    setup1
     interp create i
 } -body {
     # Variables deleted in a master interp should be deleted in child interp
     # too.
-    i eval { set env(THIS_SHOULD_EXIST) a}
+    i eval {set env(THIS_SHOULD_EXIST) a}
     set result [set env(THIS_SHOULD_EXIST)]
     unset env(THIS_SHOULD_EXIST)
     lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
 } -cleanup {
+    cleanup1
     interp delete i
 } -result {a 1}
+
+
 test env-5.4 {corner cases - unset the env array} -setup {
+    setup1
     interp create i
 } -body {
     # The info exists command should be in synch with the env array.
     # Know Bug: 1737
-    i eval { set env(THIS_SHOULD_EXIST) a}
+    i eval {set env(THIS_SHOULD_EXIST) a}
     set     result [info exists env(THIS_SHOULD_EXIST)]
     lappend result [set env(THIS_SHOULD_EXIST)]
     lappend result [info exists env(THIS_SHOULD_EXIST)]
 } -cleanup {
+    cleanup1
     interp delete i
 } -result {1 a 1}
-test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body {
+
+
+test env-5.5 {
+    corner cases - cannot have null entries on Windows
+} -constraints win -body {
     set env() a
     catch {set env()}
-} -result 1
+} -cleanup cleanup1 -result 1
 
-test env-6.1 {corner cases - add lots of env variables} -body {
+test env-6.1 {corner cases - add lots of env variables} -setup setup1 -body {
     set size [array size env]
     for {set i 0} {$i < 100} {incr i} {
 	set env(BOGUS$i) $i
     }
     expr {[array size env] - $size}
-} -result 100
+} -cleanup cleanup1 -result 100
 
 test env-7.1 {[219226]: whole env array should not be unset by read} -body {
     set n [array size env]
@@ -310,16 +362,20 @@ test env-7.1 {[219226]: whole env array should not be unset by read} -body {
     return $n
 } -result 0
 
-test env-7.2 {[219226]: links to env elements should not be removed by read} -body {
+test env-7.2 {
+    [219226]: links to env elements should not be removed by read
+} -setup setup1 -body {
     apply {{} {
 	set ::env(test7_2) ok
 	upvar env(test7_2) elem
 	set ::env(PATH)
 	return $elem
     }}
-} -result ok
+} -cleanup cleanup1 -result ok
 
-test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body {
+test env-7.3 {
+    [9b4702]: testing existence of env(some_thing) should not destroy trace
+} -setup setup1 -body {
     apply {{} {
       catch {unset ::env(test7_3)}
       proc foo args {
@@ -330,16 +386,25 @@ test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy
       set ::env(not_yet_existent) "Now I'm here";
       return [info exists ::env(test7_3)]
     }}
-} -result 1
+} -cleanup cleanup1 -result 1
 
-# Restore the environment variables at the end of the test.
+test env-8.0 {
+    memory usage - valgrind does not report reachable memory
+} -body {
+    set res [set env(__DUMMY__) {i'm with dummy}]
+    unset env(__DUMMY__)
+    return $res
+} -result {i'm with dummy}
+
 
-foreach name [array names env] {
-    unset env($name)
-}
-array set env $env2
 
 # cleanup
+rename getenv {} 
+rename envrestore {} 
+rename envprep {}
+rename encodingrestore {}
+rename encodingswitch {}
+
 removeFile $printenvScript
 ::tcltest::cleanupTests
 return