开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
obj.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：24k
源码类别：

通讯编程

开发平台：

Visual C++

obj.test：源码内容
  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. # Copyright (c) 1998-1999 by Scriptics Corporation.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14. # RCS: @(#) $Id: obj.test,v 1.7.2.1 2004/09/10 21:52:37 dkf Exp $
  16. if {[lsearch [namespace children] ::tcltest] == -1} {
  17.     package require tcltest
  18.     namespace import -force ::tcltest::*
  19. }
  21. if {[info commands testobj] == {}} {
  22.     puts "This application hasn't been compiled with the "testobj""
  23.     puts "command, so I can't test the Tcl type and object support."
  24.     ::tcltest::cleanupTests
  25.     return
  26. }
  28. # Procedure to determine the integer range of the machine
  30. proc int_range {} {
  31.     for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
  32. set MIN_INT [expr { $MIN_INT << 1 }]
  33.     }
  34.     set MAX_INT [expr { ~ $MIN_INT }]
  35.     return [list $MIN_INT $MAX_INT]
  36. }
  38. # Procedure to determine the range of wide integers on the machine.
  40. proc wide_range {} {
  41.     for { set MIN_WIDE [expr { wide(1) }] } { $MIN_WIDE > wide(0) } {} {
  42. set MIN_WIDE [expr { $MIN_WIDE << 1 }]
  43.     }
  44.     set MAX_WIDE [expr { ~ $MIN_WIDE }]
  45.     return [list $MIN_WIDE $MAX_WIDE]
  46. }
  48. foreach { MIN_INT MAX_INT } [int_range] break
  49. foreach { MIN_WIDE MAX_WIDE } [wide_range] break
  50. ::tcltest::testConstraint 32bit 
  51.     [expr { $MAX_INT == 0x7fffffff }]
  52. ::tcltest::testConstraint wideBiggerThanInt 
  53.     [expr { $MAX_WIDE > wide($MAX_INT) }]
  55. test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
  56.     set r 1
  57.     foreach {t} {
  58. {array search} 
  59. boolean
  60. bytearray
  61. bytecode
  62. double
  63. end-offset
  64. index
  65. int
  66. list
  67. nsName
  68. procbody
  69. string
  70.     } {
  71.         set first [string first $t [testobj types]]
  72.         set r [expr {$r && ($first != -1)}]
  73.     }
  74.     set result $r
  75. } {1}
  77. test obj-2.1 {Tcl_GetObjType error} {
  78.     list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
  79. } {0 1 {no type foo found}}
  80. test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
  81.     set result ""
  82.     lappend result [testobj freeallvars]
  83.     lappend result [testintobj set 1 12]
  84.     lappend result [testobj convert 1 double]
  85.     lappend result [testobj type 1]
  86.     lappend result [testobj refcount 1]
  87. } {{} 12 12 double 3}
  89. test obj-3.1 {Tcl_ConvertToType error} {
  90.     list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
  91. } {12.34 1 {expected integer but got "12.34"}}
  92. test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
  93.     list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
  94. } {{} 1 {expected integer but got ""}}
  96. test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
  97.     set result ""
  98.     lappend result [testobj freeallvars]
  99.     lappend result [testobj newobj 1]
  100.     lappend result [testobj type 1]
  101.     lappend result [testobj refcount 1]
  102. } {{} {} string 2}
  104. test obj-5.1 {Tcl_FreeObj} {
  105.     set result ""
  106.     lappend result [testintobj set 1 12345]
  107.     lappend result [testobj freeallvars]
  108.     lappend result [catch {testintobj get 1} msg]
  109.     lappend result $msg
  110. } {12345 {} 1 {variable 1 is unset (NULL)}}
  112. test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
  113.     set result ""
  114.     lappend result [testobj freeallvars]
  115.     lappend result [testintobj set 1 47]
  116.     lappend result [testobj duplicate 1 2]    
  117.     lappend result [testintobj get 2]
  118.     lappend result [testobj refcount 1]
  119.     lappend result [testobj refcount 2]
  120. } {{} 47 47 47 2 3}
  121. test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
  122.     set result ""
  123.     lappend result [testobj freeallvars]
  124.     lappend result [testobj newobj 1]
  125.     lappend result [testobj duplicate 1 2]    
  126.     lappend result [testintobj get 2]
  127.     lappend result [testobj refcount 1]
  128.     lappend result [testobj refcount 2]
  129. } {{} {} {} {} 2 3}
  131. test obj-7.1 {Tcl_GetString, return existing string rep} {
  132.     set result ""
  133.     lappend result [testintobj set 1 47]
  134.     lappend result [testintobj get2 1]
  135. } {47 47}
  136. test obj-7.2 {Tcl_GetString, "empty string" object} {
  137.     set result ""
  138.     lappend result [testobj newobj 1]
  139.     lappend result [teststringobj append 1 abc -1]
  140.     lappend result [teststringobj get2 1]
  141. } {{} abc abc}
  142. test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} {
  143.     set result ""
  144.     lappend result [teststringobj set 1 xyz]
  145.     lappend result [teststringobj append 1 abc -1]
  146.     lappend result [teststringobj get2 1]
  147. } {xyz xyzabc xyzabc}
  148. test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} {
  149.     set result ""
  150.     lappend result [testintobj set 1 77]
  151.     lappend result [testintobj mult10 1]
  152.     lappend result [teststringobj get2 1]
  153. } {77 770 770}
  155. test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} {
  156.     set result ""
  157.     lappend result [testintobj set 1 47]
  158.     lappend result [testintobj get 1]
  159. } {47 47}
  160. test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} {
  161.     set result ""
  162.     lappend result [testobj newobj 1]
  163.     lappend result [teststringobj append 1 abc -1]
  164.     lappend result [teststringobj get 1]
  165. } {{} abc abc}
  166. test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
  167.     set result ""
  168.     lappend result [teststringobj set 1 xyz]
  169.     lappend result [teststringobj append 1 abc -1]
  170.     lappend result [teststringobj get 1]
  171. } {xyz xyzabc xyzabc}
  172. test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
  173.     set result ""
  174.     lappend result [testintobj set 1 77]
  175.     lappend result [testintobj mult10 1]
  176.     lappend result [teststringobj get 1]
  177. } {77 770 770}
  179. test obj-9.1 {Tcl_NewBooleanObj} {
  180.     set result ""
  181.     lappend result [testobj freeallvars]
  182.     lappend result [testbooleanobj set 1 0]
  183.     lappend result [testobj type 1]
  184.     lappend result [testobj refcount 1]
  185. } {{} 0 boolean 2}
  187. test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} {
  188.     set result ""
  189.     lappend result [testobj freeallvars]
  190.     lappend result [testobj newobj 1]
  191.     lappend result [testbooleanobj set 1 0]  ;# makes existing obj boolean
  192.     lappend result [testobj type 1]
  193.     lappend result [testobj refcount 1]
  194. } {{} {} 0 boolean 2}
  195. test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
  196.     set result ""
  197.     lappend result [testobj freeallvars]
  198.     lappend result [testintobj set 1 98765]
  199.     lappend result [testbooleanobj set 1 1]  ;# makes existing obj boolean
  200.     lappend result [testobj type 1]
  201.     lappend result [testobj refcount 1]
  202. } {{} 98765 1 boolean 2}
  204. test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} {
  205.     set result ""
  206.     lappend result [testbooleanobj set 1 1]
  207.     lappend result [testbooleanobj not 1]    ;# gets existing boolean rep
  208. } {1 0}
  209. test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} {
  210.     set result ""
  211.     lappend result [testintobj set 1 47]
  212.     lappend result [testbooleanobj not 1]    ;# must convert to bool
  213.     lappend result [testobj type 1]
  214. } {47 0 boolean}
  215. test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
  216.     set result ""
  217.     lappend result [teststringobj set 1 abc]
  218.     lappend result [catch {testbooleanobj not 1} msg]
  219.     lappend result $msg
  220. } {abc 1 {expected boolean value but got "abc"}}
  221. test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
  222.     set result ""
  223.     lappend result [testobj newobj 1]
  224.     lappend result [catch {testbooleanobj not 1} msg]
  225.     lappend result $msg
  226. } {{} 1 {expected boolean value but got ""}}
  227. test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} {
  228.     set result ""
  229.     lappend result [teststringobj set 1 0xac]
  230.     lappend result [testbooleanobj not 1]
  231.     lappend result [testobj type 1]
  232. } {0xac 0 boolean}
  233. test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} {
  234.     set result ""
  235.     lappend result [teststringobj set 1 5.42]
  236.     lappend result [testbooleanobj not 1]
  237.     lappend result [testobj type 1]
  238. } {5.42 0 boolean}
  240. test obj-12.1 {DupBooleanInternalRep} {
  241.     set result ""
  242.     lappend result [testbooleanobj set 1 1]
  243.     lappend result [testobj duplicate 1 2]   ;# uses DupBooleanInternalRep
  244.     lappend result [testbooleanobj get 2]
  245. } {1 1 1}
  247. test obj-13.1 {SetBooleanFromAny, int to boolean special case} {
  248.     set result ""
  249.     lappend result [testintobj set 1 1234]
  250.     lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
  251.     lappend result [testobj type 1]
  252. } {1234 0 boolean}
  253. test obj-13.2 {SetBooleanFromAny, double to boolean special case} {
  254.     set result ""
  255.     lappend result [testdoubleobj set 1 3.14159]
  256.     lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
  257.     lappend result [testobj type 1]
  258. } {3.14159 0 boolean}
  259. test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} {
  260.     set result ""
  261.     foreach s {yes no true false on off} {
  262.         teststringobj set 1 $s
  263.         lappend result [testbooleanobj not 1]
  264.     }
  265.     lappend result [testobj type 1]
  266. } {0 1 0 1 0 1 boolean}
  267. test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} {
  268.     set result ""
  269.     lappend result [testintobj set 1 456]
  270.     lappend result [testintobj div10 1]
  271.     lappend result [testbooleanobj not 1]    ;# converts with SetBooleanFromAny
  272.     lappend result [testobj type 1]
  273. } {456 45 0 boolean}
  274. test obj-13.5 {SetBooleanFromAny, error parsing string} {
  275.     set result ""
  276.     lappend result [teststringobj set 1 abc]
  277.     lappend result [catch {testbooleanobj not 1} msg]
  278.     lappend result $msg
  279. } {abc 1 {expected boolean value but got "abc"}}
  280. test obj-13.6 {SetBooleanFromAny, error parsing string} {
  281.     set result ""
  282.     lappend result [teststringobj set 1 x1.0]
  283.     lappend result [catch {testbooleanobj not 1} msg]
  284.     lappend result $msg
  285. } {x1.0 1 {expected boolean value but got "x1.0"}}
  286. test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} {
  287.     set result ""
  288.     lappend result [testobj newobj 1]
  289.     lappend result [catch {testbooleanobj not 1} msg]
  290.     lappend result $msg
  291. } {{} 1 {expected boolean value but got ""}}
  292. test obj-13.8 {SetBooleanFromAny, unicode strings} {
  293.     set result ""
  294.     lappend result [teststringobj set 1 1u7777]
  295.     lappend result [catch {testbooleanobj not 1} msg]
  296.     lappend result $msg
  297. } "1u7777 1 {expected boolean value but got "1u7777"}"
  299. test obj-14.1 {UpdateStringOfBoolean} {
  300.     set result ""
  301.     lappend result [testbooleanobj set 1 0]
  302.     lappend result [testbooleanobj not 1]
  303.     lappend result [testbooleanobj get 1]    ;# must update string rep
  304. } {0 1 1}
  306. test obj-15.1 {Tcl_NewDoubleObj} {
  307.     set result ""
  308.     lappend result [testobj freeallvars]
  309.     lappend result [testdoubleobj set 1 3.1459]
  310.     lappend result [testobj type 1]
  311.     lappend result [testobj refcount 1]
  312. } {{} 3.1459 double 2}
  314. test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} {
  315.     set result ""
  316.     lappend result [testobj freeallvars]
  317.     lappend result [testobj newobj 1]
  318.     lappend result [testdoubleobj set 1 0.123]  ;# makes existing obj boolean
  319.     lappend result [testobj type 1]
  320.     lappend result [testobj refcount 1]
  321. } {{} {} 0.123 double 2}
  322. test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
  323.     set result ""
  324.     lappend result [testobj freeallvars]
  325.     lappend result [testintobj set 1 98765]
  326.     lappend result [testdoubleobj set 1 27.56]  ;# makes existing obj double
  327.     lappend result [testobj type 1]
  328.     lappend result [testobj refcount 1]
  329. } {{} 98765 27.56 double 2}
  331. test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} {
  332.     set result ""
  333.     lappend result [testdoubleobj set 1 16.1]
  334.     lappend result [testdoubleobj mult10 1]   ;# gets existing double rep
  335. } {16.1 161.0}
  336. test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} {
  337.     set result ""
  338.     lappend result [testintobj set 1 477]
  339.     lappend result [testdoubleobj div10 1]    ;# must convert to bool
  340.     lappend result [testobj type 1]
  341. } {477 47.7 double}
  342. test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} {
  343.     set result ""
  344.     lappend result [teststringobj set 1 abc]
  345.     lappend result [catch {testdoubleobj mult10 1} msg]
  346.     lappend result $msg
  347. } {abc 1 {expected floating-point number but got "abc"}}
  348. test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
  349.     set result ""
  350.     lappend result [testobj newobj 1]
  351.     lappend result [catch {testdoubleobj div10 1} msg]
  352.     lappend result $msg
  353. } {{} 1 {expected floating-point number but got ""}}
  355. test obj-18.1 {DupDoubleInternalRep} {
  356.     set result ""
  357.     lappend result [testdoubleobj set 1 17.1]
  358.     lappend result [testobj duplicate 1 2]      ;# uses DupDoubleInternalRep
  359.     lappend result [testdoubleobj get 2]
  360. } {17.1 17.1 17.1}
  362. test obj-19.1 {SetDoubleFromAny, int to double special case} {
  363.     set result ""
  364.     lappend result [testintobj set 1 1234]
  365.     lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
  366.     lappend result [testobj type 1]
  367. } {1234 12340.0 double}
  368. test obj-19.2 {SetDoubleFromAny, boolean to double special case} {
  369.     set result ""
  370.     lappend result [testbooleanobj set 1 1]
  371.     lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
  372.     lappend result [testobj type 1]
  373. } {1 10.0 double}
  374. test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} {
  375.     set result ""
  376.     lappend result [testintobj set 1 456]
  377.     lappend result [testintobj div10 1]
  378.     lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
  379.     lappend result [testobj type 1]
  380. } {456 45 450.0 double}
  381. test obj-19.4 {SetDoubleFromAny, error parsing string} {
  382.     set result ""
  383.     lappend result [teststringobj set 1 abc]
  384.     lappend result [catch {testdoubleobj mult10 1} msg]
  385.     lappend result $msg
  386. } {abc 1 {expected floating-point number but got "abc"}}
  387. test obj-19.5 {SetDoubleFromAny, error parsing string} {
  388.     set result ""
  389.     lappend result [teststringobj set 1 x1.0]
  390.     lappend result [catch {testdoubleobj mult10 1} msg]
  391.     lappend result $msg
  392. } {x1.0 1 {expected floating-point number but got "x1.0"}}
  393. test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} {
  394.     set result ""
  395.     lappend result [testobj newobj 1]
  396.     lappend result [catch {testdoubleobj div10 1} msg]
  397.     lappend result $msg
  398. } {{} 1 {expected floating-point number but got ""}}
  400. test obj-20.1 {UpdateStringOfDouble} {
  401.     set result ""
  402.     lappend result [testdoubleobj set 1 3.14159]
  403.     lappend result [testdoubleobj mult10 1]
  404.     lappend result [testdoubleobj get 1]   ;# must update string rep
  405. } {3.14159 31.4159 31.4159}
  407. test obj-21.1 {Tcl_NewIntObj} {
  408.     set result ""
  409.     lappend result [testobj freeallvars]
  410.     lappend result [testintobj set 1 55]
  411.     lappend result [testobj type 1]
  412.     lappend result [testobj refcount 1]
  413. } {{} 55 int 2}
  415. test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} {
  416.     set result ""
  417.     lappend result [testobj freeallvars]
  418.     lappend result [testobj newobj 1]
  419.     lappend result [testintobj set 1 77]  ;# makes existing obj int
  420.     lappend result [testobj type 1]
  421.     lappend result [testobj refcount 1]
  422. } {{} {} 77 int 2}
  423. test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} {
  424.     set result ""
  425.     lappend result [testobj freeallvars]
  426.     lappend result [testdoubleobj set 1 12.34]
  427.     lappend result [testintobj set 1 77]  ;# makes existing obj int
  428.     lappend result [testobj type 1]
  429.     lappend result [testobj refcount 1]
  430. } {{} 12.34 77 int 2}
  432. test obj-23.1 {Tcl_GetIntFromObj, existing int object} {
  433.     set result ""
  434.     lappend result [testintobj set 1 22]
  435.     lappend result [testintobj mult10 1]   ;# gets existing int rep
  436. } {22 220}
  437. test obj-23.2 {Tcl_GetIntFromObj, convert to int} {
  438.     set result ""
  439.     lappend result [testintobj set 1 477]
  440.     lappend result [testintobj div10 1]    ;# must convert to bool
  441.     lappend result [testobj type 1]
  442. } {477 47 int}
  443. test obj-23.3 {Tcl_GetIntFromObj, error converting to int} {
  444.     set result ""
  445.     lappend result [teststringobj set 1 abc]
  446.     lappend result [catch {testintobj mult10 1} msg]
  447.     lappend result $msg
  448. } {abc 1 {expected integer but got "abc"}}
  449. test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
  450.     set result ""
  451.     lappend result [testobj newobj 1]
  452.     lappend result [catch {testintobj div10 1} msg]
  453.     lappend result $msg
  454. } {{} 1 {expected integer but got ""}}
  455. test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
  456.     set result ""
  457.     lappend result [testobj newobj 1]
  458.     lappend result [testintobj inttoobigtest 1]
  459. } {{} 1}
  461. test obj-24.1 {DupIntInternalRep} {
  462.     set result ""
  463.     lappend result [testintobj set 1 23]
  464.     lappend result [testobj duplicate 1 2]    ;# uses DupIntInternalRep
  465.     lappend result [testintobj get 2]
  466. } {23 23 23}
  468. test obj-25.1 {SetIntFromAny, int to int special case} {
  469.     set result ""
  470.     lappend result [testintobj set 1 1234]
  471.     lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
  472.     lappend result [testobj type 1]
  473. } {1234 12340 int}
  474. test obj-25.2 {SetIntFromAny, boolean to int special case} {
  475.     set result ""
  476.     lappend result [testbooleanobj set 1 1]
  477.     lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
  478.     lappend result [testobj type 1]
  479. } {1 10 int}
  480. test obj-25.3 {SetIntFromAny, recompute string rep then parse it} {
  481.     set result ""
  482.     lappend result [testintobj set 1 456]
  483.     lappend result [testintobj div10 1]
  484.     lappend result [testintobj mult10 1]  ;# converts with SetIntFromAny
  485.     lappend result [testobj type 1]
  486. } {456 45 450 int}
  487. test obj-25.4 {SetIntFromAny, error parsing string} {
  488.     set result ""
  489.     lappend result [teststringobj set 1 abc]
  490.     lappend result [catch {testintobj mult10 1} msg]
  491.     lappend result $msg
  492. } {abc 1 {expected integer but got "abc"}}
  493. test obj-25.5 {SetIntFromAny, error parsing string} {
  494.     set result ""
  495.     lappend result [teststringobj set 1 x17]
  496.     lappend result [catch {testintobj mult10 1} msg]
  497.     lappend result $msg
  498. } {x17 1 {expected integer but got "x17"}}
  499. test obj-25.6 {SetIntFromAny, integer too large} {nonPortable} {
  500.     set result ""
  501.     lappend result [teststringobj set 1 123456789012345678901]
  502.     lappend result [catch {testintobj mult10 1} msg]
  503.     lappend result $msg
  504. } {123456789012345678901 1 {integer value too large to represent}}
  505. test obj-25.7 {SetIntFromAny, error converting from "empty string"} {
  506.     set result ""
  507.     lappend result [testobj newobj 1]
  508.     lappend result [catch {testintobj div10 1} msg]
  509.     lappend result $msg
  510. } {{} 1 {expected integer but got ""}}
  512. test obj-26.1 {UpdateStringOfInt} {
  513.     set result ""
  514.     lappend result [testintobj set 1 512]
  515.     lappend result [testintobj mult10 1]
  516.     lappend result [testintobj get 1]       ;# must update string rep
  517. } {512 5120 5120}
  519. test obj-27.1 {Tcl_NewLongObj} {
  520.     set result ""
  521.     lappend result [testobj freeallvars]
  522.     testintobj setmaxlong 1
  523.     lappend result [testintobj ismaxlong 1]
  524.     lappend result [testobj type 1]
  525.     lappend result [testobj refcount 1]
  526. } {{} 1 int 1}
  528. test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} {
  529.     set result ""
  530.     lappend result [testobj freeallvars]
  531.     lappend result [testobj newobj 1]
  532.     lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
  533.     lappend result [testobj type 1]
  534.     lappend result [testobj refcount 1]
  535. } {{} {} 77 int 2}
  536. test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} {
  537.     set result ""
  538.     lappend result [testobj freeallvars]
  539.     lappend result [testdoubleobj set 1 12.34]
  540.     lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
  541.     lappend result [testobj type 1]
  542.     lappend result [testobj refcount 1]
  543. } {{} 12.34 77 int 2}
  545. test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} {
  546.     set result ""
  547.     lappend result [testintobj setlong 1 22]
  548.     lappend result [testintobj mult10 1]   ;# gets existing long int rep
  549. } {22 220}
  550. test obj-29.2 {Tcl_GetLongFromObj, convert to long} {
  551.     set result ""
  552.     lappend result [testintobj setlong 1 477]
  553.     lappend result [testintobj div10 1]    ;# must convert to bool
  554.     lappend result [testobj type 1]
  555. } {477 47 int}
  556. test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} {
  557.     set result ""
  558.     lappend result [teststringobj set 1 abc]
  559.     lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
  560.     lappend result $msg
  561. } {abc 1 {expected integer but got "abc"}}
  562. test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
  563.     set result ""
  564.     lappend result [testobj newobj 1]
  565.     lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
  566.     lappend result $msg
  567. } {{} 1 {expected integer but got ""}}
  569. test obj-30.1 {Ref counting and object deletion, simple types} {
  570.     set result ""
  571.     lappend result [testobj freeallvars]
  572.     lappend result [testintobj set 1 1024]
  573.     lappend result [testobj assign 1 2]     ;# vars 1 and 2 share the int obj
  574.     lappend result [testobj type 2]
  575.     lappend result [testobj refcount 1]
  576.     lappend result [testobj refcount 2]
  577.     lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
  578.     lappend result [testobj type 2]
  579.     lappend result [testobj refcount 1]
  580.     lappend result [testobj refcount 2]
  581. } {{} 1024 1024 int 4 4 0 boolean 3 2}
  584. test obj-31.1 {regenerate string rep of "end"} {
  585.     testobj freeallvars
  586.     teststringobj set 1 end
  587.     testobj convert 1 end-offset
  588.     testobj invalidateStringRep 1
  589. } end
  591. test obj-31.2 {regenerate string rep of "end-1"} {
  592.     testobj freeallvars
  593.     teststringobj set 1 end-0x1
  594.     testobj convert 1 end-offset
  595.     testobj invalidateStringRep 1
  596. } end-1
  598. test obj-31.3 {regenerate string rep of "end--1"} {
  599.     testobj freeallvars
  600.     teststringobj set 1 end--0x1
  601.     testobj convert 1 end-offset
  602.     testobj invalidateStringRep 1
  603. } end--1
  605. test obj-31.4 {regenerate string rep of "end-bigInteger"} {
  606.     testobj freeallvars
  607.     teststringobj set 1 end-0x7fffffff
  608.     testobj convert 1 end-offset
  609.     testobj invalidateStringRep 1
  610. } end-2147483647
  612. test obj-31.5 {regenerate string rep of "end--bigInteger"} {
  613.     testobj freeallvars
  614.     teststringobj set 1 end--0x7fffffff
  615.     testobj convert 1 end-offset
  616.     testobj invalidateStringRep 1
  617. } end--2147483647
  618.     
  620. test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} {
  621.     testobj freeallvars
  622.     teststringobj set 1 end--0x80000000
  623.     testobj convert 1 end-offset
  624.     testobj invalidateStringRep 1
  625. } end--2147483648
  627. test obj-32.1 {integer overflow on input} {32bit wideBiggerThanInt} {
  628.     set x 0x8000; append x 0000
  629.     list [string is integer $x] [expr { wide($x) }]
  630. } {1 2147483648}
  632. test obj-32.2 {integer overflow on input} {32bit wideBiggerThanInt} {
  633.     set x 0xffff; append x ffff
  634.     list [string is integer $x] [expr { wide($x) }]
  635. } {1 4294967295}
  637. test obj-32.3 {integer overflow on input} {32bit wideBiggerThanInt} {
  638.     set x 0x10000; append x 0000
  639.     list [string is integer $x] [expr { wide($x) }]
  640. } {0 4294967296}
  642. test obj-32.4 {integer overflow on input} {32bit wideBiggerThanInt} {
  643.     set x -0x8000; append x 0000
  644.     list [string is integer $x] [expr { wide($x) }]
  645. } {1 -2147483648}
  647. test obj-32.5 {integer overflow on input} {32bit wideBiggerThanInt} {
  648.     set x -0x8000; append x 0001
  649.     list [string is integer $x] [expr { wide($x) }]
  650. } {1 -2147483649}
  652. test obj-32.6 {integer overflow on input} {32bit wideBiggerThanInt} {
  653.     set x -0xffff; append x ffff
  654.     list [string is integer $x] [expr { wide($x) }]
  655. } {1 -4294967295}
  657. test obj-32.7 {integer overflow on input} {32bit wideBiggerThanInt} {
  658.     set x -0x10000; append x 0000
  659.     list [string is integer $x] [expr { wide($x) }]
  660. } {0 -4294967296}
  662. testobj freeallvars
  664. # cleanup
  665. ::tcltest::cleanupTests
  666. return
  668. # Local Variables:
  669. # mode: tcl
  670. # End: