# testing mixinof package require XOTcl; xotcl::use xotcl1 package require xotcl::test ########################################### # 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 transitive per object mixins ########################################### Class B Class C -superclass B Class M B instmixin M Object o -mixin C Object o1 -mixin B ? {C info mixinof} ::o ? {lsort [B info mixinof -closure]} "::o ::o1" ? {lsort [B info mixinof -closure ::o1]} "::o1" ? {lsort [B info mixinof -closure ::o*]} "::o ::o1" ? {lsort [C info mixinof -closure ::o*]} "::o" # A class is mixed into a per-object mixin class ? {lsort [M info mixinof -closure ::o*]} "::o ::o1" ? {lsort [M info mixinof]} "" M destroy B destroy C destroy ::o destroy ::o1 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 ########################################### Test case pcm 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 simple per class mixins with guards ########################################### Test case pcm2 Class M1 Class M2 Class X Class A -instmixin {M1 M2 X} A instmixinguard M1 "test" Class B -superclass A ? {A info instmixin M2} ::M2 ? {A info instmixin M*} "::M1 ::M2" ? {A info instmixin -guards} "{::M1 -guard test} ::M2 ::X" ? {B info instmixin} "" ? {B info instmixin -closure} "::M1 ::M2 ::X" ? {B info instmixin -closure M2} ::M2 ? {B info instmixin -closure M*} "::M1 ::M2" ? {B info instmixin -closure -guards} "{::M1 -guard test} ::M2 ::X" ? {B info instmixin -closure -guards M1} "{::M1 -guard test}" ? {B info instmixin -closure -guards M*} "{::M1 -guard test} ::M2" A destroy B destroy X destroy M1 destroy M2 destroy ########################################### # testing transitive per class mixins ########################################### Test case trans-pcm1 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 with subclasses ########################################### Test case trans-pcm2 Class X Class D Class C -superclass D Class A -instmixin C Class B -superclass A B b1 ? {C info instmixinof -closure} "::A ::B" ? {D info instmixinof -closure} "" ? {A info instmixinof -closure} "" ? {B info instmixinof -closure} "" ? {X info instmixinof -closure} "" D instmixin X ? {C info instmixinof -closure} "::A ::B" ? {D info instmixinof -closure} "" ? {A info instmixinof -closure} "" ? {B info instmixinof -closure} "" ? {X info instmixinof -closure} "::D ::C ::A ::B" ? {b1 info precedence} "::C ::X ::D ::B ::A ::xotcl::Object" B b2 ? {b2 info precedence} "::C ::X ::D ::B ::A ::xotcl::Object" foreach o {X D C A B b1 b2} {$o destroy} ########################################### # testing transitive per class mixins with subclasses ########################################### Test case trans-pcm3 Class A3 -superclass [Class A2 -superclass [Class A1]] Class B3 -superclass [Class B2 -superclass [Class B1 -superclass [Class B0]]] Class C3 -superclass [Class C2 -superclass [Class C1]] A2 instmixin B2 B1 instmixin C2 ? {A1 info instmixinof -closure} "" ? {A2 info instmixinof -closure} "" ? {A3 info instmixinof -closure} "" ? {B0 info instmixinof -closure} "" ? {B1 info instmixinof -closure} "" ? {B2 info instmixinof -closure} "::A2 ::A3" ? {B3 info instmixinof -closure} "" ? {C1 info instmixinof -closure} "" ? {C2 info instmixinof -closure} "::B1 ::B2 ::B3 ::A2 ::A3" ? {C3 info instmixinof -closure} "" foreach o {A1 A2 A3 B0 B1 B2 B3 C1 C2 C3} {$o destroy} ########################################### # testing transitive per class mixins with destroy ########################################### Test case pcm-trans-destroy-A 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 with destroy ########################################### Test case pcm-trans-destroy-B 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 ########################################### Test case pcm-redefine 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 ########################################### Test case pcm-redefine-soft ::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 ########################################### 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 ########################################### 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 ########################################### 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 ########################################### 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]] ::xotcl::use xotcl2x ########################################### # testing simple per object mixins ########################################### Test case xotcl2-mixinof { Class create M Class create A Class create C C create c1 -mixin A C create c2 Class create C2 -mixin A C2 create c22 ? {c1 mixin} ::A ? {c1 info mixin} ::A ? {lsort [A info mixinof]} "::C2 ::c1" ? {M info mixinof} "" C mixin M #? {M info mixinof -scope object} "::c1 ::c2" ? {M info mixinof -scope object} "" ? {M info mixinof -scope class} "::C" ? {M info mixinof -scope all} "::C" ? {M info mixinof} "::C" ? {lsort [A info mixinof]} "::C2 ::c1" ? {A info mixinof -scope object} "::c1" ? {A info mixinof -scope class} "::C2" c1 destroy ? {A info mixinof} "::C2" ? {M info mixinof} "::C" C destroy ? {M info mixinof} "" }