diff options
Diffstat (limited to 'tests/listObj.test')
| -rw-r--r-- | tests/listObj.test | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/tests/listObj.test b/tests/listObj.test index 0b64635..0f43648 100644 --- a/tests/listObj.test +++ b/tests/listObj.test @@ -20,6 +20,7 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] +testConstraint memory [llength [info commands memory]] catch {unset x} test listobj-1.1 {Tcl_GetListObjType} emptyTest { @@ -210,6 +211,73 @@ test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj testobj bug3598580 } 123 +# Stolen from dict.test +proc listobjmemcheck script { + set end [lindex [split [memory info] \n] 3 3] + for {set i 0} {$i < 5} {incr i} { + uplevel 1 $script + set tmp $end + set end [lindex [split [memory info] \n] 3 3] + } + expr {$end - $tmp} +} + +test listobj-12.1 {Tcl_ListObjIndex memory leaks for native lists} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [lrepeat 1000 x] + set errorMessage [testlistobj indexmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} +test listobj-12.2 {Tcl_ListObjIndex memory leaks for native lists with spans} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [testlistrep new 1000 100 100] + set errorMessage [testlistobj indexmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} +test listobj-12.3 {Tcl_ListObjIndex memory leaks for lseq} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [lseq 1000] + set errorMessage [testlistobj indexmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} + +test listobj-13.1 {Tcl_ListObjGetElements memory leaks for native lists} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [lrepeat 1000 x] + set errorMessage [testlistobj getelementsmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} +test listobj-13.2 {Tcl_ListObjElements memory leaks for native lists with spans} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [testlistrep new 1000 100 100] + set errorMessage [testlistobj getelementsmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} +test listobj-13.3 {Tcl_ListObjElements memory leaks for lseq} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [lseq 1000] + set errorMessage [testlistobj getelementsmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} + # cleanup ::tcltest::cleanupTests return |