# testing mixinof
package require XOTcl
namespace import -force xotcl::*
package require xotcl::test

proc ? {cmd expected} {
  set t [Test new -cmd $cmd]
  $t expected $expected 
  $t run
}

###########################################
# testing simple per object mixins
###########################################
Class A
Object o -mixin A
? {o mixin} ::A
? {o info mixin} ::A
? {A info mixinof} ::o

o destroy
? {A info mixinof} ""

A destroy

###########################################
# testing per object mixins with redefinition
###########################################
Class M -instproc foo args {puts x;next}
Object o -mixin M 

? {o info mixin} ::M
? {o info precedence} "::M ::xotcl::Object"
? {o procsearch foo} "::M instproc foo"

Class M -instproc foo args next 
? {o info mixin} ::M
? {o info precedence} "::M ::xotcl::Object"
? {o procsearch foo} "::M instproc foo"

M destroy
? {o info mixin} ""
? {o info precedence} "::xotcl::Object"
? {o procsearch foo} ""

o destroy

###########################################
# testing simple per class mixins
###########################################
Class A
Class B -instmixin A
Class C -superclass B
C c1

? {B instmixin} ::A
? {B info instmixin} ::A
? {A info instmixinof} ::B
? {c1 info precedence} "::A ::C ::B ::xotcl::Object"

B destroy
? {A info instmixinof} ""
? {c1 info precedence} "::C ::xotcl::Object"

A destroy
C destroy 
c1 destroy

###########################################
# testing transitive per class mixins
###########################################
Class A
Class B -instmixin A
Class C -superclass B
A instmixin [Class M]

A a1
B b1
C c1

? {B instmixin} ::A
? {B info instmixin} ::A
? {A info instmixinof} ::B
? {a1 info precedence} "::M ::A ::xotcl::Object"
? {b1 info precedence} "::M ::A ::B ::xotcl::Object"
? {c1 info precedence} "::M ::A ::C ::B ::xotcl::Object"

? {M info instmixinof} "::A"
# since M is an instmixin of A and A is a instmixin of B,
# M is a instmixin of B as well, and of its subclasses
? {M info instmixinof -closure} "::A ::B ::C"
? {A info instmixinof} "::B"
? {A info instmixinof -closure} "::B ::C"
? {B info instmixinof} ""
? {B info instmixinof -closure} ""

# and now destroy mixin classes
M destroy
? {a1 info precedence} "::A ::xotcl::Object"
? {b1 info precedence} "::A ::B ::xotcl::Object"
? {c1 info precedence} "::A ::C ::B ::xotcl::Object"

B destroy
? {A info instmixinof} ""
? {c1 info precedence} "::C ::xotcl::Object"

foreach o {A C a1 b1 c1} { $o destroy }


###########################################
# testing transitive per class mixins (part 2)
###########################################
Class A -instmixin [Class M]
Class B -instmixin A
Class C -superclass B

A a1
B b1
C c1

? {B instmixin} ::A
? {B info instmixin} ::A
? {A info instmixinof} ::B
? {a1 info precedence} "::M ::A ::xotcl::Object"
? {b1 info precedence} "::M ::A ::B ::xotcl::Object"
? {c1 info precedence} "::M ::A ::C ::B ::xotcl::Object"

# and now destroy A
A destroy
? {a1 info precedence} "::xotcl::Object"
? {b1 info precedence} "::B ::xotcl::Object"
? {c1 info precedence} "::C ::B ::xotcl::Object"

? {M info instmixinof} ""
? {M info instmixinof -closure} ""


B destroy
? {M info instmixinof} ""
? {c1 info precedence} "::C ::xotcl::Object"

foreach o {M C a1 b1 c1} { $o destroy }

###########################################
# testing transitive per class mixins (part 3)
###########################################
Class A -instmixin [Class M]
Class B -instmixin A
Class C -superclass B

A a1
B b1
C c1

? {B instmixin} ::A
? {B info instmixin} ::A
? {A info instmixinof} ::B
? {a1 info precedence} "::M ::A ::xotcl::Object"
? {b1 info precedence} "::M ::A ::B ::xotcl::Object"
? {c1 info precedence} "::M ::A ::C ::B ::xotcl::Object"

