diff options
Diffstat (limited to 'tests/obj.test')
| -rw-r--r-- | tests/obj.test | 111 |
1 files changed, 81 insertions, 30 deletions
diff --git a/tests/obj.test b/tests/obj.test index a6bb192..7273b40 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -10,30 +10,29 @@ # # 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.8 2004/05/19 20:15:32 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + testConstraint testobj [llength [info commands testobj]] +testConstraint longIs32bit [expr {int(0x80000000) < 0}] +testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { set r 1 foreach {t} { {array search} - boolean bytearray bytecode - double + cmdName + dict end-offset - index - int - list - nsName - procbody + regexp string } { set first [string first $t [testobj types]] @@ -45,21 +44,23 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes test obj-2.1 {Tcl_GetObjType error} testobj { list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg } {0 1 {no type foo found}} -test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} { +test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj { set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 12] - lappend result [testobj convert 1 double] + lappend result [testobj convert 1 bytearray] lappend result [testobj type 1] lappend result [testobj refcount 1] -} {{} 12 12 double 3} +} {{} 12 12 bytearray 3} test obj-3.1 {Tcl_ConvertToType error} testobj { - list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg -} {12.34 1 {expected integer but got "12.34"}} + list [testdoubleobj set 1 12.34] \ + [catch {testobj convert 1 end-offset} msg] \ + $msg +} {12.34 1 {bad index "12.34": must be end?[+-]integer?}} test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj { - list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg -} {{} 1 {expected integer but got ""}} + list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg +} {{} 1 {bad index "": must be end?[+-]integer?}} test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj { set result "" @@ -152,7 +153,7 @@ test obj-9.1 {Tcl_NewBooleanObj} testobj { lappend result [testbooleanobj set 1 0] lappend result [testobj type 1] lappend result [testobj refcount 1] -} {{} 0 boolean 2} +} {{} 0 int 2} test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} testobj { set result "" @@ -161,7 +162,7 @@ test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} testobj { lappend result [testbooleanobj set 1 0] ;# makes existing obj boolean lappend result [testobj type 1] lappend result [testobj refcount 1] -} {{} {} 0 boolean 2} +} {{} {} 0 int 2} test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} testobj { set result "" lappend result [testobj freeallvars] @@ -169,7 +170,7 @@ test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} testobj { lappend result [testbooleanobj set 1 1] ;# makes existing obj boolean lappend result [testobj type 1] lappend result [testobj refcount 1] -} {{} 98765 1 boolean 2} +} {{} 98765 1 int 2} test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} testobj { set result "" @@ -181,7 +182,7 @@ test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} testobj { lappend result [testintobj set 1 47] lappend result [testbooleanobj not 1] ;# must convert to bool lappend result [testobj type 1] -} {47 0 boolean} +} {47 0 int} test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} testobj { set result "" lappend result [teststringobj set 1 abc] @@ -199,13 +200,13 @@ test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} testobj { lappend result [teststringobj set 1 0xac] lappend result [testbooleanobj not 1] lappend result [testobj type 1] -} {0xac 0 boolean} +} {0xac 0 int} test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} testobj { set result "" lappend result [teststringobj set 1 5.42] lappend result [testbooleanobj not 1] lappend result [testobj type 1] -} {5.42 0 boolean} +} {5.42 0 int} test obj-12.1 {DupBooleanInternalRep} testobj { set result "" @@ -219,13 +220,13 @@ test obj-13.1 {SetBooleanFromAny, int to boolean special case} testobj { lappend result [testintobj set 1 1234] lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny lappend result [testobj type 1] -} {1234 0 boolean} +} {1234 0 int} test obj-13.2 {SetBooleanFromAny, double to boolean special case} testobj { 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} +} {3.14159 0 int} test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} testobj { set result "" foreach s {yes no true false on off} { @@ -233,14 +234,14 @@ test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} te lappend result [testbooleanobj not 1] } lappend result [testobj type 1] -} {0 1 0 1 0 1 boolean} +} {0 1 0 1 0 1 int} test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} testobj { 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} +} {456 45 0 int} test obj-13.5 {SetBooleanFromAny, error parsing string} testobj { set result "" lappend result [teststringobj set 1 abc] @@ -422,7 +423,7 @@ test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} testobj lappend result [catch {testintobj div10 1} msg] lappend result $msg } {{} 1 {expected integer but got ""}} -test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {testobj nonPortable} { +test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {testobj} { set result "" lappend result [testobj newobj 1] lappend result [testintobj inttoobigtest 1] @@ -466,7 +467,7 @@ test obj-25.5 {SetIntFromAny, error parsing string} testobj { lappend result [catch {testintobj mult10 1} msg] lappend result $msg } {x17 1 {expected integer but got "x17"}} -test obj-25.6 {SetIntFromAny, integer too large} {testobj nonPortable} { +test obj-25.6 {SetIntFromAny, integer too large} {testobj} { set result "" lappend result [teststringobj set 1 123456789012345678901] lappend result [catch {testintobj mult10 1} msg] @@ -548,7 +549,7 @@ test obj-30.1 {Ref counting and object deletion, simple types} testobj { lappend result [testobj type 2] lappend result [testobj refcount 1] lappend result [testobj refcount 2] -} {{} 1024 1024 int 4 4 0 boolean 3 2} +} {{} 1024 1024 int 4 4 0 int 3 2} test obj-31.1 {regenerate string rep of "end"} testobj { @@ -581,13 +582,63 @@ test obj-31.5 {regenerate string rep of "end--bigInteger"} testobj { testobj convert 1 end-offset testobj invalidateStringRep 1 } end--2147483647 -test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj nonPortable} { +test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj longIs32bit} { testobj freeallvars teststringobj set 1 end--0x80000000 testobj convert 1 end-offset testobj invalidateStringRep 1 } end--2147483648 +test obj-32.1 {freeing very large object trees} { + set x {} + for {set i 0} {$i<100000} {incr i} { + set x [list $x {}] + } + unset x +} {} + +test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} { + set x 0x8000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {1 2147483648} +test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} { + set x 0xffff; append x ffff + list [string is integer $x] [expr { wide($x) }] +} {1 4294967295} +test obj-33.3 {integer overflow on input} { + set x 0x10000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {0 4294967296} +test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} { + set x -0x8000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {1 -2147483648} +test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} { + set x -0x8000; append x 0001 + list [string is integer $x] [expr { wide($x) }] +} {1 -2147483649} +test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} { + set x -0xffff; append x ffff + list [string is integer $x] [expr { wide($x) }] +} {1 -4294967295} +test obj-33.7 {integer overflow on input} { + set x -0x10000; append x 0000 + list [string is integer $x] [expr { wide($x) }] +} {0 -4294967296} + +test obj-34.1 {mp_iseven} testobj { + set result "" + lappend result [testbignumobj set 1 0] + lappend result [testbignumobj iseven 1] ; + lappend result [testobj type 1] +} {0 1 int} +test obj-34.2 {mp_radix_size} testobj { + set result "" + lappend result [testbignumobj set 1 9] + lappend result [testbignumobj radixsize 1] ; + lappend result [testobj type 1] +} {9 2 int} + if {[testConstraint testobj]} { testobj freeallvars } |