Rewrite to use tcltest2 and not generate non-ascii chars in results.

Part of fix of [Bug 1513659]

1 files changed, 58 insertions, 55 deletions

diff --git a/tests/env.test b/tests/env.test
index e417db2..2d4dc8a 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: env.test,v 1.28 2007/01/19 01:04:00 das Exp $
+# RCS: @(#) $Id: env.test,v 1.29 2008/07/19 09:57:37 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -27,37 +27,39 @@ testConstraint exec [llength [info commands exec]]
 # 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} {
+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
-    set return [child eval {set env(test)}]
+    child eval {set env(test)}
+} -cleanup {
     interp delete child
     unset env(test)
-    set return
-} {garbage}
+} -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} {
+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)
-} {}
-test env-1.3 {reflection of env by "array names"} {
+}
+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}
-    set names [array names env]
+    expr {"test" in [array names env]}
+} -cleanup {
     interp delete child
-    set ix [lsearch $names test]
     catch {unset env(test)}
-    expr {$ix >= 0}
-} {1}
+} -result {1}
 
 set printenvScript [makeFile {
     proc lrem {listname name} {
@@ -68,6 +70,14 @@ set printenvScript [makeFile {
 	}
 	return $list
     }
+    proc mangle s {
+	regsub -all {\[|\\|\]} $s {\\&} s
+	regsub -all {[\u007f-\uffff]} $s {[manglechar &]} s
+	return [subst -novariables $s]
+    }
+    proc manglechar c {
+	return [format {\u%04x} [scan $c %c]]
+    }
 	
     set names [lsort [array names env]]
     if {$tcl_platform(platform) == "windows"} {
@@ -85,11 +95,10 @@ set printenvScript [makeFile {
 	lrem names $name
     }
     foreach p $names {
-	puts "$p=$env($p)"
+	puts "[mangle $p]=[mangle $env($p)]"
     }
     exit
 } printenv]
-	
 # [exec] is required here to see the actual environment received
 # by child processes.
 proc getenv {} {
@@ -103,9 +112,8 @@ proc getenv {} {
 
 # Save the current environment variables at the start of the test.
 
+set env2 [array get env]
 foreach name [array names env] {
-    set env2($name) $env($name)
-
     # Keep some environment variables that support operation of the
     # tcltest package.
     if {[string toupper $name] ni {
@@ -121,18 +129,15 @@ foreach name [array names env] {
 test env-2.1 {adding environment variables} {exec} {
     getenv
 } {}
-
 set env(NAME1) "test string"
 test env-2.2 {adding environment variables} {exec} {
     getenv
 } {NAME1=test string}
-
 set env(NAME2) "more"
 test env-2.3 {adding environment variables} {exec} {
     getenv
 } {NAME1=test string
 NAME2=more}
-
 set env(XYZZY) "garbage"
 test env-2.4 {adding environment variables} {exec} {
     getenv
@@ -155,84 +160,84 @@ test env-4.1 {unsetting environment variables} {exec} {
     set result
 } {NAME1=test string
 XYZZY=garbage}
-
 test env-4.2 {unsetting environment variables} {exec} {
     set result [getenv]
     unset env(XYZZY)
     set result
 } {XYZZY=garbage}
-
 test env-4.3 {setting international environment variables} {exec} {
     set env(\ua7) \ub6
     getenv
-} "\ua7=\ub6"
+} {\u00a7=\u00b6}
 test env-4.4 {changing international environment variables} {exec} {
     set env(\ua7) \ua7
     getenv
-} "\ua7=\ua7"
+} {\u00a7=\u00a7}
 test env-4.5 {unsetting international environment variables} {exec} {
     set env(\ub6) \ua7
     unset env(\ua7)
     set result [getenv]
     unset env(\ub6)
     set result
-} "\ub6=\ua7"
+} {\u00b6=\u00a7}
 
-test env-5.0 {corner cases - set a value, it should exist} {} {
+test env-5.0 {corner cases - set a value, it should exist} -body {
     set env(temp) a
-    set result [set env(temp)]
+    set env(temp)
+} -cleanup {
     unset env(temp)
-    set result
-} {a}
-test env-5.1 {corner cases - remove one elem at a time} {} {
+} -result {a}
+test env-5.1 {corner cases - remove one elem at a time} -setup {
+    set x [array get env]
+} -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.
-
-    set x [array get env]
     foreach e [array names env] {
 	unset env($e)
     }
-    set result [catch {array names env}]
+    array size env
+} -cleanup {
     array set env $x
-    set result
-} {0}
-test env-5.2 {corner cases - unset the env array} {} {
+} -result {0}
+test env-5.2 {corner cases - unset the env array} -setup {
+    interp create i 
+} -body {
     # Unsetting a variable in an interp detaches the C-level
     # traces from the Tcl "env" variable.
-
-    interp create i 
-    i eval { unset env }
-    i eval { set env(THIS_SHOULDNT_EXIST) a}
-    set result [info exists env(THIS_SHOULDNT_EXIST)]
+    i eval {
+	unset env
+	set env(THIS_SHOULDNT_EXIST) a
+    }
+    info exists env(THIS_SHOULDNT_EXIST)
+} -cleanup {
     interp delete i
-    set result
-} {0}
-test env-5.3 {corner cases - unset the env in master should unset child} {} {
+} -result {0}
+test env-5.3 {corner cases - unset the env in master should unset child} -setup {
+    interp create i 
+} -body {
     # Variables deleted in a master interp should be deleted in
     # child interp too.
-
-    interp create i 
     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 {
     interp delete i
-    set result
-} {a 1}
-test env-5.4 {corner cases - unset the env array} {} {
+} -result {a 1}
+test env-5.4 {corner cases - unset the env array} -setup {
+    interp create i 
+} -body {
     # The info exists command should be in synch with the env array.
     # Know Bug: 1737
-
-    interp create i 
     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 {
     interp delete i
-    set result
-} {1 a 1}
+} -result {1 a 1}
 test env-5.5 {corner cases - cannot have null entries on Windows} {win} {
     set env() a
     catch {set env()}
@@ -251,9 +256,7 @@ test env-6.1 {corner cases - add lots of env variables} {} {
 foreach name [array names env] {
     unset env($name)
 }
-foreach name [array names env2] {
-    set env($name) $env2($name)
-}
+array set env $env2
 
 # cleanup
 removeFile $printenvScript