diff options
Diffstat (limited to 'contrib/tcl/tests/util.test')
| -rw-r--r-- | contrib/tcl/tests/util.test | 132 |
1 files changed, 0 insertions, 132 deletions
diff --git a/contrib/tcl/tests/util.test b/contrib/tcl/tests/util.test deleted file mode 100644 index ee37047cd659..000000000000 --- a/contrib/tcl/tests/util.test +++ /dev/null @@ -1,132 +0,0 @@ -# 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 "" |