summaryrefslogtreecommitdiffstats
path: root/tests/util.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/util.test')
-rw-r--r--tests/util.test132
1 files changed, 132 insertions, 0 deletions
diff --git a/tests/util.test b/tests/util.test
new file mode 100644
index 0000000..ee37047
--- /dev/null
+++ b/tests/util.test
@@ -0,0 +1,132 @@
+# This file is a Tcl script to test the code in the file tclUtil.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+#
+# 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.8 97/08/12 15:50:02
+
+if {[info commands testobj] == {}} {
+ puts "This application hasn't been compiled with the \"testobj\""
+ puts "command, so I can't test the Tcl type and object support."
+ return
+}
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test util-1.1 {TclFindElement procedure - binary element in middle of list} {
+ lindex {0 foo\x00help 1} 1
+} "foo\x00help"
+test util-1.2 {TclFindElement procedure - binary element at end of list} {
+ lindex {0 foo\x00help} 1
+} "foo\x00help"
+
+test util-2.1 {TclCopyAndCollapse procedure - normal string} {
+ lindex {0 foo} 1
+} {foo}
+test util-2.2 {TclCopyAndCollapse procedure - string with backslashes} {
+ lindex {0 foo\n\x00help 1} 1
+} "foo\n\x00help"
+
+test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} {
+ # This test checks for a very tricky feature. Any list element
+ # generated with Tcl_ScanCountedElement and Tcl_ConvertElement must
+ # have the property that it can be enclosing in curly braces to make
+ # an embedded sub-list. If this property doesn't hold, then
+ # Tcl_DStringStartSublist doesn't work.
+
+ set x {}
+ lappend x " \\\{ \\"
+ concat $x [llength "{$x}"]
+} {\ \\\{\ \\ 1}
+
+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-5.2 {Tcl_SetObjErrorCode - two args} {
+ catch {testsetobjerrorcode 1 2}
+ list [set errorCode]
+} {{1 2}}
+test util-5.3 {Tcl_SetObjErrorCode - three args} {
+ catch {testsetobjerrorcode 1 2 3}
+ list [set errorCode]
+} {{1 2 3}}
+test util-5.4 {Tcl_SetObjErrorCode - four args} {
+ catch {testsetobjerrorcode 1 2 3 4}
+ list [set errorCode]
+} {{1 2 3 4}}
+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 ""