B destroy
? {a1 info precedence} "::M ::A ::xotcl::Object"
? {b1 info precedence} "::xotcl::Object"
? {c1 info precedence} "::C ::xotcl::Object"

? {M info instmixinof} "::A"
? {M info instmixinof -closure} "::A"
? {A info instmixinof} ""

foreach o {M C a1 b1 c1} {
  $o destroy
}

###########################################
# testing simple per class mixins with redefinition
###########################################
Class A
Class B -instmixin A
Class C -superclass B
C c1

? {B instmixin} ::A
? {B info instmixin} ::A
? {A info instmixinof} ::B
? {c1 info precedence} "::A ::C ::B ::xotcl::Object"
? {B info heritage} "::xotcl::Object"
? {C info heritage} "::B ::xotcl::Object"

Class B -instmixin A

? {B info heritage} "::xotcl::Object"
? {C info heritage} "::xotcl::Object"
? {B instmixin} ::A
? {B info instmixin} ::A
? {A info instmixinof} ::B
? {c1 info precedence} "::C ::xotcl::Object"

B destroy
? {A info instmixinof} ""
? {c1 info precedence} "::C ::xotcl::Object"

A destroy
C destroy 
c1 destroy


###########################################
# testing simple per class mixins with 
# redefinition and softrecreate
###########################################
::xotcl::configure softrecreate true
Class A
Class B -instmixin A
Class C -superclass B
C c1

? {B instmixin} ::A
? {B info instmixin} ::A
? {A info instmixinof} ::B
? {c1 info precedence} "::A ::C ::B ::xotcl::Object"
? {C info heritage} "::B ::xotcl::Object"
? {B info heritage} "::xotcl::Object"

Class B -instmixin A
? {C info heritage} "::B ::xotcl::Object"
? {B info heritage} "::xotcl::Object"
? {B info instmixin} ::A
? {A info instmixinof} ::B
? {c1 info precedence} "::A ::C ::B ::xotcl::Object"

B destroy
? {A info instmixinof} ""
? {c1 info precedence} "::C ::xotcl::Object"

A destroy
C destroy 
c1 destroy


###########################################
# test of recreate with same superclass, 
# with softrecreate off
###########################################
::xotcl::test::case precedence
::xotcl::configure softrecreate false
Class O
Class A -superclass O
Class B -superclass A
B b1
A a1
O o1
? {A info superclass} "::O"
? {B info heritage} "::A ::O ::xotcl::Object"
? {list [A info subclass]   [B info subclass]   [O info subclass]}   "::B {} ::A"
? {list [A info superclass] [B info superclass] [O info superclass]} "::O ::A ::xotcl::Object"
? {list [a1 info class]     [b1 info class]     [o1 info class]}     "::A ::B ::O"
? {o1 info precedence} "::O ::xotcl::Object"
? {a1 info precedence} "::A ::O ::xotcl::Object"
? {b1 info precedence} "::B ::A ::O ::xotcl::Object"
# we recreate the class new, with the same superclass
Class A -superclass O
? {A info superclass} "::O"
? {B info heritage} "::xotcl::Object"
? {list [A info subclass]   [B info subclass]   [O info subclass]}   "{} {} ::A"
? {list [A info superclass] [B info superclass] [O info superclass]} "::O ::xotcl::Object ::xotcl::Object"
? {list [a1 info class]     [b1 info class]     [o1 info class]}     "::xotcl::Object ::B ::O"
? {o1 info precedence} "::O ::xotcl::Object"
? {a1 info precedence} "::xotcl::Object"
? {b1 info precedence} "::B ::xotcl::Object"
foreach o {A O B a1 b1 o1} {$o destroy} 

