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 / obj.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  18.6 KB  |  497 lines  |  [TEXT/ALFA]
  1. # Functionality covered: this file contains a collection of tests for the
  2. # procedures in tclObj.c that implement Tcl's basic type support and the
  3. # type managers for the types boolean, double, and integer.
  4. #
  5. # Sourcing this file into Tcl runs the tests and generates output for
  6. # errors. No output means no errors were found.
  7. #
  8. # Copyright (c) 1995-1996 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # @(#) obj.test 1.11 97/08/06 08:56:09
  14.  
  15. if {[info commands testobj] == {}} {
  16.     puts "This application hasn't been compiled with the \"testobj\""
  17.     puts "command, so I can't test the Tcl type and object support."
  18.     return
  19. }
  20.  
  21. if {[string compare test [info procs test]] == 1} then {source defs}
  22.  
  23. test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
  24.     set r 1
  25.     foreach {t} {list boolean cmdName bytecode string int double} {
  26.         set first [string first $t [testobj types]]
  27.         set r [expr {$r && ($first != -1)}]
  28.     }
  29.     set result $r
  30. } {1}
  31.  
  32. test obj-2.1 {Tcl_GetObjType error} {
  33.     list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
  34. } {0 1 {no type foo found}}
  35. test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
  36.     set result ""
  37.     lappend result [testobj freeallvars]
  38.     lappend result [testintobj set 1 12]
  39.     lappend result [testobj convert 1 double]
  40.     lappend result [testobj type 1]
  41.     lappend result [testobj refcount 1]
  42. } {{} 12 12 double 3}
  43.  
  44. test obj-3.1 {Tcl_ConvertToType error} {
  45.     list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
  46. } {12.34 1 {expected integer but got "12.34"}}
  47. test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
  48.     list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
  49. } {{} 1 {expected integer but got ""}}
  50.  
  51. test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
  52.     set result ""
  53.     lappend result [testobj freeallvars]
  54.     lappend result [testobj newobj 1]
  55.     lappend result [testobj type 1]
  56.     lappend result [testobj refcount 1]
  57. } {{} {} string 2}
  58.  
  59. test obj-5.1 {Tcl_FreeObj} {
  60.     set result ""
  61.     lappend result [testintobj set 1 12345]
  62.     lappend result [testobj freeallvars]
  63.     lappend result [catch {testintobj get 1} msg]
  64.     lappend result $msg
  65. } {12345 {} 1 {variable 1 is unset (NULL)}}
  66.  
  67. test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
  68.     set result ""
  69.     lappend result [testobj freeallvars]
  70.     lappend result [testintobj set 1 47]
  71.     lappend result [testobj duplicate 1 2]    
  72.     lappend result [testintobj get 2]
  73.     lappend result [testobj refcount 1]
  74.     lappend result [testobj refcount 2]
  75. } {{} 47 47 47 2 3}
  76. test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
  77.     set result ""
  78.     lappend result [testobj freeallvars]
  79.     lappend result [testobj newobj 1]
  80.     lappend result [testobj duplicate 1 2]    
  81.     lappend result [testintobj get 2]
  82.     lappend result [testobj refcount 1]
  83.     lappend result [testobj refcount 2]
  84. } {{} {} {} {} 2 3}
  85.  
  86. test obj-7.1 {Tcl_GetStringFromObj, return existing string rep} {
  87.     set result ""
  88.     lappend result [testintobj set 1 47]
  89.     lappend result [testintobj get 1]
  90. } {47 47}
  91. test obj-7.2 {Tcl_GetStringFromObj, "empty string" object} {
  92.     set result ""
  93.     lappend result [testobj newobj 1]
  94.     lappend result [teststringobj append 1 abc -1]
  95.     lappend result [teststringobj get 1]
  96. } {{} abc abc}
  97. test obj-7.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
  98.     set result ""
  99.     lappend result [teststringobj set 1 xyz]
  100.     lappend result [teststringobj append 1 abc -1]
  101.     lappend result [teststringobj get 1]
  102. } {xyz xyzabc xyzabc}
  103. test obj-7.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
  104.     set result ""
  105.     lappend result [testintobj set 1 77]
  106.     lappend result [testintobj mult10 1]
  107.     lappend result [teststringobj get 1]
  108. } {77 770 770}
  109.  
  110. test obj-8.1 {Tcl_NewBooleanObj} {
  111.     set result ""
  112.     lappend result [testobj freeallvars]
  113.     lappend result [testbooleanobj set 1 0]
  114.     lappend result [testobj type 1]
  115.     lappend result [testobj refcount 1]
  116. } {{} 0 boolean 2}
  117.  
  118. test obj-9.1 {Tcl_SetBooleanObj, existing "empty string" object} {
  119.     set result ""
  120.     lappend result [testobj freeallvars]
  121.     lappend result [testobj newobj 1]
  122.     lappend result [testbooleanobj set 1 0]  ;# makes existing obj boolean
  123.     lappend result [testobj type 1]
  124.     lappend result [testobj refcount 1]
  125. } {{} {} 0 boolean 2}
  126. test obj-9.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
  127.     set result ""
  128.     lappend result [testobj freeallvars]
  129.     lappend result [testintobj set 1 98765]
  130.     lappend result [testbooleanobj set 1 1]  ;# makes existing obj boolean
  131.     lappend result [testobj type 1]
  132.     lappend result [testobj refcount 1]
  133. } {{} 98765 1 boolean 2}
  134.  
  135. test obj-10.1 {Tcl_GetBooleanFromObj, existing boolean object} {
  136.     set result ""
  137.     lappend result [testbooleanobj set 1 1]
  138.     lappend result [testbooleanobj not 1]    ;# gets existing boolean rep
  139. } {1 0}
  140. test obj-10.2 {Tcl_GetBooleanFromObj, convert to boolean} {
  141.     set result ""
  142.     lappend result [testintobj set 1 47]
  143.     lappend result [testbooleanobj not 1]    ;# must convert to bool
  144.     lappend result [testobj type 1]
  145. } {47 0 boolean}
  146. test obj-10.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
  147.     set result ""
  148.     lappend result [teststringobj set 1 abc]
  149.     lappend result [catch {testbooleanobj not 1} msg]
  150.     lappend result $msg
  151. } {abc 1 {expected boolean value but got "abc"}}
  152. test obj-10.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
  153.     set result ""
  154.     lappend result [testobj newobj 1]
  155.     lappend result [catch {testbooleanobj not 1} msg]
  156.     lappend result $msg
  157. } {{} 1 {expected boolean value but got ""}}
  158.  
  159. test obj-11.1 {DupBooleanInternalRep} {
  160.     set result ""
  161.     lappend result [testbooleanobj set 1 1]
  162.     lappend result [testobj duplicate 1 2]   ;# uses DupBooleanInternalRep
  163.     lappend result [testbooleanobj get 2]
  164. } {1 1 1}
  165.  
  166. test obj-12.1 {SetBooleanFromAny, int to boolean special case} {
  167.     set result ""
  168.     lappend result [testintobj set 1 1234]
  169.     lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
  170.     lappend result [testobj type 1]
  171. } {1234 0 boolean}
  172. test obj-12.2 {SetBooleanFromAny, double to boolean special case} {
  173.     set result ""
  174.     lappend result [testdoubleobj set 1 3.14159]
  175.     lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
  176.     lappend result [testobj type 1]
  177. } {3.14159 0 boolean}
  178. test obj-12.3 {SetBooleanFromAny, special case strings representing booleans} {
  179.     set result ""
  180.     foreach s {yes no true false on off} {
  181.         teststringobj set 1 $s
  182.         lappend result [testbooleanobj not 1]
  183.     }
  184.     lappend result [testobj type 1]
  185. } {0 1 0 1 0 1 boolean}
  186. test obj-12.4 {SetBooleanFromAny, recompute string rep then parse it} {
  187.     set result ""
  188.     lappend result [testintobj set 1 456]
  189.     lappend result [testintobj div10 1]
  190.     lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
  191.     lappend result [testobj type 1]
  192. } {456 45 0 boolean}
  193. test obj-12.5 {SetBooleanFromAny, error parsing string} {
  194.     set result ""
  195.     lappend result [teststringobj set 1 abc]
  196.     lappend result [catch {testbooleanobj not 1} msg]
  197.     lappend result $msg
  198. } {abc 1 {expected boolean value but got "abc"}}
  199. test obj-12.6 {SetBooleanFromAny, error parsing string} {
  200.     set result ""
  201.     lappend result [teststringobj set 1 x1.0]
  202.     lappend result [catch {testbooleanobj not 1} msg]
  203.     lappend result $msg
  204. } {x1.0 1 {expected boolean value but got "x1.0"}}
  205. test obj-12.7 {SetBooleanFromAny, error converting from "empty string"} {
  206.     set result ""
  207.     lappend result [testobj newobj 1]
  208.     lappend result [catch {testbooleanobj not 1} msg]
  209.     lappend result $msg
  210. } {{} 1 {expected boolean value but got ""}}
  211.  
  212. test obj-13.1 {UpdateStringOfBoolean} {
  213.     set result ""
  214.     lappend result [testbooleanobj set 1 0]
  215.     lappend result [testbooleanobj not 1]
  216.     lappend result [testbooleanobj get 1]    ;# must update string rep
  217. } {0 1 1}
  218.  
  219. test obj-14.1 {Tcl_NewDoubleObj} {
  220.     set result ""
  221.     lappend result [testobj freeallvars]
  222.     lappend result [testdoubleobj set 1 3.1459]
  223.     lappend result [testobj type 1]
  224.     lappend result [testobj refcount 1]
  225. } {{} 3.1459 double 2}
  226.  
  227. test obj-15.1 {Tcl_SetDoubleObj, existing "empty string" object} {
  228.     set result ""
  229.     lappend result [testobj freeallvars]
  230.     lappend result [testobj newobj 1]
  231.     lappend result [testdoubleobj set 1 0.123]  ;# makes existing obj boolean
  232.     lappend result [testobj type 1]
  233.     lappend result [testobj refcount 1]
  234. } {{} {} 0.123 double 2}
  235. test obj-15.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
  236.     set result ""
  237.     lappend result [testobj freeallvars]
  238.     lappend result [testintobj set 1 98765]
  239.     lappend result [testdoubleobj set 1 27.56]  ;# makes existing obj double
  240.     lappend result [testobj type 1]
  241.     lappend result [testobj refcount 1]
  242. } {{} 98765 27.56 double 2}
  243.  
  244. test obj-16.1 {Tcl_GetDoubleFromObj, existing double object} {
  245.     set result ""
  246.     lappend result [testdoubleobj set 1 16.1]
  247.     lappend result [testdoubleobj mult10 1]   ;# gets existing double rep
  248. } {16.1 161.0}
  249. test obj-16.2 {Tcl_GetDoubleFromObj, convert to double} {
  250.     set result ""
  251.     lappend result [testintobj set 1 477]
  252.     lappend result [testdoubleobj div10 1]    ;# must convert to bool
  253.     lappend result [testobj type 1]
  254. } {477 47.7 double}
  255. test obj-16.3 {Tcl_GetDoubleFromObj, error converting to double} {
  256.     set result ""
  257.     lappend result [teststringobj set 1 abc]
  258.     lappend result [catch {testdoubleobj mult10 1} msg]
  259.     lappend result $msg
  260. } {abc 1 {expected floating-point number but got "abc"}}
  261. test obj-16.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
  262.     set result ""
  263.     lappend result [testobj newobj 1]
  264.     lappend result [catch {testdoubleobj div10 1} msg]
  265.     lappend result $msg
  266. } {{} 1 {expected floating-point number but got ""}}
  267.  
  268. test obj-17.1 {DupDoubleInternalRep} {
  269.     set result ""
  270.     lappend result [testdoubleobj set 1 17.1]
  271.     lappend result [testobj duplicate 1 2]      ;# uses DupDoubleInternalRep
  272.     lappend result [testdoubleobj get 2]
  273. } {17.1 17.1 17.1}
  274.  
  275. test obj-18.1 {SetDoubleFromAny, int to double special case} {
  276.     set result ""
  277.     lappend result [testintobj set 1 1234]
  278.     lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
  279.     lappend result [testobj type 1]
  280. } {1234 12340.0 double}
  281. test obj-18.2 {SetDoubleFromAny, boolean to double special case} {
  282.     set result ""
  283.     lappend result [testbooleanobj set 1 1]
  284.     lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
  285.     lappend result [testobj type 1]
  286. } {1 10.0 double}
  287. test obj-18.3 {SetDoubleFromAny, recompute string rep then parse it} {
  288.     set result ""
  289.     lappend result [testintobj set 1 456]
  290.     lappend result [testintobj div10 1]
  291.     lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
  292.     lappend result [testobj type 1]
  293. } {456 45 450.0 double}
  294. test obj-18.4 {SetDoubleFromAny, error parsing string} {
  295.     set result ""
  296.     lappend result [teststringobj set 1 abc]
  297.     lappend result [catch {testdoubleobj mult10 1} msg]
  298.     lappend result $msg
  299. } {abc 1 {expected floating-point number but got "abc"}}
  300. test obj-18.5 {SetDoubleFromAny, error parsing string} {
  301.     set result ""
  302.     lappend result [teststringobj set 1 x1.0]
  303.     lappend result [catch {testdoubleobj mult10 1} msg]
  304.     lappend result $msg
  305. } {x1.0 1 {expected floating-point number but got "x1.0"}}
  306. test obj-18.6 {SetDoubleFromAny, error converting from "empty string"} {
  307.     set result ""
  308.     lappend result [testobj newobj 1]
  309.     lappend result [catch {testdoubleobj div10 1} msg]
  310.     lappend result $msg
  311. } {{} 1 {expected floating-point number but got ""}}
  312.  
  313. test obj-19.1 {UpdateStringOfDouble} {
  314.     set result ""
  315.     lappend result [testdoubleobj set 1 3.14159]
  316.     lappend result [testdoubleobj mult10 1]
  317.     lappend result [testdoubleobj get 1]   ;# must update string rep
  318. } {3.14159 31.4159 31.4159}
  319.  
  320. test obj-20.1 {Tcl_NewIntObj} {
  321.     set result ""
  322.     lappend result [testobj freeallvars]
  323.     lappend result [testintobj set 1 55]
  324.     lappend result [testobj type 1]
  325.     lappend result [testobj refcount 1]
  326. } {{} 55 int 2}
  327.  
  328. test obj-21.1 {Tcl_SetIntObj, existing "empty string" object} {
  329.     set result ""
  330.     lappend result [testobj freeallvars]
  331.     lappend result [testobj newobj 1]
  332.     lappend result [testintobj set 1 77]  ;# makes existing obj int
  333.     lappend result [testobj type 1]
  334.     lappend result [testobj refcount 1]
  335. } {{} {} 77 int 2}
  336. test obj-21.2 {Tcl_SetIntObj, existing non-"empty string" object} {
  337.     set result ""
  338.     lappend result [testobj freeallvars]
  339.     lappend result [testdoubleobj set 1 12.34]
  340.     lappend result [testintobj set 1 77]  ;# makes existing obj int
  341.     lappend result [testobj type 1]
  342.     lappend result [testobj refcount 1]
  343. } {{} 12.34 77 int 2}
  344.  
  345. test obj-22.1 {Tcl_GetIntFromObj, existing int object} {
  346.     set result ""
  347.     lappend result [testintobj set 1 22]
  348.     lappend result [testintobj mult10 1]   ;# gets existing int rep
  349. } {22 220}
  350. test obj-22.2 {Tcl_GetIntFromObj, convert to int} {
  351.     set result ""
  352.     lappend result [testintobj set 1 477]
  353.     lappend result [testintobj div10 1]    ;# must convert to bool
  354.     lappend result [testobj type 1]
  355. } {477 47 int}
  356. test obj-22.3 {Tcl_GetIntFromObj, error converting to int} {
  357.     set result ""
  358.     lappend result [teststringobj set 1 abc]
  359.     lappend result [catch {testintobj mult10 1} msg]
  360.     lappend result $msg
  361. } {abc 1 {expected integer but got "abc"}}
  362. test obj-22.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
  363.     set result ""
  364.     lappend result [testobj newobj 1]
  365.     lappend result [catch {testintobj div10 1} msg]
  366.     lappend result $msg
  367. } {{} 1 {expected integer but got ""}}
  368. test obj-22.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
  369.     set result ""
  370.     lappend result [testobj newobj 1]
  371.     lappend result [testintobj inttoobigtest 1]
  372. } {{} 1}
  373.  
  374. test obj-23.1 {DupIntInternalRep} {
  375.     set result ""
  376.     lappend result [testintobj set 1 23]
  377.     lappend result [testobj duplicate 1 2]    ;# uses DupIntInternalRep
  378.     lappend result [testintobj get 2]
  379. } {23 23 23}
  380.  
  381. test obj-24.1 {SetIntFromAny, int to int special case} {
  382.     set result ""
  383.     lappend result [testintobj set 1 1234]
  384.     lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
  385.     lappend result [testobj type 1]
  386. } {1234 12340 int}
  387. test obj-24.2 {SetIntFromAny, boolean to int special case} {
  388.     set result ""
  389.     lappend result [testbooleanobj set 1 1]
  390.     lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
  391.     lappend result [testobj type 1]
  392. } {1 10 int}
  393. test obj-24.3 {SetIntFromAny, recompute string rep then parse it} {
  394.     set result ""
  395.     lappend result [testintobj set 1 456]
  396.     lappend result [testintobj div10 1]
  397.     lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
  398.     lappend result [testobj type 1]
  399. } {456 45 450 int}
  400. test obj-24.4 {SetIntFromAny, error parsing string} {
  401.     set result ""
  402.     lappend result [teststringobj set 1 abc]
  403.     lappend result [catch {testintobj mult10 1} msg]
  404.     lappend result $msg
  405. } {abc 1 {expected integer but got "abc"}}
  406. test obj-24.5 {SetIntFromAny, error parsing string} {
  407.     set result ""
  408.     lappend result [teststringobj set 1 x17]
  409.     lappend result [catch {testintobj mult10 1} msg]
  410.     lappend result $msg
  411. } {x17 1 {expected integer but got "x17"}}
  412. test obj-24.6 {SetIntFromAny, integer too large} {nonPortable} {
  413.     set result ""
  414.     lappend result [teststringobj set 1 12345678901234567890]
  415.     lappend result [catch {testintobj mult10 1} msg]
  416.     lappend result $msg
  417. } {12345678901234567890 1 {integer value too large to represent}}
  418. test obj-24.7 {SetIntFromAny, error converting from "empty string"} {
  419.     set result ""
  420.     lappend result [testobj newobj 1]
  421.     lappend result [catch {testintobj div10 1} msg]
  422.     lappend result $msg
  423. } {{} 1 {expected integer but got ""}}
  424.  
  425. test obj-25.1 {UpdateStringOfInt} {
  426.     set result ""
  427.     lappend result [testintobj set 1 512]
  428.     lappend result [testintobj mult10 1]
  429.     lappend result [testintobj get 1]       ;# must update string rep
  430. } {512 5120 5120}
  431.  
  432. test obj-26.1 {Tcl_NewLongObj} {
  433.     set result ""
  434.     lappend result [testobj freeallvars]
  435.     testintobj setmaxlong 1
  436.     lappend result [testintobj ismaxlong 1]
  437.     lappend result [testobj type 1]
  438.     lappend result [testobj refcount 1]
  439. } {{} 1 int 1}
  440.  
  441. test obj-27.1 {Tcl_SetLongObj, existing "empty string" object} {
  442.     set result ""
  443.     lappend result [testobj freeallvars]
  444.     lappend result [testobj newobj 1]
  445.     lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
  446.     lappend result [testobj type 1]
  447.     lappend result [testobj refcount 1]
  448. } {{} {} 77 int 2}
  449. test obj-27.2 {Tcl_SetLongObj, existing non-"empty string" object} {
  450.     set result ""
  451.     lappend result [testobj freeallvars]
  452.     lappend result [testdoubleobj set 1 12.34]
  453.     lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
  454.     lappend result [testobj type 1]
  455.     lappend result [testobj refcount 1]
  456. } {{} 12.34 77 int 2}
  457.  
  458. test obj-28.1 {Tcl_GetLongFromObj, existing long integer object} {
  459.     set result ""
  460.     lappend result [testintobj setlong 1 22]
  461.     lappend result [testintobj mult10 1]   ;# gets existing long int rep
  462. } {22 220}
  463. test obj-28.2 {Tcl_GetLongFromObj, convert to long} {
  464.     set result ""
  465.     lappend result [testintobj setlong 1 477]
  466.     lappend result [testintobj div10 1]    ;# must convert to bool
  467.     lappend result [testobj type 1]
  468. } {477 47 int}
  469. test obj-28.3 {Tcl_GetLongFromObj, error converting to long integer} {
  470.     set result ""
  471.     lappend result [teststringobj set 1 abc]
  472.     lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
  473.     lappend result $msg
  474. } {abc 1 {expected integer but got "abc"}}
  475. test obj-28.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
  476.     set result ""
  477.     lappend result [testobj newobj 1]
  478.     lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
  479.     lappend result $msg
  480. } {{} 1 {expected integer but got ""}}
  481.  
  482. test obj-29.1 {Ref counting and object deletion, simple types} {
  483.     set result ""
  484.     lappend result [testobj freeallvars]
  485.     lappend result [testintobj set 1 1024]
  486.     lappend result [testobj assign 1 2]     ;# vars 1 and 2 share the int obj
  487.     lappend result [testobj type 2]
  488.     lappend result [testobj refcount 1]
  489.     lappend result [testobj refcount 2]
  490.     lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
  491.     lappend result [testobj type 2]
  492.     lappend result [testobj refcount 1]
  493.     lappend result [testobj refcount 2]
  494. } {{} 1024 1024 int 4 4 0 boolean 3 2}
  495.  
  496. testobj freeallvars
  497.