# 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. # # RCS: @(#) $Id: util.test,v 1.2 2001/09/14 01:43:51 zlaski Exp $ 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} {eformat} { 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 ""