###########################################
# test of recreate with different superclass 
# with softrecreate on
###########################################
::xotcl::test::case alternate-precedence
::xotcl::configure softrecreate false
Class O
Class A -superclass O
Class B -superclass A
B b1
A a1
O o1
? {A info superclass} "::O"
? {B info heritage}   "::A ::O ::xotcl::Object"
? {list [A info subclass]   [B info subclass]   [O info subclass]}   "::B {} ::A"
? {list [A info superclass] [B info superclass] [O info superclass]} "::O ::A ::xotcl::Object"
? {list [a1 info class]     [b1 info class]     [o1 info class]}     "::A ::B ::O"
? {o1 info precedence} "::O ::xotcl::Object"
? {a1 info precedence} "::A ::O ::xotcl::Object"
? {b1 info precedence} "::B ::A ::O ::xotcl::Object"
# we recreate the class new, with a different superclass
Class A
? {A info superclass} "::xotcl::Object"
? {B info heritage}   "::xotcl::Object"
? {list [A info subclass]   [B info subclass]   [O info subclass]}   "{} {} {}"
? {list [A info superclass] [B info superclass] [O info superclass]} "::xotcl::Object ::xotcl::Object ::xotcl::Object"
? {list [a1 info class]     [b1 info class]     [o1 info class]}     "::xotcl::Object ::B ::O"
? {o1 info precedence} "::O ::xotcl::Object"
? {a1 info precedence} "::xotcl::Object"
? {b1 info precedence} "::B ::xotcl::Object"
foreach o {A O B a1 b1 o1} {$o destroy} 


###########################################
# test of recreate with same superclass, 
# with softrecreate on
###########################################
::xotcl::test::case recreate-precedence
::xotcl::configure softrecreate true
Class O
Class A -superclass O
Class B -superclass A
B b1
A a1
O o1
? {A info superclass} "::O"
? {B info heritage} "::A ::O ::xotcl::Object"
? {list [A info subclass]   [B info subclass]   [O info subclass]}   "::B {} ::A"
? {list [A info superclass] [B info superclass] [O info superclass]} "::O ::A ::xotcl::Object"
? {list [a1 info class]     [b1 info class]     [o1 info class]}     "::A ::B ::O"
? {o1 info precedence} "::O ::xotcl::Object"
? {a1 info precedence} "::A ::O ::xotcl::Object"
? {b1 info precedence} "::B ::A ::O ::xotcl::Object"
# we recreate the class new, with the same superclass
Class A -superclass O
? {A info superclass} "::O"
? {B info heritage} "::A ::O ::xotcl::Object"
? {list [A info subclass]   [B info subclass]   [O info subclass]}   "::B {} ::A"
? {list [A info superclass] [B info superclass] [O info superclass]} "::O ::A ::xotcl::Object"
? {list [a1 info class]     [b1 info class]     [o1 info class]}     "::A ::B ::O"
? {o1 info precedence} "::O ::xotcl::Object"
? {a1 info precedence} "::A ::O ::xotcl::Object"
? {b1 info precedence} "::B ::A ::O ::xotcl::Object"
foreach o {A O B a1 b1 o1} {$o destroy} 

###########################################
# test of recreate with different superclass 
# with softrecreate on
###########################################
::xotcl::test::case recreate-alternate-precedence
::xotcl::configure softrecreate true
Class O
Class A -superclass O
Class B -superclass A
B b1
A a1
O o1
? {B info heritage} "::A ::O ::xotcl::Object"
? {list [A info subclass]   [B info subclass]   [O info subclass]}   "::B {} ::A"
? {list [A info superclass] [B info superclass] [O info superclass]} "::O ::A ::xotcl::Object"
? {list [a1 info class]     [b1 info class]     [o1 info class]}     "::A ::B ::O"
? {o1 info precedence} "::O ::xotcl::Object"
? {a1 info precedence} "::A ::O ::xotcl::Object"
? {b1 info precedence} "::B ::A ::O ::xotcl::Object"
# we recreate the class new, with a different superclass
Class A
? {A info superclass} "::xotcl::Object"
? {B info heritage} "::A ::xotcl::Object"
? {B info heritage} "::A ::xotcl::Object"
? {list [A info subclass]   [B info subclass]   [O info subclass]}   "::B {} {}"
? {list [A info superclass] [B info superclass] [O info superclass]} "::xotcl::Object ::A ::xotcl::Object"
? {list [a1 info class]     [b1 info class]     [o1 info class]}     "::A ::B ::O"
? {o1 info precedence} "::O ::xotcl::Object"
? {a1 info precedence} "::A ::xotcl::Object"
? {b1 info precedence} "::B ::A ::xotcl::Object"
foreach o {A O B a1 b1 o1} {$o destroy} 




#foreach o [::xotcl::test::Test info instances] {$o destroy}
#::xotcl::test::Test destroy
#puts [lsort [::xotcl::Object allinstances]]