Index: tests/destroytest.tcl =================================================================== diff -u -r1a67ad0bf0b5c2092e1558d13659bad489f5bb75 -r18122dd21b99cf0d5b4cd01635048641a23aa051 --- tests/destroytest.tcl (.../destroytest.tcl) (revision 1a67ad0bf0b5c2092e1558d13659bad489f5bb75) +++ tests/destroytest.tcl (.../destroytest.tcl) (revision 18122dd21b99cf0d5b4cd01635048641a23aa051) @@ -27,18 +27,18 @@ C method foo {} { puts stderr "==== $::case [current]" :destroy - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 ? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBBB" - ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc" + ? {::nsf::isobject c1} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::nsf::objectproperty c1 object] -? {::nsf::objectproperty c1 object} 0 "$::case object deleted" +puts stderr ======[::nsf::isobject c1] +? {::nsf::isobject c1} 0 "$::case object deleted" ? "set ::firstDestroy" 1 "firstDestroy called" @@ -52,18 +52,18 @@ C method foo {} { puts stderr "==== $::case [current]" :destroy - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 ? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBBB" - ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc" + ? {::nsf::isobject c1} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::nsf::objectproperty c1 object] -? {::nsf::objectproperty c1 object} 1 "$::case object deleted" +puts stderr ======[::nsf::isobject c1] +? {::nsf::isobject c1} 1 "$::case object deleted" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -77,18 +77,18 @@ C method foo {} { puts stderr "==== $::case [current]" [:info class] create [current] - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 ? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBBB" - ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc" + ? {::nsf::isobject c1} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::nsf::objectproperty c1 object] -? {::nsf::objectproperty c1 object} 1 "$::case object deleted" +puts stderr ======[::nsf::isobject c1] +? {::nsf::isobject c1} 1 "$::case object deleted" ? "set ::firstDestroy" 0 "firstDestroy called" # @@ -103,18 +103,18 @@ C method foo {} { puts stderr "==== $::case [current]" rename [current] "" - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 ? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" - ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc" + ? {::nsf::isobject c1} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::nsf::objectproperty c1 object] -? {::nsf::objectproperty c1 object} 0 "$::case object still exists after proc" +puts stderr ======[::nsf::isobject c1] +? {::nsf::isobject c1} 0 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" @@ -130,19 +130,19 @@ C method foo {} { puts stderr "==== $::case [current]" rename [current] "" - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 ? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" - ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc" + ? {::nsf::isobject c1} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::nsf::objectproperty c1 object] +puts stderr ======[::nsf::isobject c1] puts stderr ======[c1 set x] -? {::nsf::objectproperty c1 object} 1 "$::case object still exists after proc" +? {::nsf::isobject c1} 1 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -158,18 +158,18 @@ C method foo {} { puts stderr "==== $::case [current]" rename o [current] - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 ? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" - ? {::nsf::objectproperty c1 object} 1 "$::case object still exists in proc" + ? {::nsf::isobject c1} 1 "$::case object still exists in proc" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create c1 c1 foo -puts stderr ======[::nsf::objectproperty c1 object] -? {::nsf::objectproperty c1 object} 1 "$::case object still exists after proc" +puts stderr ======[::nsf::isobject c1] +? {::nsf::isobject c1} 1 "$::case object still exists after proc" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -189,7 +189,7 @@ } C create c1 c1 foo -? {::nsf::objectproperty c1 object} 1 "$::case object still exists after proc" +? {::nsf::isobject c1} 1 "$::case object still exists after proc" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -209,28 +209,28 @@ C method foo {} { puts stderr "==== $::case [current]" namespace delete ::test - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 # # If the following line is commented in, the namespace is deleted # here. Is there a bug with nsPtr->activationCount # #? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" - puts stderr "???? [current] exists [::nsf::objectproperty [current] object]" - ? "::nsf::objectproperty [current] object" 0 ;# WHY? - puts stderr "???? [current] exists [::nsf::objectproperty [current] object]" + puts stderr "???? [current] exists [::nsf::isobject [current]]" + ? "::nsf::isobject [current]" 0 ;# WHY? + puts stderr "???? [current] exists [::nsf::isobject [current]]" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "$::case destroy not yet called" } } test::C create test::c1 test::c1 foo -puts stderr ======[::nsf::objectproperty test::c1 object] -? {::nsf::objectproperty test::c1 object} 0 "object still exists after proc" +puts stderr ======[::nsf::isobject test::c1] +? {::nsf::isobject test::c1} 0 "object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "destroy was called when poping stack frame" -? {::nsf::objectproperty ::test::C object} 0 "class still exists after proc" +? {::nsf::isobject ::test::C} 0 "class still exists after proc" ? {namespace exists ::test::C} 0 "namespace ::test::C still exists after proc" ? {namespace exists ::test} 1 "parent ::test namespace still exists after proc" ? {namespace exists ::xotcl::classes::test::C} 0 "namespace ::xotcl::classes::test::C still exists after proc" @@ -249,25 +249,25 @@ C method foo {} { puts stderr "==== $::case [current]" namespace delete ::test - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 # # If the following line is commented in, the namespace is deleted # here. Is there a bug with nsPtr->activationCount # #? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBBB" - puts stderr "???? [current] exists [::nsf::objectproperty [current] object]" - ? "::nsf::objectproperty [current] object" 0 "$::case object still exists in proc";# WHY? - puts stderr "???? [current] exists [::nsf::objectproperty [current] object]" + puts stderr "???? [current] exists [::nsf::isobject [current]]" + ? "::nsf::isobject [current]" 0 "$::case object still exists in proc";# WHY? + puts stderr "???? [current] exists [::nsf::isobject [current]]" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called"; # NOT YET CALLED } } test::C create test::c1 test::c1 foo -puts stderr ======[::nsf::objectproperty test::c1 object] -? {::nsf::objectproperty test::c1 object} 0 "$::case object still exists after proc" +puts stderr ======[::nsf::isobject test::c1] +? {::nsf::isobject test::c1} 0 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" ;# toplevel destroy was blocked @@ -287,20 +287,20 @@ puts stderr "AAAA" # the following isobject call has a problem in Tcl_GetCommandFromObj(), # which tries to access invalid memory - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 #? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBBB" - ? {::nsf::objectproperty ::o::c1 object} 0 "$::case object still exists in proc" + ? {::nsf::isobject ::o::c1} 0 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" } C create o::c1 o::c1 foo -puts stderr ======[::nsf::objectproperty ::o::c1 object] -? {::nsf::objectproperty ::o::c1 object} 0 "$::case object o::c1 still exists after proc" -? {::nsf::objectproperty o object} 0 "$::case object o still exists after proc" +puts stderr ======[::nsf::isobject ::o::c1] +? {::nsf::isobject ::o::c1} 0 "$::case object o::c1 still exists after proc" +? {::nsf::isobject o} 0 "$::case object o still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" @@ -317,18 +317,18 @@ C method foo {} { puts stderr "==== $::case [current]" o destroy - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 #? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" - ? {::nsf::objectproperty ::o::c1 object} 0 "$::case object still exists in proc" + ? {::nsf::isobject ::o::c1} 0 "$::case object still exists in proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" } C create o::c1 o::c1 foo -puts stderr ======[::nsf::objectproperty ::o::c1 object] -? {::nsf::objectproperty ::o::c1 object} 0 "$::case object still exists after proc" +puts stderr ======[::nsf::isobject ::o::c1] +? {::nsf::isobject ::o::c1} 0 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -345,18 +345,18 @@ C method foo {} { puts stderr "==== $::case [current]" proc [current] {args} {puts HELLO} - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 #? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" - ? {::nsf::objectproperty c1 object} 0 "$::case object still exists in proc" + ? {::nsf::isobject c1} 0 "$::case object still exists in proc" } C create c1 c1 foo -puts stderr ======[::nsf::objectproperty c1 object] -? {::nsf::objectproperty c1 object} 0 "$::case object still exists after proc" +puts stderr ======[::nsf::isobject c1] +? {::nsf::isobject c1} 0 "$::case object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" @@ -372,22 +372,22 @@ C method foo {} { puts stderr "==== $::case [current]" C destroy - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 #? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" #? [:info class] ::xotcl::Object "object reclassed" ? [:info class] ::C "object reclassed?" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" - ? {::nsf::objectproperty c1 object} 1 "object still exists in proc" + ? {::nsf::isobject c1} 1 "object still exists in proc" #? {::nsf::objectproperty ::C class} 0 "class still exists in proc" ? {::nsf::objectproperty ::C class} 1 "class still exists in proc" } C create c1 c1 foo -puts stderr ======[::nsf::objectproperty c1 object] -? {::nsf::objectproperty c1 object} 1 "object still exists after proc" +puts stderr ======[::nsf::isobject c1] +? {::nsf::isobject c1} 1 "object still exists after proc" ? [c1 info class] ::nx::Object "after proc: object reclassed?" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "ObjectDestroy called" @@ -402,7 +402,7 @@ C method foo {} { puts stderr "==== $::case [current]" C destroy - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 #? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" @@ -412,13 +412,13 @@ ? "set ::ObjectDestroy" 1 "ObjectDestroy called" ? [:info class] ::C "object reclassed" #? [:info class] ::xotcl::Object "object reclassed" - ? {::nsf::objectproperty ::C::c1 object} 1 "object still exists in proc" + ? {::nsf::isobject ::C::c1} 1 "object still exists in proc" ? {::nsf::objectproperty ::C class} 1 "class still exists in proc" } C create ::C::c1 C::c1 foo -#puts stderr ======[::nsf::objectproperty ::C::c1 object] -? {::nsf::objectproperty ::C::c1 object} 0 "object still exists after proc" +#puts stderr ======[::nsf::isobject ::C::c1] +? {::nsf::isobject ::C::c1} 0 "object still exists after proc" ? {::nsf::objectproperty ::C class} 0 "class still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "ObjectDestroy called" @@ -428,8 +428,8 @@ Object create x Object create x::y x destroy - ? {::nsf::objectproperty x object} 0 "parent object gone" - ? {::nsf::objectproperty x::y object} 0 "child object gone" + ? {::nsf::isobject x} 0 "parent object gone" + ? {::nsf::isobject x::y} 0 "child object gone" } Test case deleting-aliased-object { @@ -457,18 +457,18 @@ Object create o3 ::nsf::alias o x o3 o destroy -? {::nsf::objectproperty o object} 0 "parent object gone" -? {::nsf::objectproperty o3 object} 1 "aliased object still here" +? {::nsf::isobject o} 0 "parent object gone" +? {::nsf::isobject o3} 1 "aliased object still here" o3 destroy -? {::nsf::objectproperty o3 object} 0 "aliased object destroyed" +? {::nsf::isobject o3} 0 "aliased object destroyed" set case "create an alias, and delete cmd via aggregation" Test case create-alias-delete-via-aggregation Object create o Object create o3 ::nsf::alias o x o3 o::x destroy -? {::nsf::objectproperty o3 object} 0 "aliased object destroyed" +? {::nsf::isobject o3} 0 "aliased object destroyed" o destroy # @@ -517,8 +517,8 @@ C alias b o C create c1 C destroy - ? {::nsf::objectproperty o object} 1 "object o still here" - ? {::nsf::objectproperty o3 object} 1 "object o3 still here" + ? {::nsf::isobject o} 1 "object o still here" + ? {::nsf::isobject o3} 1 "object o3 still here" } # @@ -553,23 +553,23 @@ } ? {::nsf::objectproperty ::module::Foo class} 1 ? {::nsf::objectproperty ::module::foo class} 0 - ? {::nsf::objectproperty ::module::foo object} 1 + ? {::nsf::isobject ::module::foo} 1 ? {::nsf::objectproperty ::module class} 1 Object create ::o { :require namespace } namespace eval ::o {namespace import ::module::*} ? {::nsf::objectproperty ::o::Foo class} 1 - ? {::nsf::objectproperty ::o::foo object} 1 + ? {::nsf::isobject ::o::foo} 1 # do not destroy namespace imported objects/classes ::o destroy ? {::nsf::objectproperty ::o::Foo class} 0 - ? {::nsf::objectproperty ::o::foo object} 0 + ? {::nsf::isobject ::o::foo} 0 ? {::nsf::objectproperty ::module::Foo class} 1 - ? {::nsf::objectproperty ::module::foo object} 1 + ? {::nsf::isobject ::module::foo} 1 ::module destroy } @@ -583,28 +583,28 @@ C method foo {} { puts stderr "==== $::case [current]" namespace delete ::test - puts stderr "AAAA [current] exists [::nsf::objectproperty [current] object]" + puts stderr "AAAA [current] exists [::nsf::isobject [current]]" :set x 1 # # If the following line is commented in, the namespace is deleted # here. Is there a bug with nsPtr->activationCount # #? "[current] set x" 1 "$::case can still access [current]" puts stderr "BBB" - puts stderr "???? [current] exists [::nsf::objectproperty [current] object]" - ? "::nsf::objectproperty [current] object" 0 ;# WHY? - puts stderr "???? [current] exists [::nsf::objectproperty [current] object]" + puts stderr "???? [current] exists [::nsf::isobject [current]]" + ? "::nsf::isobject [current]" 0 ;# WHY? + puts stderr "???? [current] exists [::nsf::isobject [current]]" ? "set ::firstDestroy" 0 "firstDestroy called" ? "set ::ObjectDestroy" 0 "$::case destroy not yet called" } } test::C create test::c1 test::c1 foo -puts stderr ======[::nsf::objectproperty test::c1 object] -? {::nsf::objectproperty test::c1 object} 0 "object still exists after proc" +puts stderr ======[::nsf::isobject test::c1] +? {::nsf::isobject test::c1} 0 "object still exists after proc" ? "set ::firstDestroy" 1 "firstDestroy called" ? "set ::ObjectDestroy" 1 "destroy was called when poping stack frame" -? {::nsf::objectproperty ::test::C object} 0 "class still exists after proc" +? {::nsf::isobject ::test::C} 0 "class still exists after proc" ? {namespace exists ::test::C} 0 "namespace ::test::C still exists after proc" ? {namespace exists ::test} 1 "parent ::test namespace still exists after proc" ? {namespace exists ::xotcl::classes::test::C} 0 "namespace ::xotcl::classes::test::C still exists after proc"