home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / util.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  4.3 KB  |  133 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test the code in the file tclUtil.c.
  2. # This file is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1995-1997 Sun Microsystems, Inc.
  5. #
  6. # See the file "license.terms" for information on usage and redistribution
  7. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  8. #
  9. # SCCS: @(#) util.test 1.8 97/08/12 15:50:02
  10.  
  11. if {[info commands testobj] == {}} {
  12.     puts "This application hasn't been compiled with the \"testobj\""
  13.     puts "command, so I can't test the Tcl type and object support."
  14.     return
  15. }
  16.  
  17. if {[string compare test [info procs test]] == 1} then {source defs}
  18.  
  19. test util-1.1 {TclFindElement procedure - binary element in middle of list} {
  20.     lindex {0 foo\x00help 1} 1
  21. } "foo\x00help"
  22. test util-1.2 {TclFindElement procedure - binary element at end of list} {
  23.     lindex {0 foo\x00help} 1
  24. } "foo\x00help"
  25.  
  26. test util-2.1 {TclCopyAndCollapse procedure - normal string} {
  27.     lindex {0 foo} 1
  28. } {foo}
  29. test util-2.2 {TclCopyAndCollapse procedure - string with backslashes} {
  30.     lindex {0 foo\n\x00help 1} 1
  31. } "foo\n\x00help"
  32.  
  33. test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces} {
  34.     # This test checks for a very tricky feature.  Any list element
  35.     # generated with Tcl_ScanCountedElement and Tcl_ConvertElement must
  36.     # have the property that it can be enclosing in curly braces to make
  37.     # an embedded sub-list.  If this property doesn't hold, then
  38.     # Tcl_DStringStartSublist doesn't work.
  39.  
  40.     set x {}
  41.     lappend x " \\\{ \\"
  42.     concat $x [llength "{$x}"]
  43. } {\ \\\{\ \\ 1}
  44.  
  45. test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} {
  46.     concat a {b\ } c
  47. } {a b\  c}
  48. test util-4.2 {Tcl_ConcatObj - backslash-space at end of argument} {
  49.     concat a {b\   } c
  50. } {a b\  c}
  51. test util-4.3 {Tcl_ConcatObj - backslash-space at end of argument} {
  52.     concat a {b\\   } c
  53. } {a b\\  c}
  54. test util-4.4 {Tcl_ConcatObj - backslash-space at end of argument} {
  55.     concat a {b } c
  56. } {a b c}
  57. test util-4.5 {Tcl_ConcatObj - backslash-space at end of argument} {
  58.     concat a { } c
  59. } {a c}
  60.  
  61. test util-5.1 {Tcl_SetObjErrorCode - one arg} {
  62.     catch {testsetobjerrorcode 1}
  63.     list [set errorCode]
  64. } {1}
  65. test util-5.2 {Tcl_SetObjErrorCode - two args} {
  66.     catch {testsetobjerrorcode 1 2}
  67.     list [set errorCode]
  68. } {{1 2}}
  69. test util-5.3 {Tcl_SetObjErrorCode - three args} {
  70.     catch {testsetobjerrorcode 1 2 3}
  71.     list [set errorCode]
  72. } {{1 2 3}}
  73. test util-5.4 {Tcl_SetObjErrorCode - four args} {
  74.     catch {testsetobjerrorcode 1 2 3 4}
  75.     list [set errorCode]
  76. } {{1 2 3 4}}
  77. test util-5.5 {Tcl_SetObjErrorCode - five args} {
  78.     catch {testsetobjerrorcode 1 2 3 4 5}
  79.     list [set errorCode]
  80. } {{1 2 3 4 5}}
  81.  
  82. test util-6.1 {Tcl_PrintDouble - using tcl_precision} {
  83.     concat x[expr 1.4]
  84. } {x1.4}
  85. test util-6.2 {Tcl_PrintDouble - using tcl_precision} {
  86.     concat x[expr 1.39999999999]
  87. } {x1.39999999999}
  88. test util-6.3 {Tcl_PrintDouble - using tcl_precision} {
  89.     concat x[expr 1.399999999999]
  90. } {x1.4}
  91. test util-6.4 {Tcl_PrintDouble - using tcl_precision} {
  92.     set tcl_precision 5
  93.     concat x[expr 1.123412341234]
  94. } {x1.1234}
  95. set tcl_precision 12
  96. test util-6.4 {Tcl_PrintDouble - make sure there's a decimal point} {
  97.     concat x[expr 2.0]
  98. } {x2.0}
  99. test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {
  100.     concat x[expr 3.0e98]
  101. } {x3e+98}
  102.  
  103. test util-7.1 {TclPrecTraceProc - unset callbacks} {
  104.     set tcl_precision 7
  105.     set x $tcl_precision
  106.     unset tcl_precision
  107.     list $x $tcl_precision
  108. } {7 7}
  109. test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters} {
  110.     set tcl_precision 12
  111.     interp create child
  112.     set x [child eval set tcl_precision]
  113.     child eval {set tcl_precision 6}
  114.     interp delete child
  115.     list $x $tcl_precision
  116. } {12 6}
  117. test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} {
  118.     set tcl_precision 12
  119.     interp create -safe child
  120.     set x [child eval {
  121.     list [catch {set tcl_precision 8} msg] $msg
  122.     }]
  123.     interp delete child
  124.     list $x $tcl_precision
  125. } {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12}
  126. test util-7.3 {TclPrecTraceProc - write traces, bogus values} {
  127.     set tcl_precision 12
  128.     list [catch {set tcl_precision abc} msg] $msg $tcl_precision
  129. } {1 {can't set "tcl_precision": improper value for precision} 12}
  130.  
  131. set tcl_precision 12
  132. concat ""
  133.