diff options
Diffstat (limited to 'tests/obj.test')
| -rw-r--r-- | tests/obj.test | 176 |
1 files changed, 113 insertions, 63 deletions
diff --git a/tests/obj.test b/tests/obj.test index b4b7672..ce7738d 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -6,20 +6,24 @@ # errors. No output means no errors were found. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: obj.test,v 1.2 1998/09/14 18:40:12 stanton Exp $ +# RCS: @(#) $Id: obj.test,v 1.3 1999/04/16 00:47:31 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} 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." + ::tcltest::cleanupTests return } -if {[string compare test [info procs test]] == 1} then {source defs} - test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} { set r 1 foreach {t} {list boolean cmdName bytecode string int double} { @@ -83,31 +87,55 @@ test obj-6.2 {Tcl_DuplicateObj, "empty string" object} { lappend result [testobj refcount 2] } {{} {} {} {} 2 3} -test obj-7.1 {Tcl_GetStringFromObj, return existing string rep} { +test obj-7.1 {Tcl_GetString, return existing string rep} { + set result "" + lappend result [testintobj set 1 47] + lappend result [testintobj get2 1] +} {47 47} +test obj-7.2 {Tcl_GetString, "empty string" object} { + set result "" + lappend result [testobj newobj 1] + lappend result [teststringobj append 1 abc -1] + lappend result [teststringobj get2 1] +} {{} abc abc} +test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} { + set result "" + lappend result [teststringobj set 1 xyz] + lappend result [teststringobj append 1 abc -1] + lappend result [teststringobj get2 1] +} {xyz xyzabc xyzabc} +test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} { + set result "" + lappend result [testintobj set 1 77] + lappend result [testintobj mult10 1] + lappend result [teststringobj get2 1] +} {77 770 770} + +test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} { set result "" lappend result [testintobj set 1 47] lappend result [testintobj get 1] } {47 47} -test obj-7.2 {Tcl_GetStringFromObj, "empty string" object} { +test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} { set result "" lappend result [testobj newobj 1] lappend result [teststringobj append 1 abc -1] lappend result [teststringobj get 1] } {{} abc abc} -test obj-7.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} { +test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} { set result "" lappend result [teststringobj set 1 xyz] lappend result [teststringobj append 1 abc -1] lappend result [teststringobj get 1] } {xyz xyzabc xyzabc} -test obj-7.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} { +test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} { set result "" lappend result [testintobj set 1 77] lappend result [testintobj mult10 1] lappend result [teststringobj get 1] } {77 770 770} -test obj-8.1 {Tcl_NewBooleanObj} { +test obj-9.1 {Tcl_NewBooleanObj} { set result "" lappend result [testobj freeallvars] lappend result [testbooleanobj set 1 0] @@ -115,7 +143,7 @@ test obj-8.1 {Tcl_NewBooleanObj} { lappend result [testobj refcount 1] } {{} 0 boolean 2} -test obj-9.1 {Tcl_SetBooleanObj, existing "empty string" object} { +test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] @@ -123,7 +151,7 @@ test obj-9.1 {Tcl_SetBooleanObj, existing "empty string" object} { lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 0 boolean 2} -test obj-9.2 {Tcl_SetBooleanObj, existing non-"empty string" object} { +test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 98765] @@ -132,50 +160,50 @@ test obj-9.2 {Tcl_SetBooleanObj, existing non-"empty string" object} { lappend result [testobj refcount 1] } {{} 98765 1 boolean 2} -test obj-10.1 {Tcl_GetBooleanFromObj, existing boolean object} { +test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} { set result "" lappend result [testbooleanobj set 1 1] lappend result [testbooleanobj not 1] ;# gets existing boolean rep } {1 0} -test obj-10.2 {Tcl_GetBooleanFromObj, convert to boolean} { +test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} { set result "" lappend result [testintobj set 1 47] lappend result [testbooleanobj not 1] ;# must convert to bool lappend result [testobj type 1] } {47 0 boolean} -test obj-10.3 {Tcl_GetBooleanFromObj, error converting to boolean} { +test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {abc 1 {expected boolean value but got "abc"}} -test obj-10.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} { +test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} { set result "" lappend result [testobj newobj 1] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {{} 1 {expected boolean value but got ""}} -test obj-11.1 {DupBooleanInternalRep} { +test obj-12.1 {DupBooleanInternalRep} { set result "" lappend result [testbooleanobj set 1 1] lappend result [testobj duplicate 1 2] ;# uses DupBooleanInternalRep lappend result [testbooleanobj get 2] } {1 1 1} -test obj-12.1 {SetBooleanFromAny, int to boolean special case} { +test obj-13.1 {SetBooleanFromAny, int to boolean special case} { set result "" lappend result [testintobj set 1 1234] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] } {1234 0 boolean} -test obj-12.2 {SetBooleanFromAny, double to boolean special case} { +test obj-13.2 {SetBooleanFromAny, double to boolean special case} { set result "" lappend result [testdoubleobj set 1 3.14159] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] } {3.14159 0 boolean} -test obj-12.3 {SetBooleanFromAny, special case strings representing booleans} { +test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} { set result "" foreach s {yes no true false on off} { teststringobj set 1 $s @@ -183,40 +211,46 @@ test obj-12.3 {SetBooleanFromAny, special case strings representing booleans} { } lappend result [testobj type 1] } {0 1 0 1 0 1 boolean} -test obj-12.4 {SetBooleanFromAny, recompute string rep then parse it} { +test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} { set result "" lappend result [testintobj set 1 456] lappend result [testintobj div10 1] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] } {456 45 0 boolean} -test obj-12.5 {SetBooleanFromAny, error parsing string} { +test obj-13.5 {SetBooleanFromAny, error parsing string} { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {abc 1 {expected boolean value but got "abc"}} -test obj-12.6 {SetBooleanFromAny, error parsing string} { +test obj-13.6 {SetBooleanFromAny, error parsing string} { set result "" lappend result [teststringobj set 1 x1.0] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {x1.0 1 {expected boolean value but got "x1.0"}} -test obj-12.7 {SetBooleanFromAny, error converting from "empty string"} { +test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} { set result "" lappend result [testobj newobj 1] lappend result [catch {testbooleanobj not 1} msg] lappend result $msg } {{} 1 {expected boolean value but got ""}} +test obj-13.8 {SetBooleanFromAny, unicode strings} { + set result "" + lappend result [teststringobj set 1 1\u7777] + lappend result [catch {testbooleanobj not 1} msg] + lappend result $msg +} "1\u7777 1 {expected boolean value but got \"1\u7777\"}" -test obj-13.1 {UpdateStringOfBoolean} { +test obj-14.1 {UpdateStringOfBoolean} { set result "" lappend result [testbooleanobj set 1 0] lappend result [testbooleanobj not 1] lappend result [testbooleanobj get 1] ;# must update string rep } {0 1 1} -test obj-14.1 {Tcl_NewDoubleObj} { +test obj-15.1 {Tcl_NewDoubleObj} { set result "" lappend result [testobj freeallvars] lappend result [testdoubleobj set 1 3.1459] @@ -224,7 +258,7 @@ test obj-14.1 {Tcl_NewDoubleObj} { lappend result [testobj refcount 1] } {{} 3.1459 double 2} -test obj-15.1 {Tcl_SetDoubleObj, existing "empty string" object} { +test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] @@ -232,7 +266,7 @@ test obj-15.1 {Tcl_SetDoubleObj, existing "empty string" object} { lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 0.123 double 2} -test obj-15.2 {Tcl_SetDoubleObj, existing non-"empty string" object} { +test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 98765] @@ -241,83 +275,83 @@ test obj-15.2 {Tcl_SetDoubleObj, existing non-"empty string" object} { lappend result [testobj refcount 1] } {{} 98765 27.56 double 2} -test obj-16.1 {Tcl_GetDoubleFromObj, existing double object} { +test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} { set result "" lappend result [testdoubleobj set 1 16.1] lappend result [testdoubleobj mult10 1] ;# gets existing double rep } {16.1 161.0} -test obj-16.2 {Tcl_GetDoubleFromObj, convert to double} { +test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} { set result "" lappend result [testintobj set 1 477] lappend result [testdoubleobj div10 1] ;# must convert to bool lappend result [testobj type 1] } {477 47.7 double} -test obj-16.3 {Tcl_GetDoubleFromObj, error converting to double} { +test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testdoubleobj mult10 1} msg] lappend result $msg } {abc 1 {expected floating-point number but got "abc"}} -test obj-16.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} { +test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} { set result "" lappend result [testobj newobj 1] lappend result [catch {testdoubleobj div10 1} msg] lappend result $msg } {{} 1 {expected floating-point number but got ""}} -test obj-17.1 {DupDoubleInternalRep} { +test obj-18.1 {DupDoubleInternalRep} { set result "" lappend result [testdoubleobj set 1 17.1] lappend result [testobj duplicate 1 2] ;# uses DupDoubleInternalRep lappend result [testdoubleobj get 2] } {17.1 17.1 17.1} -test obj-18.1 {SetDoubleFromAny, int to double special case} { +test obj-19.1 {SetDoubleFromAny, int to double special case} { set result "" lappend result [testintobj set 1 1234] lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny lappend result [testobj type 1] } {1234 12340.0 double} -test obj-18.2 {SetDoubleFromAny, boolean to double special case} { +test obj-19.2 {SetDoubleFromAny, boolean to double special case} { set result "" lappend result [testbooleanobj set 1 1] lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny lappend result [testobj type 1] } {1 10.0 double} -test obj-18.3 {SetDoubleFromAny, recompute string rep then parse it} { +test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} { set result "" lappend result [testintobj set 1 456] lappend result [testintobj div10 1] lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny lappend result [testobj type 1] } {456 45 450.0 double} -test obj-18.4 {SetDoubleFromAny, error parsing string} { +test obj-19.4 {SetDoubleFromAny, error parsing string} { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testdoubleobj mult10 1} msg] lappend result $msg } {abc 1 {expected floating-point number but got "abc"}} -test obj-18.5 {SetDoubleFromAny, error parsing string} { +test obj-19.5 {SetDoubleFromAny, error parsing string} { set result "" lappend result [teststringobj set 1 x1.0] lappend result [catch {testdoubleobj mult10 1} msg] lappend result $msg } {x1.0 1 {expected floating-point number but got "x1.0"}} -test obj-18.6 {SetDoubleFromAny, error converting from "empty string"} { +test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} { set result "" lappend result [testobj newobj 1] lappend result [catch {testdoubleobj div10 1} msg] lappend result $msg } {{} 1 {expected floating-point number but got ""}} -test obj-19.1 {UpdateStringOfDouble} { +test obj-20.1 {UpdateStringOfDouble} { set result "" lappend result [testdoubleobj set 1 3.14159] lappend result [testdoubleobj mult10 1] lappend result [testdoubleobj get 1] ;# must update string rep } {3.14159 31.4159 31.4159} -test obj-20.1 {Tcl_NewIntObj} { +test obj-21.1 {Tcl_NewIntObj} { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 55] @@ -325,7 +359,7 @@ test obj-20.1 {Tcl_NewIntObj} { lappend result [testobj refcount 1] } {{} 55 int 2} -test obj-21.1 {Tcl_SetIntObj, existing "empty string" object} { +test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] @@ -333,7 +367,7 @@ test obj-21.1 {Tcl_SetIntObj, existing "empty string" object} { lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 77 int 2} -test obj-21.2 {Tcl_SetIntObj, existing non-"empty string" object} { +test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} { set result "" lappend result [testobj freeallvars] lappend result [testdoubleobj set 1 12.34] @@ -342,94 +376,94 @@ test obj-21.2 {Tcl_SetIntObj, existing non-"empty string" object} { lappend result [testobj refcount 1] } {{} 12.34 77 int 2} -test obj-22.1 {Tcl_GetIntFromObj, existing int object} { +test obj-23.1 {Tcl_GetIntFromObj, existing int object} { set result "" lappend result [testintobj set 1 22] lappend result [testintobj mult10 1] ;# gets existing int rep } {22 220} -test obj-22.2 {Tcl_GetIntFromObj, convert to int} { +test obj-23.2 {Tcl_GetIntFromObj, convert to int} { set result "" lappend result [testintobj set 1 477] lappend result [testintobj div10 1] ;# must convert to bool lappend result [testobj type 1] } {477 47 int} -test obj-22.3 {Tcl_GetIntFromObj, error converting to int} { +test obj-23.3 {Tcl_GetIntFromObj, error converting to int} { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {abc 1 {expected integer but got "abc"}} -test obj-22.4 {Tcl_GetIntFromObj, error converting from "empty string"} { +test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} { set result "" lappend result [testobj newobj 1] lappend result [catch {testintobj div10 1} msg] lappend result $msg } {{} 1 {expected integer but got ""}} -test obj-22.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} { +test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} { set result "" lappend result [testobj newobj 1] lappend result [testintobj inttoobigtest 1] } {{} 1} -test obj-23.1 {DupIntInternalRep} { +test obj-24.1 {DupIntInternalRep} { set result "" lappend result [testintobj set 1 23] lappend result [testobj duplicate 1 2] ;# uses DupIntInternalRep lappend result [testintobj get 2] } {23 23 23} -test obj-24.1 {SetIntFromAny, int to int special case} { +test obj-25.1 {SetIntFromAny, int to int special case} { set result "" lappend result [testintobj set 1 1234] lappend result [testintobj mult10 1] ;# converts with SetIntFromAny lappend result [testobj type 1] } {1234 12340 int} -test obj-24.2 {SetIntFromAny, boolean to int special case} { +test obj-25.2 {SetIntFromAny, boolean to int special case} { set result "" lappend result [testbooleanobj set 1 1] lappend result [testintobj mult10 1] ;# converts with SetIntFromAny lappend result [testobj type 1] } {1 10 int} -test obj-24.3 {SetIntFromAny, recompute string rep then parse it} { +test obj-25.3 {SetIntFromAny, recompute string rep then parse it} { set result "" lappend result [testintobj set 1 456] lappend result [testintobj div10 1] lappend result [testintobj mult10 1] ;# converts with SetIntFromAny lappend result [testobj type 1] } {456 45 450 int} -test obj-24.4 {SetIntFromAny, error parsing string} { +test obj-25.4 {SetIntFromAny, error parsing string} { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {abc 1 {expected integer but got "abc"}} -test obj-24.5 {SetIntFromAny, error parsing string} { +test obj-25.5 {SetIntFromAny, error parsing string} { set result "" lappend result [teststringobj set 1 x17] lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {x17 1 {expected integer but got "x17"}} -test obj-24.6 {SetIntFromAny, integer too large} {nonPortable} { +test obj-25.6 {SetIntFromAny, integer too large} {nonPortable} { set result "" lappend result [teststringobj set 1 123456789012345678901] lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {123456789012345678901 1 {integer value too large to represent}} -test obj-24.7 {SetIntFromAny, error converting from "empty string"} { +test obj-25.7 {SetIntFromAny, error converting from "empty string"} { set result "" lappend result [testobj newobj 1] lappend result [catch {testintobj div10 1} msg] lappend result $msg } {{} 1 {expected integer but got ""}} -test obj-25.1 {UpdateStringOfInt} { +test obj-26.1 {UpdateStringOfInt} { set result "" lappend result [testintobj set 1 512] lappend result [testintobj mult10 1] lappend result [testintobj get 1] ;# must update string rep } {512 5120 5120} -test obj-26.1 {Tcl_NewLongObj} { +test obj-27.1 {Tcl_NewLongObj} { set result "" lappend result [testobj freeallvars] testintobj setmaxlong 1 @@ -438,7 +472,7 @@ test obj-26.1 {Tcl_NewLongObj} { lappend result [testobj refcount 1] } {{} 1 int 1} -test obj-27.1 {Tcl_SetLongObj, existing "empty string" object} { +test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] @@ -446,7 +480,7 @@ test obj-27.1 {Tcl_SetLongObj, existing "empty string" object} { lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} 77 int 2} -test obj-27.2 {Tcl_SetLongObj, existing non-"empty string" object} { +test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} { set result "" lappend result [testobj freeallvars] lappend result [testdoubleobj set 1 12.34] @@ -455,31 +489,31 @@ test obj-27.2 {Tcl_SetLongObj, existing non-"empty string" object} { lappend result [testobj refcount 1] } {{} 12.34 77 int 2} -test obj-28.1 {Tcl_GetLongFromObj, existing long integer object} { +test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} { set result "" lappend result [testintobj setlong 1 22] lappend result [testintobj mult10 1] ;# gets existing long int rep } {22 220} -test obj-28.2 {Tcl_GetLongFromObj, convert to long} { +test obj-29.2 {Tcl_GetLongFromObj, convert to long} { set result "" lappend result [testintobj setlong 1 477] lappend result [testintobj div10 1] ;# must convert to bool lappend result [testobj type 1] } {477 47 int} -test obj-28.3 {Tcl_GetLongFromObj, error converting to long integer} { +test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} { set result "" lappend result [teststringobj set 1 abc] lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int lappend result $msg } {abc 1 {expected integer but got "abc"}} -test obj-28.4 {Tcl_GetLongFromObj, error converting from "empty string"} { +test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} { set result "" lappend result [testobj newobj 1] lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int lappend result $msg } {{} 1 {expected integer but got ""}} -test obj-29.1 {Ref counting and object deletion, simple types} { +test obj-30.1 {Ref counting and object deletion, simple types} { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 1024] @@ -494,3 +528,19 @@ test obj-29.1 {Ref counting and object deletion, simple types} { } {{} 1024 1024 int 4 4 0 boolean 3 2} testobj freeallvars + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + |