1 files changed, 74 insertions, 6 deletions

diff --git a/contrib/tcl/tests/util.test b/contrib/tcl/tests/util.test
index e7a3f2f..ee37047 100644
--- a/contrib/tcl/tests/util.test
+++ b/contrib/tcl/tests/util.test
@@ -6,7 +6,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# SCCS: @(#) util.test 1.5 97/06/16 13:21:57
+# SCCS: @(#) util.test 1.8 97/08/12 15:50:02
 
 if {[info commands testobj] == {}} {
     puts "This application hasn't been compiled with the \"testobj\""
@@ -42,23 +42,91 @@ test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces}
     concat $x [llength "{$x}"]
 } {\ \\\{\ \\ 1}
 
-test util-4.1 {Tcl_SetObjErrorCode - one arg} {
+test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a {b\ } c
+} {a b\  c}
+test util-4.2 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a {b\   } c
+} {a b\  c}
+test util-4.3 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a {b\\   } c
+} {a b\\  c}
+test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a {b } c
+} {a b c}
+test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
+    concat a { } c
+} {a c}
+
+test util-5.1 {Tcl_SetObjErrorCode - one arg} {
     catch {testsetobjerrorcode 1}
     list [set errorCode]
 } {1}
-test util-4.2 {Tcl_SetObjErrorCode - two args} {
+test util-5.2 {Tcl_SetObjErrorCode - two args} {
     catch {testsetobjerrorcode 1 2}
     list [set errorCode]
 } {{1 2}}
-test util-4.3 {Tcl_SetObjErrorCode - three args} {
+test util-5.3 {Tcl_SetObjErrorCode - three args} {
     catch {testsetobjerrorcode 1 2 3}
     list [set errorCode]
 } {{1 2 3}}
-test util-4.4 {Tcl_SetObjErrorCode - four args} {
+test util-5.4 {Tcl_SetObjErrorCode - four args} {
     catch {testsetobjerrorcode 1 2 3 4}
     list [set errorCode]
 } {{1 2 3 4}}
-test util-4.5 {Tcl_SetObjErrorCode - five args} {
+test util-5.5 {Tcl_SetObjErrorCode - five args} {
     catch {testsetobjerrorcode 1 2 3 4 5}
     list [set errorCode]
 } {{1 2 3 4 5}}
+
+test util-6.1 {Tcl_PrintDouble - using tcl_precision} {
+    concat x[expr 1.4]
+} {x1.4}
+test util-6.2 {Tcl_PrintDouble - using tcl_precision} {
+    concat x[expr 1.39999999999]
+} {x1.39999999999}
+test util-6.3 {Tcl_PrintDouble - using tcl_precision} {
+    concat x[expr 1.399999999999]
+} {x1.4}
+test util-6.4 {Tcl_PrintDouble - using tcl_precision} {
+    set tcl_precision 5
+    concat x[expr 1.123412341234]
+} {x1.1234}
+set tcl_precision 12
+test util-6.4 {Tcl_PrintDouble - make sure there's a decimal point} {
+    concat x[expr 2.0]
+} {x2.0}
+test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {
+    concat x[expr 3.0e98]
+} {x3e+98}
+
+test util-7.1 {TclPrecTraceProc - unset callbacks} {
+    set tcl_precision 7
+    set x $tcl_precision
+    unset tcl_precision
+    list $x $tcl_precision
+} {7 7}
+test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} {
+    set tcl_precision 12
+    interp create child
+    set x [child eval set tcl_precision]
+    child eval {set tcl_precision 6}
+    interp delete child
+    list $x $tcl_precision
+} {12 6}
+test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} {
+    set tcl_precision 12
+    interp create -safe child
+    set x [child eval {
+	list [catch {set tcl_precision 8} msg] $msg
+    }]
+    interp delete child
+    list $x $tcl_precision
+} {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12}
+test util-7.3 {TclPrecTraceProc - write traces, bogus values} {
+    set tcl_precision 12
+    list [catch {set tcl_precision abc} msg] $msg $tcl_precision
+} {1 {can't set "tcl_precision": improper value for precision} 12}
+
+set tcl_precision 12
+concat ""