[tcljava-dev] Testcase for bug 2072924
Brought to you by:
mdejong
From: Tom P. <tpo...@ny...> - 2009-01-16 22:55:12
|
I've been looking into the bug I filed a while back, and developed a stand alone test case that illustrates the behavior. Itcl class Foo resembles my actual environment. It wraps up a Java object, and the destructor does an explicit 'rename' to get rid of the object command. Bar class is the same, except it does not explicitly rename the Java object upon destruction. Proc 'testVar' is similar to the Foo class, but obviously without Itcl class or namespace issues - it too explicitly renames the Java object to {} when going out of scope. The behavior in the bug I reported is evident when running: jaclsh testcase.tcl Foo The first time the 'testFoo' proc runs, all is good, but subsequent executions of 'testFoo' reports errors, the Java object command is returned, but it is no longer a valid Tcl command. Testing class Bar, without an explicit rename of the Java object: jaclsh testcase.tcl Bar This case runs to completion, but leaks the Java object command into the top level namespace. Furthermore, it appears that the ReflectObject.useCount is incremented for the ReflectObject, each time through 'testBar' (as witnessed with the Eclipse debugger). See below for output. Unfortunately the patch I submitted seems to also increment the useCount, therefore it too leaks objects in Java, not necessarily in Tcl command space. Mo, do you see anything wrong with my Foo class or its usage? testcase.tcl: ---cut here--------------------------------------------------------------- package require java package require Itcl # itcl class - destructor explicitly destroys the java object _obj_ itcl::class Foo { private variable _obj_ constructor {sbObj} { set _obj_ $sbObj } destructor { puts "destruct $this" catch {rename $_obj_ {}} } public method _getObj_ {} { return $_obj_ } public method getValue {} { return [$_obj_ toString] } } # itcl class - destructor does not destroy the java object _obj_ itcl::class Bar { private variable _obj_ constructor {sbObj} { set _obj_ $sbObj } destructor { puts "destruct $this" } public method _getObj_ {} { return $_obj_ } public method getValue {} { return [$_obj_ toString] } } # create a HashMap, put in one StringBuffer object set hm [java::new java.util.HashMap] set sb [java::new String sb] $hm put $sb [java::new java.lang.StringBuffer foobar] puts "info commands java0x*: [lsort [info commands java0x*]]" # proc to test retrieving the StringBuffer object into a simple Tcl variable # explicitly destroy the StringBuffer object command via "rename" proc testVar {} { global hm sb set o [$hm get $sb] puts "testVar: [$o toString]" rename $o {} return "" } # proc to test retrieving the StringBuffer object into an Itcl object Foo proc testFoo {} { global hm sb set o [$hm get $sb] set f [Foo #auto $o] puts "testFoo: [$f getValue]" itcl::delete object $f return "" } # proc to test retrieving the StringBuffer object into an Itcl object Bar proc testBar {} { global hm sb set o [$hm get $sb] set b [Bar #auto $o] puts "testBar: [$b getValue]" itcl::delete object $b return "" } if {[lindex $argv 0] eq "Foo"} { puts ==testVar=========================================== for {set i 1} {$i < 5} {incr i} { if {[catch {testVar} result]} { puts "testVar: iteration $i catch error: $result" } puts "testVar: iteration $i \[info commands java0x*\]: [lsort [info commands java0x*]]" } puts ==testFoo=========================================== for {set i 1} {$i < 5} {incr i} { if {[catch {testFoo} result]} { puts "testFoo: iteration $i catch error: $result" } puts "testFoo: iteration $i \[info commands java0x*\]: [lsort [info commands java0x*]]" } } elseif {[lindex $argv 0] eq "Bar"} { puts ==testVar=========================================== for {set i 1} {$i < 5} {incr i} { if {[catch {testVar} result]} { puts "testVar: iteration $i catch error: $result" } puts "testVar: iteration $i \[info commands java0x*\]: [lsort [info commands java0x*]]" } puts ==testBar=========================================== for {set i 1} {$i < 5} {incr i} { if {[catch {testBar} result]} { puts "testVar: iteration $i catch error: $result" } puts "testbar: iteration $i \[info commands java0x*\]: [lsort [info commands java0x*]]" } } else { error "arg should be \"Foo\" or \"Bar\"" } ---cut here--------------------------------------------------------------- Test results: $ jaclsh testcase.tcl Foo info commands java0x*: java0x1 java0x2 ==testVar=========================================== testVar: foobar testVar: iteration 1 [info commands java0x*]: java0x1 java0x2 testVar: foobar testVar: iteration 2 [info commands java0x*]: java0x1 java0x2 testVar: foobar testVar: iteration 3 [info commands java0x*]: java0x1 java0x2 testVar: foobar testVar: iteration 4 [info commands java0x*]: java0x1 java0x2 ==testFoo=========================================== testFoo: foobar destruct ::foo0 testFoo: iteration 1 [info commands java0x*]: java0x1 java0x2 testFoo: iteration 2 catch error: invalid command name "java0x8" testFoo: iteration 2 [info commands java0x*]: java0x1 java0x2 testFoo: iteration 3 catch error: invalid command name "java0x8" testFoo: iteration 3 [info commands java0x*]: java0x1 java0x2 testFoo: iteration 4 catch error: invalid command name "java0x8" testFoo: iteration 4 [info commands java0x*]: java0x1 java0x2 $ jaclsh testcase.tcl Bar info commands java0x*: java0x1 java0x2 ==testVar=========================================== testVar: foobar testVar: iteration 1 [info commands java0x*]: java0x1 java0x2 testVar: foobar testVar: iteration 2 [info commands java0x*]: java0x1 java0x2 testVar: foobar testVar: iteration 3 [info commands java0x*]: java0x1 java0x2 testVar: foobar testVar: iteration 4 [info commands java0x*]: java0x1 java0x2 ==testBar=========================================== testBar: foobar destruct ::bar0 testbar: iteration 1 [info commands java0x*]: java0x1 java0x2 java0x8 testBar: foobar destruct ::bar1 testbar: iteration 2 [info commands java0x*]: java0x1 java0x2 java0x8 testBar: foobar destruct ::bar2 testbar: iteration 3 [info commands java0x*]: java0x1 java0x2 java0x8 testBar: foobar destruct ::bar3 testbar: iteration 4 [info commands java0x*]: java0x1 java0x2 java0x8 -- Tom Poindexter tpo...@ny... |