package require XOTcl
xotcl::use xotcl1
#
# Basic tests of the object system, should not require Class Test,
# since even class Test might not work at that time.
#
proc ? {cmd expected {msg ""}} {
   #puts "??? $cmd"                 
   set r [uplevel $cmd]
   if {$msg eq ""} {set msg $cmd}
   if {$r ne $expected} {
     puts stderr "ERROR $msg returned '$r' ne '$expected'"
     error "FAILED $msg returned '$r' ne '$expected'"
   } else {
     puts stderr "OK $msg"
   }
}

? {Object isobject Object} 1
? {Object isclass} 1
? {Object ismetaclass} 0
? {Object info superclass} ""
? {Object info class} ::xotcl::Class

? {Object isobject Class} 1
? {Class isclass} 1
? {Class ismetaclass} 1
? {Class info superclass} ::xotcl::Object
? {Class info class} ::xotcl::Class

Object o
? {Object isobject o} 1
? {o isclass} 0
? {o ismetaclass} 0
? {o info class} ::xotcl::Object
? {Object info instances o} ::o
? {Object info instances ::o} ::o

Class C0
? {C0 isclass} 1
? {C0 ismetaclass} 0
? {C0 info superclass} ::xotcl::Object
? {C0 info class} ::xotcl::Class
#? {lsort [Class info vars]} "__default_metaclass __default_superclass"

Class M -superclass ::xotcl::Class
? {Object isobject M} 1
? {M isclass} 1
? {M ismetaclass} 1
? {M info superclass} ::xotcl::Class
? {M info class} ::xotcl::Class

M C
? {Object isobject C} 1
? {C isclass} 1
? {C ismetaclass} 0
? {C info superclass} ::xotcl::Object
? {C info class} ::M

C c1
? {Object isobject c1} 1
? {c1 isclass} 0
? {c1 ismetaclass} 0
? {c1 info class} ::C

# destroy meta-class M, reclass meta-class instances to the base meta-class
M destroy
? {Object isobject C} 1
? {C isclass} 1
? {C ismetaclass} 0
? {C info superclass} ::xotcl::Object
? {C info class} ::xotcl::Class

# destroy class M, reclass class instances to the base class
C destroy
? {Object isobject c1} 1
? {c1 isclass} 0
? {c1 ismetaclass} 0
? {c1 info class} ::xotcl::Object

# basic parameter tests

Class C -parameter {{x 1} {y 2}}
? {::xotcl::objectproperty C object} 1
? {::xotcl::objectproperty C::slot object} 1
? {C info children} ::C::slot


C copy X
? {::xotcl::objectproperty X object} 1
? {X info vars} ""
? {C info vars} ""
? {::xotcl::objectproperty X::slot object} 1

#? {C::slot info vars} __parameter
? {C info parameter} {{x 1} {y 2}}

#? {X::slot info vars} __parameter
? {X info parameter} {{x 1} {y 2}}

#
# tests for the dispatch command
 
Object o
o proc foo {} {return goo}
o proc bar {x} {return goo-$x}

# dispatch without colon names
::xotcl::dispatch o set x 1
? {o info vars} x "simple dispatch has set variable x"
? {o set x} 1 "simple dispatch has set variable x to 1"
? {::xotcl::dispatch o foo} "goo" "simple dispatch with one arg works"
? {::xotcl::dispatch o bar 1} "goo-1" "simple dispatch with two args works"
o destroy

# dispatch without colon names
Object o -set x 1
::xotcl::dispatch ::o ::incr x
? {o set x} 1 "cmd dispatch without -objscope did not modify the instance variable"
::xotcl::dispatch ::o -objscope ::incr x
? {o set x} 2 "cmd dispatch -objscope modifies the instance variable"
? {catch {::xotcl::dispatch ::o -objscope ::xxx x}} 1 "cmd dispatch with unknown command"
o destroy

puts stderr ===EXIT