# -*- tcl -*-
# Copyright (c) 2001 by Jean-Luc Fontaine <jfontain@free.fr>.
# This code may be distributed under the same terms as Tcl.
#
# $Id: stooop.test,v 1.12 2006/10/09 15:23:06 andreas_kupries Exp $

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.3
testsNeedTcltest 1.0

testing {
    useLocal stooop.tcl stooop
}

# -------------------------------------------------------------------------

set source [localPath stooop.tcl]

# -------------------------------------------------------------------------

set dumpArraysCode {
    proc dumpArrays {args} {
        set list {}
        foreach array $args {
            upvar $array data
            foreach name [lsort [array names data]] {
                lappend list "$array\($name\) = $data($name)"
            }
        }
        return $list
    }
}

# -------------------------------------------------------------------------

test stooop-0 {
    check that the empty named array feature works
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        set (0) 0
        lappend ::result $(0)
        namespace eval n {
            variable {}
            set (1) 1
            lappend ::result $(1)
        }

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    0\
    1\
]

test stooop-1 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {new a} ::result
        set ::result
    }]
    interp delete $interpreter
    set result
} {invalid command name "a::a"}

test stooop-2 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            lappend ::result "a::a $this"
        }
        catch {delete [new a]} message
        lappend ::result $message

        class A {
            proc A {this} {
                lappend ::result "A::A $this"
            }
        }
        catch {delete [new A]} message
        lappend ::result $message

        class b::c {}
        proc b::c::c {this} {
            lappend ::result "c::c $this"
        }
        catch {delete [new b::c]} message
        lappend ::result $message

        class B {
            class C {
                proc C {this} {
                    lappend ::result "C::C $this"
                }
            }
            catch {delete [new C]} message
            lappend ::result $message
        }
        catch {delete [new B::C]} message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {invalid command name "::a::~a"}\
    {A::A 2}\
    {invalid command name "::A::~A"}\
    {c::c 3}\
    {invalid command name "::b::c::~c"}\
    {C::C 4}\
    {invalid command name "::B::C::~C"}\
    {C::C 5}\
    {invalid command name "::B::C::~C"}\
]

test stooop-3 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        catch {new a} message
        lappend ::result $message

        class b::c {}
        catch {new b::c} message
        lappend ::result $message

        class A {}
        catch {new A} message
        lappend ::result $message

        class B {
            class C {}
            catch {new C} message
            lappend ::result $message
        }
        catch {new B::C} message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {invalid command name "a::a"}\
    {invalid command name "b::c::c"}\
    {invalid command name "A::A"}\
    {invalid command name "C::C"}\
    {invalid command name "B::C::C"}\
]

test stooop-4 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p q} {
            lappend ::result "a::a $this"
            set ($this,m) $p
            set ($this,n) $q
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        set o [new a x {y z}]
        eval lappend ::result [dumpArrays a::]
        delete $o
        eval lappend ::result [dumpArrays a::]

        class A {
            proc A {this p q} {
                lappend ::result "A::A $this"
                set ($this,m) $p
                set ($this,n) $q
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        set o [new A x {y z}]
        eval lappend ::result [dumpArrays A::]
        delete $o
        eval lappend ::result [dumpArrays A::]

        class c::d {}
        proc c::d::d {this p q} {
            lappend ::result "d::d $this"
            set ($this,m) $p
            set ($this,n) $q
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        set o [new c::d x {y z}]
        eval lappend ::result [dumpArrays c::d::]
        delete $o
        eval lappend ::result [dumpArrays c::d::]

        class C {
            class D {
                proc D {this p q} {
                    lappend ::result "D::D $this"
                    set ($this,m) $p
                    set ($this,n) $q
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            set o [new D x {y z}]
            eval lappend ::result [dumpArrays D::]
            delete $o
            eval lappend ::result [dumpArrays D::]
        }
        set o [new C::D x {y z}]
        eval lappend ::result [dumpArrays C::D::]
        delete $o
        eval lappend ::result [dumpArrays C::D::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {a::(1,m) = x}\
    {a::(1,n) = y z}\
    {a::~a 1}\
    {A::A 2}\
    {A::(2,m) = x}\
    {A::(2,n) = y z}\
    {A::~A 2}\
    {d::d 3}\
    {c::d::(3,m) = x}\
    {c::d::(3,n) = y z}\
    {d::~d 3}\
    {D::D 4}\
    {D::(4,m) = x}\
    {D::(4,n) = y z}\
    {D::~D 4}\
    {D::D 5}\
    {C::D::(5,m) = x}\
    {C::D::(5,n) = y z}\
    {D::~D 5}\
]

test stooop-5 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class ::a {}
        class b::b {}
        set ::result {}
    }]
    interp delete $interpreter
    set result
} {}

test stooop-6 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p q} a {$p} {
            lappend ::result "b::b $this"
            set ($this,n) $q
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        set o [new b {x y} z]
        eval lappend ::result [dumpArrays a:: b::]
        delete $o
        eval lappend ::result [dumpArrays a:: b::]

        class A {
            proc A {this p} {
                lappend ::result "A::A $this"
                set ($this,m) $p
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p q} A {$p} {
                lappend ::result "B::B $this"
                set ($this,n) $q
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        set o [new B {x y} z]
        eval lappend ::result [dumpArrays A:: B::]
        delete $o
        eval lappend ::result [dumpArrays A:: B::]

        class c::d {}
        proc c::d::d {this p} {
            lappend ::result "d::d $this"
            set ($this,m) $p
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class c::e {}
        proc c::e::e {this p q} c::d {$p} {
            lappend ::result "e::e $this"
            set ($this,n) $q
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        set o [new c::e {x y} z]
        eval lappend ::result [dumpArrays c::d:: c::e::]
        delete $o
        eval lappend ::result [dumpArrays c::d:: c::e::]

        class C {
            class D {
                proc D {this p} {
                    lappend ::result "D::D $this"
                    set ($this,m) $p
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this p q} C::D {$p} {
                    lappend ::result "E::E $this"
                    set ($this,n) $q
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
        }
        set o [new C::E {x y} z]
        eval lappend ::result [dumpArrays C::D:: C::E::]
        delete $o
        eval lappend ::result [dumpArrays C::D:: C::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = x y}\
    {b::(1,n) = z}\
    {b::~b 1}\
    {a::~a 1}\
    {A::A 2}\
    {B::B 2}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = x y}\
    {B::(2,n) = z}\
    {B::~B 2}\
    {A::~A 2}\
    {d::d 3}\
    {e::e 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = x y}\
    {c::e::(3,n) = z}\
    {e::~e 3}\
    {d::~d 3}\
    {D::D 4}\
    {E::E 4}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = x y}\
    {C::E::(4,n) = z}\
    {E::~E 4}\
    {D::~D 4}\
]

test stooop-7 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        class b {}
        proc b::b {this} a {} {}
        class c {}
        proc c::c {this} b {} a {} {}
        lappend ::result [classof [new a]]
        lappend ::result [classof [new b]]
        lappend ::result [classof [new c]]

        class A {
            proc A {this} {}
        }
        class B {
            proc B {this} A {} {}
        }
        class C {
            proc C {this} B {} A {} {}
        }
        lappend ::result [classof [new A]]
        lappend ::result [classof [new B]]
        lappend ::result [classof [new C]]

        class d::e {}
        proc d::e::e {this} {}
        class d::f {}
        proc d::f::f {this} d::e {} {}
        class d::g {}
        proc d::g::g {this} d::f {} d::e {} {}
        lappend ::result [classof [new d::e]]
        lappend ::result [classof [new d::f]]
        lappend ::result [classof [new d::g]]

        class D {
            class E {
                proc E {this} {}
            }
            class F {
                proc F {this} D::E {} {}
            }
            class G {
                proc G {this} D::F {} D::E {} {}
            }
            lappend ::result [classof [new E]]
            lappend ::result [classof [new F]]
            lappend ::result [classof [new G]]
        }
        lappend ::result [classof [new D::E]]
        lappend ::result [classof [new D::F]]
        lappend ::result [classof [new D::G]]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    ::a\
    ::b\
    ::c\
    ::A\
    ::B\
    ::C\
    ::d::e\
    ::d::f\
    ::d::g\
    ::D::E\
    ::D::F\
    ::D::G\
    ::D::E\
    ::D::F\
    ::D::G\
]

test stooop-8 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            lappend ::result "a::a $this"
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this} a {} {
            lappend ::result "b::b $this"
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class c {}
        proc c::c {this} b {} {
            lappend ::result "c::c $this"
        }
        proc c::~c {this} {
            lappend ::result "c::~c $this"
        }
        delete [new a]
        delete [new b]
        delete [new c]

        class A {
            proc A {this} {
                lappend ::result "A::A $this"
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this} A {} {
                lappend ::result "B::B $this"
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        class C {
            proc C {this} B {} {
                lappend ::result "C::C $this"
            }
            proc ~C {this} {
                lappend ::result "C::~C $this"
            }
        }
        delete [new A]
        delete [new B]
        delete [new C]

        class d::e {}
        proc d::e::e {this} {
            lappend ::result "e::e $this"
        }
        proc d::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        class d::f {}
        proc d::f::f {this} d::e {} {
            lappend ::result "f::f $this"
        }
        proc d::f::~f {this} {
            lappend ::result "f::~f $this"
        }
        class d::g {}
        proc d::g::g {this} d::f {} {
            lappend ::result "g::g $this"
        }
        proc d::g::~g {this} {
            lappend ::result "g::~g $this"
        }
        delete [new d::e]
        delete [new d::f]
        delete [new d::g]

        class D {
            class E {
                proc E {this} {
                    lappend ::result "E::E $this"
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            class F {
                proc F {this} D::E {} {
                    lappend ::result "F::F $this"
                }
                proc ~F {this} {
                    lappend ::result "F::~F $this"
                }
            }
            class G {
                proc G {this} D::F {} {
                    lappend ::result "G::G $this"
                }
                proc ~G {this} {
                    lappend ::result "G::~G $this"
                }
            }
            delete [new E]
            delete [new F]
            delete [new G]
        }
        delete [new D::E]
        delete [new D::F]
        delete [new D::G]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {a::~a 1}\
    {a::a 2}\
    {b::b 2}\
    {b::~b 2}\
    {a::~a 2}\
    {a::a 3}\
    {b::b 3}\
    {c::c 3}\
    {c::~c 3}\
    {b::~b 3}\
    {a::~a 3}\
    {A::A 4}\
    {A::~A 4}\
    {A::A 5}\
    {B::B 5}\
    {B::~B 5}\
    {A::~A 5}\
    {A::A 6}\
    {B::B 6}\
    {C::C 6}\
    {C::~C 6}\
    {B::~B 6}\
    {A::~A 6}\
    {e::e 7}\
    {e::~e 7}\
    {e::e 8}\
    {f::f 8}\
    {f::~f 8}\
    {e::~e 8}\
    {e::e 9}\
    {f::f 9}\
    {g::g 9}\
    {g::~g 9}\
    {f::~f 9}\
    {e::~e 9}\
    {E::E 10}\
    {E::~E 10}\
    {E::E 11}\
    {F::F 11}\
    {F::~F 11}\
    {E::~E 11}\
    {E::E 12}\
    {F::F 12}\
    {G::G 12}\
    {G::~G 12}\
    {F::~F 12}\
    {E::~E 12}\
    {E::E 13}\
    {E::~E 13}\
    {E::E 14}\
    {F::F 14}\
    {F::~F 14}\
    {E::~E 14}\
    {E::E 15}\
    {F::F 15}\
    {G::G 15}\
    {G::~G 15}\
    {F::~F 15}\
    {E::~E 15}\
]

test stooop-9 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this} {}
            proc a::~a {this p} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
                proc ~A {this p} {}
            }
        } message
        lappend ::result $message

        catch {
            class b::c {}
            proc b::c::c {this} {}
            proc b::c::~c {this p} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc C {this} {}
                    proc ~C {this p} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a destructor must have 1 argument exactly}\
    {class ::A destructor must have 1 argument exactly}\
    {class ::b::c destructor must have 1 argument exactly}\
    {class ::B::C destructor must have 1 argument exactly}\
]

test stooop-10 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this} {}
            virtual proc a::~a {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
                virtual proc ~A {this} {}
            }
        } message
        lappend ::result $message

        catch {
            class b::c {}
            proc b::c::c {this} {}
            virtual proc b::c::~c {this} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc C {this} {}
                    virtual proc ~C {this} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {cannot make class ::a destructor virtual}\
    {cannot make class ::A destructor virtual}\
    {cannot make class ::b::c destructor virtual}\
    {cannot make class ::B::C destructor virtual}\
]

test stooop-11 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            lappend ::result "a::a $this"
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        virtual proc a::f {this p q} {}
        virtual proc a::g {this p q}
        virtual proc a::h {this p q} {
            lappend ::result "a::h $this $p $q"
        }
        virtual proc a::i {this p q}
        class b {}
        proc b::b {this} a {} {
            lappend ::result "b::b $this"
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        virtual proc b::f {this p q} {
            lappend ::result "b::f $this $p $q"
        }
        virtual proc b::g {this p q} {
            lappend ::result "b::g $this $p $q"
        }
        set o [new b]
        a::f $o x {y z}
        a::g $o x {y z}
        a::h $o x {y z}
        catch {a::i $o x {y z}} message
        lappend ::result $message

        class A {
            proc A {this} {
                lappend ::result "A::A $this"
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
            virtual proc f {this p q} {}
            virtual proc g {this p q}
            virtual proc h {this p q} {
                lappend ::result "A::h $this $p $q"
            }
            virtual proc i {this p q}
        }
        class B {
            proc B {this} A {} {
                lappend ::result "B::B $this"
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
            virtual proc f {this p q} {
                lappend ::result "B::f $this $p $q"
            }
            virtual proc g {this p q} {
                lappend ::result "B::g $this $p $q"
            }
        }
        set o [new B]
        A::f $o x {y z}
        A::g $o x {y z}
        A::h $o x {y z}
        catch {A::i $o x {y z}} message
        lappend ::result $message

        class c::d {}
        proc c::d::d {this} {
            lappend ::result "d::d $this"
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        virtual proc c::d::f {this p q} {}
        virtual proc c::d::g {this p q}
        virtual proc c::d::h {this p q} {
            lappend ::result "d::h $this $p $q"
        }
        virtual proc c::d::i {this p q}
        class c::e {}
        proc c::e::e {this} c::d {} {
            lappend ::result "e::e $this"
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        virtual proc c::e::f {this p q} {
            lappend ::result "e::f $this $p $q"
        }
        virtual proc c::e::g {this p q} {
            lappend ::result "e::g $this $p $q"
        }
        set o [new c::e]
        c::d::f $o x {y z}
        c::d::g $o x {y z}
        c::d::h $o x {y z}
        catch {c::d::i $o x {y z}} message
        lappend ::result $message

        class C {
            class D {
                proc D {this} {
                    lappend ::result "D::D $this"
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
                virtual proc f {this p q} {}
                virtual proc g {this p q}
                virtual proc h {this p q} {
                    lappend ::result "D::h $this $p $q"
                }
                virtual proc i {this p q}
            }
            class E {
                proc E {this} C::D {} {
                    lappend ::result "E::E $this"
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
                virtual proc f {this p q} {
                    lappend ::result "E::f $this $p $q"
                }
                virtual proc g {this p q} {
                    lappend ::result "E::g $this $p $q"
                }
            }
            set o [new E]
            D::f $o x {y z}
            D::g $o x {y z}
            D::h $o x {y z}
            catch {D::i $o x {y z}} message
            lappend ::result $message
        }
        set o [new C::E]
        C::D::f $o x {y z}
        C::D::g $o x {y z}
        C::D::h $o x {y z}
        catch {C::D::i $o x {y z}} message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {b::f 1 x y z}\
    {b::g 1 x y z}\
    {a::h 1 x y z}\
    {invalid command name "::b::i"}\
    {A::A 2}\
    {B::B 2}\
    {B::f 2 x y z}\
    {B::g 2 x y z}\
    {A::h 2 x y z}\
    {invalid command name "::B::i"}\
    {d::d 3}\
    {e::e 3}\
    {e::f 3 x y z}\
    {e::g 3 x y z}\
    {d::h 3 x y z}\
    {invalid command name "::c::e::i"}\
    {D::D 4}\
    {E::E 4}\
    {E::f 4 x y z}\
    {E::g 4 x y z}\
    {D::h 4 x y z}\
    {invalid command name "::C::E::i"}\
    {D::D 5}\
    {E::E 5}\
    {E::f 5 x y z}\
    {E::g 5 x y z}\
    {D::h 5 x y z}\
    {invalid command name "::C::E::i"}\
]

test stooop-12 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            virtual proc a::a {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                virtual proc A {this} {}
            }
        } message
        lappend ::result $message

        catch {
            class b::c {}
            virtual proc b::c::c {this} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    virtual proc C {this} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {cannot make class ::a constructor virtual}\
    {cannot make class ::A constructor virtual}\
    {cannot make class ::b::c constructor virtual}\
    {cannot make class ::B::C constructor virtual}\
]

test stooop-13 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::~a {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc ~A {this} {}
            }
        } message
        lappend ::result $message

        catch {
            class b::c {}
            proc b::c::~c {this} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc ~C {this} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a destructor defined before constructor}\
    {class ::A destructor defined before constructor}\
    {class ::b::c destructor defined before constructor}\
    {class ::B::C destructor defined before constructor}\
]

test stooop-14 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        catch {
            class b {}
            proc b::b {this} a {} {}
        } message
        lappend ::result $message

        class A {}
        catch {
            class B {
                proc B {this} A {} {}
            }
        } message
        lappend ::result $message

        class b::c {}
        catch {
            class b::d {}
            proc b::d::d {this} b::c {} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {}
                class D {
                    proc D {this} C {} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::b constructor defined before base class a constructor}\
    {class ::B constructor defined before base class A constructor}\
    {class ::b::d constructor defined before base class b::c constructor}\
    {class ::B::D constructor defined before base class C constructor}\
]

test stooop-15 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            virtual a::f {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                virtual f {this} {}
            }
        } message
        lappend ::result $message

        catch {
            class b::c {}
            virtual b::c::f {this} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    virtual f {this} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {virtual operator works only on proc, not a::f}\
    {virtual operator works only on proc, not f}\
    {virtual operator works only on proc, not b::c::f}\
    {virtual operator works only on proc, not f}\
]

test stooop-16 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            virtual proc f {} {}
        } message
        lappend ::result $message

        catch {
            virtual proc a::f {} {}
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {procedure ::f class name is empty}\
    {procedure ::a::f class ::a is unknown}\
]

test stooop-17 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::f {this}
        } message
        lappend ::result $message

        catch {
            class A {
                proc f {this}
            }
        } message
        lappend ::result $message

        catch {
            class b::c {}
            proc b::c::f {this}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc f {this}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {missing body for ::a::f}\
    {missing body for ::A::f}\
    {missing body for ::b::c::f}\
    {missing body for ::B::C::f}\
]

test stooop-18 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class b {}
            proc b::b {this} a {}
        } message
        lappend ::result $message

        catch {
            class B {
                proc B {this} A {}
            }
        } message
        lappend ::result $message

        catch {
            class c::e {}
            proc c::e::e {this} d {}
        } message
        lappend ::result $message

        catch {
            class C {
                class E {
                    proc E {this} D {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {bad class ::b constructor declaration, a base class, contructor arguments or body may be missing}\
    {bad class ::B constructor declaration, a base class, contructor arguments or body may be missing}\
    {bad class ::c::e constructor declaration, a base class, contructor arguments or body may be missing}\
    {bad class ::C::E constructor declaration, a base class, contructor arguments or body may be missing}\
]

test stooop-19 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class b {}
            proc b::b {this} b {} {}
        } message
        lappend ::result $message

        catch {
            class B {
                proc B {this} B {} {}
            }
        } message
        lappend ::result $message

        catch {
            class c::d {}
            proc c::d::d {this} c::d {} {}
        } message
        lappend ::result $message

        catch {
            class C {
                class D {
                    proc D {this} D {} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::b cannot be derived from itself}\
    {class ::B cannot be derived from itself}\
    {class ::c::d cannot be derived from itself}\
    {class ::C::D cannot be derived from itself}\
]

test stooop-20 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::~a {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc ~A {this} {}
            }
        } message
        lappend ::result $message

        catch {
            class a {}
            proc a::a {this} {}
            class a::b {}
            proc a::b::~b {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
                class B {
                    proc ~B {this} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a destructor defined before constructor}\
    {class ::A destructor defined before constructor}\
    {class ::a::b destructor defined before constructor}\
    {class ::A::B destructor defined before constructor}\
]

test stooop-21 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {p} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {p} {}
            }
        } message
        lappend ::result $message

        catch {
            class a {}
            proc a::a {this} {}
            class a::b {}
            proc a::b::b {p} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
                class B {
                    proc B {p} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a constructor first argument must be this}\
    {class ::A constructor first argument must be this}\
    {class ::a::b constructor first argument must be this}\
    {class ::A::B constructor first argument must be this}\
]

test stooop-22 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::~a {p} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc ~A {p} {}
            }
        } message
        lappend ::result $message

        catch {
            class a {}
            proc a::a {this} {}
            class a::b {}
            proc a::b::~b {p} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
                class B {
                    proc ~B {p} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a destructor argument must be this}\
    {class ::A destructor argument must be this}\
    {class ::a::b destructor argument must be this}\
    {class ::A::B destructor argument must be this}\
]

test stooop-23 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            virtual proc a::f {p} {}
        } message
        lappend ::result $message

        catch {
            class A {
                virtual proc f {p} {}
            }
        } message
        lappend ::result $message

        catch {
            class a {}
            proc a::a {this} {}
            class a::b {}
            virtual proc a::b::f {p} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
                class B {
                    virtual proc f {p} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {cannot make static procedure f of class ::a virtual}\
    {cannot make static procedure f of class ::A virtual}\
    {cannot make static procedure f of class ::a::b virtual}\
    {cannot make static procedure f of class ::A::B virtual}\
]

test stooop-24 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p args} {
            lappend ::result "a::a $this $p $args"
            set ($this,m) [lindex $args 0]
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p args} a {$p $args} {
            lappend ::result "b::b $this $p $args"
            set ($this,n) [lindex $args 0]
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        new b {x y} {1 2} 3
        eval lappend ::result [dumpArrays a:: b::]

        class A {
            proc A {this p args} {
                lappend ::result "A::A $this $p $args"
                set ($this,m) [lindex $args 0]
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p args} A {$p $args} {
                lappend ::result "B::B $this $p $args"
                set ($this,n) [lindex $args 0]
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        new B {x y} {1 2} 3
        eval lappend ::result [dumpArrays A:: B::]

        class c {}
        class c::d {}
        proc c::d::d {this p args} {
            lappend ::result "d::d $this $p $args"
            set ($this,m) [lindex $args 0]
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class c::e {}
        proc c::e::e {this p args} c::d {$p $args} {
            lappend ::result "e::e $this $p $args"
            set ($this,n) [lindex $args 0]
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        new c::e {x y} {1 2} 3
        eval lappend ::result [dumpArrays c::d:: c::e::]

        class C {
            class D {
                proc D {this p args} {
                    lappend ::result "D::D $this $p $args"
                    set ($this,m) [lindex $args 0]
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this p args} C::D {$p $args} {
                    lappend ::result "E::E $this $p $args"
                    set ($this,n) [lindex $args 0]
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            new E {x y} {1 2} 3
            eval lappend ::result [dumpArrays D:: E::]
        }
        new C::E {x y} {1 2} 3
        eval lappend ::result [dumpArrays C::D:: C::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 x y {1 2} 3}\
    {b::b 1 x y {1 2} 3}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = 1 2}\
    {b::(1,n) = 1 2}\
    {A::A 2 x y {1 2} 3}\
    {B::B 2 x y {1 2} 3}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = 1 2}\
    {B::(2,n) = 1 2}\
    {d::d 3 x y {1 2} 3}\
    {e::e 3 x y {1 2} 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = 1 2}\
    {c::e::(3,n) = 1 2}\
    {D::D 4 x y {1 2} 3}\
    {E::E 4 x y {1 2} 3}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = 1 2}\
    {E::(4,n) = 1 2}\
    {D::D 5 x y {1 2} 3}\
    {E::E 5 x y {1 2} 3}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = 1 2}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = 1 2}\
    {C::E::(4,n) = 1 2}\
    {C::E::(5,n) = 1 2}\
]

test stooop-25 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            lappend ::result "a::a $this"
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        virtual proc a::f {this p args} {}
        proc a::g {this p args} {
            lappend ::result "a::g $this $p $args"
        }
        class b {}
        proc b::b {this} a {} {
            lappend ::result "b::b $this"
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        virtual proc b::f {this p args} {
            lappend ::result "b::f $this $p $args"
        }
        set o [new b]
        a::f $o {x y} {1 2} 3
        a::g $o {x y} {1 2} 3

        class A {
            proc A {this} {
                lappend ::result "A::A $this"
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
            virtual proc f {this p args} {}
            proc g {this p args} {
                lappend ::result "A::g $this $p $args"
            }
        }
        class B {
            proc B {this} A {} {
                lappend ::result "B::B $this"
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
            virtual proc f {this p args} {
                lappend ::result "B::f $this $p $args"
            }
        }
        set o [new B]
        A::f $o {x y} {1 2} 3
        A::g $o {x y} {1 2} 3

        class c {}
        class c::d {}
        proc c::d::d {this} {
            lappend ::result "d::d $this"
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        virtual proc c::d::f {this p args} {}
        proc c::d::g {this p args} {
            lappend ::result "d::g $this $p $args"
        }
        class c::e {}
        proc c::e::e {this} c::d {} {
            lappend ::result "e::e $this"
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        virtual proc c::e::f {this p args} {
            lappend ::result "e::f $this $p $args"
        }
        set o [new c::e]
        c::d::f $o {x y} {1 2} 3
        c::d::g $o {x y} {1 2} 3

        class C {
            class D {
                proc D {this} {
                    lappend ::result "D::D $this"
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
                virtual proc f {this p args} {}
                proc g {this p args} {
                    lappend ::result "D::g $this $p $args"
                }
            }
            class B {
                proc B {this} C::D {} {
                    lappend ::result "B::B $this"
                }
                proc ~B {this} {
                    lappend ::result "B::~B $this"
                }
                virtual proc f {this p args} {
                    lappend ::result "B::f $this $p $args"
                }
            }
            set o [new B]
            D::f $o {x y} {1 2} 3
            D::g $o {x y} {1 2} 3
        }
        set o [new C::B]
        C::D::f $o {x y} {1 2} 3
        C::D::g $o {x y} {1 2} 3

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {b::f 1 x y {1 2} 3}\
    {a::g 1 x y {1 2} 3}\
    {A::A 2}\
    {B::B 2}\
    {B::f 2 x y {1 2} 3}\
    {A::g 2 x y {1 2} 3}\
    {d::d 3}\
    {e::e 3}\
    {e::f 3 x y {1 2} 3}\
    {d::g 3 x y {1 2} 3}\
    {D::D 4}\
    {B::B 4}\
    {B::f 4 x y {1 2} 3}\
    {D::g 4 x y {1 2} 3}\
    {D::D 5}\
    {B::B 5}\
    {B::f 5 x y {1 2} 3}\
    {D::g 5 x y {1 2} 3}\
]

test stooop-26 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p q args} {
            lappend ::result "a::a $this $p $q $args"
            set ($this,m) [lindex $args 0]
            set ($this,p) $p
            set ($this,q) $q
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p q args} a {$p $q $args} {
            lappend ::result "b::b $this $p $q $args"
            set ($this,n) [lindex $args 0]
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        new b {x y} {X Y} {1 2} 3
        eval lappend ::result [dumpArrays a:: b::]

        class A {
            proc A {this p q args} {
                lappend ::result "A::A $this $p $q $args"
                set ($this,m) [lindex $args 0]
                set ($this,p) $p
                set ($this,q) $q
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p q args} A {$p $q $args} {
                lappend ::result "B::B $this $p $q $args"
                set ($this,n) [lindex $args 0]
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        new B {x y} {X Y} {1 2} 3
        eval lappend ::result [dumpArrays A:: B::]

        class c {}
        class c::d {}
        proc c::d::d {this p q args} {
            lappend ::result "d::d $this $p $q $args"
            set ($this,m) [lindex $args 0]
            set ($this,p) $p
            set ($this,q) $q
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class c::e {}
        proc c::e::e {this p q args} c::d {$p $q $args} {
            lappend ::result "e::e $this $p $q $args"
            set ($this,n) [lindex $args 0]
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        new c::e {x y} {X Y} {1 2} 3
        eval lappend ::result [dumpArrays c::d:: c::e::]

        class C {
            class D {
                proc D {this p q args} {
                    lappend ::result "D::D $this $p $q $args"
                    set ($this,m) [lindex $args 0]
                    set ($this,p) $p
                    set ($this,q) $q
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this p q args} C::D {$p $q $args} {
                    lappend ::result "E::E $this $p $q $args"
                    set ($this,n) [lindex $args 0]
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            new E {x y} {X Y} {1 2} 3
            eval lappend ::result [dumpArrays D:: E::]
        }
        new C::E {x y} {X Y} {1 2} 3
        eval lappend ::result [dumpArrays C::D:: C::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 x y X Y {1 2} 3}\
    {b::b 1 x y X Y {1 2} 3}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = 1 2}\
    {a::(1,p) = x y}\
    {a::(1,q) = X Y}\
    {b::(1,n) = 1 2}\
    {A::A 2 x y X Y {1 2} 3}\
    {B::B 2 x y X Y {1 2} 3}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = 1 2}\
    {A::(2,p) = x y}\
    {A::(2,q) = X Y}\
    {B::(2,n) = 1 2}\
    {d::d 3 x y X Y {1 2} 3}\
    {e::e 3 x y X Y {1 2} 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = 1 2}\
    {c::d::(3,p) = x y}\
    {c::d::(3,q) = X Y}\
    {c::e::(3,n) = 1 2}\
    {D::D 4 x y X Y {1 2} 3}\
    {E::E 4 x y X Y {1 2} 3}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = 1 2}\
    {D::(4,p) = x y}\
    {D::(4,q) = X Y}\
    {E::(4,n) = 1 2}\
    {D::D 5 x y X Y {1 2} 3}\
    {E::E 5 x y X Y {1 2} 3}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = 1 2}\
    {C::D::(4,p) = x y}\
    {C::D::(4,q) = X Y}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = 1 2}\
    {C::D::(5,p) = x y}\
    {C::D::(5,q) = X Y}\
    {C::E::(4,n) = 1 2}\
    {C::E::(5,n) = 1 2}\
]

test stooop-27 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this args} {
            lappend ::result "a::a $this $args"
            set ($this,m) [lindex $args 0]
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p args} a {$args} {
            lappend ::result "b::b $this $p $args"
            set ($this,n) [lindex $args 0]
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        new b {x y} {1 2} 3
        eval lappend ::result [dumpArrays a:: b::]

        class A {
            proc A {this args} {
                lappend ::result "A::A $this $args"
                set ($this,m) [lindex $args 0]
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p args} A {$args} {
                lappend ::result "B::B $this $p $args"
                set ($this,n) [lindex $args 0]
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        new B {x y} {1 2} 3
        eval lappend ::result [dumpArrays A:: B::]

        class c {}
        class c::d {}
        proc c::d::d {this args} {
            lappend ::result "d::d $this $args"
            set ($this,m) [lindex $args 0]
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class c::e {}
        proc c::e::e {this p args} c::d {$args} {
            lappend ::result "e::e $this $p $args"
            set ($this,n) [lindex $args 0]
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        new c::e {x y} {1 2} 3
        eval lappend ::result [dumpArrays c::d:: c::e::]

        class C {
            class D {
                proc D {this args} {
                    lappend ::result "D::D $this $args"
                    set ($this,m) [lindex $args 0]
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this p args} C::D {$args} {
                    lappend ::result "E::E $this $p $args"
                    set ($this,n) [lindex $args 0]
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            new E {x y} {1 2} 3
            eval lappend ::result [dumpArrays D:: E::]
        }
        new C::E {x y} {1 2} 3
        eval lappend ::result [dumpArrays C::D:: C::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 {1 2} 3}\
    {b::b 1 x y {1 2} 3}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = 1 2}\
    {b::(1,n) = 1 2}\
    {A::A 2 {1 2} 3}\
    {B::B 2 x y {1 2} 3}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = 1 2}\
    {B::(2,n) = 1 2}\
    {d::d 3 {1 2} 3}\
    {e::e 3 x y {1 2} 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = 1 2}\
    {c::e::(3,n) = 1 2}\
    {D::D 4 {1 2} 3}\
    {E::E 4 x y {1 2} 3}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = 1 2}\
    {E::(4,n) = 1 2}\
    {D::D 5 {1 2} 3}\
    {E::E 5 x y {1 2} 3}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = 1 2}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = 1 2}\
    {C::E::(4,n) = 1 2}\
    {C::E::(5,n) = 1 2}\
]

test stooop-28 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this args} {
            lappend ::result "a::a $this $args"
            set ($this,m) [lindex $args 0]
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this args} a {$args} {
            lappend ::result "b::b $this $args"
            set ($this,n) [lindex $args 0]
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        new b {1 2} 3
        eval lappend ::result [dumpArrays a:: b::]

        class A {
            proc A {this args} {
                lappend ::result "A::A $this $args"
                set ($this,m) [lindex $args 0]
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this args} A {$args} {
                lappend ::result "B::B $this $args"
                set ($this,n) [lindex $args 0]
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        new B {1 2} 3
        eval lappend ::result [dumpArrays A:: B::]

        class c {}
        class c::d {}
        proc c::d::d {this args} {
            lappend ::result "d::d $this $args"
            set ($this,m) [lindex $args 0]
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class c::e {}
        proc c::e::e {this args} c::d {$args} {
            lappend ::result "e::e $this $args"
            set ($this,n) [lindex $args 0]
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        new c::e {1 2} 3
        eval lappend ::result [dumpArrays c::d:: c::e::]

        class C {
            class D {
                proc D {this args} {
                    lappend ::result "D::D $this $args"
                    set ($this,m) [lindex $args 0]
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this args} C::D {$args} {
                    lappend ::result "E::E $this $args"
                    set ($this,n) [lindex $args 0]
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            new E {1 2} 3
            eval lappend ::result [dumpArrays D:: E::]
        }
        new C::E {1 2} 3
        eval lappend ::result [dumpArrays C::D:: C::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 {1 2} 3}\
    {b::b 1 {1 2} 3}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = 1 2}\
    {b::(1,n) = 1 2}\
    {A::A 2 {1 2} 3}\
    {B::B 2 {1 2} 3}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = 1 2}\
    {B::(2,n) = 1 2}\
    {d::d 3 {1 2} 3}\
    {e::e 3 {1 2} 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = 1 2}\
    {c::e::(3,n) = 1 2}\
    {D::D 4 {1 2} 3}\
    {E::E 4 {1 2} 3}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = 1 2}\
    {E::(4,n) = 1 2}\
    {D::D 5 {1 2} 3}\
    {E::E 5 {1 2} 3}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = 1 2}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = 1 2}\
    {C::E::(4,n) = 1 2}\
    {C::E::(5,n) = 1 2}\
]

test stooop-29 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this p q} {
            lappend ::result "a::a $this $p $q"
        }
        proc a::~a {this} {}
        class b {}
        proc b::b {this p q} a {
            $p $q
        } {
            lappend ::result "b::b $this $p $q"
        }
        proc b::~b {this} {}
        new b {x y} z

        class A {
            proc A {this p q} {
                lappend ::result "A::A $this $p $q"
            }
            proc ~A {this} {}
        }
        class B {
            proc B {this p q} A {
                $p $q
            } {
                lappend ::result "B::B $this $p $q"
            }
            proc ~B {this} {}
        }
        new B {x y} z

        class c {}
        class c::d {}
        proc c::d::d {this p q} {
            lappend ::result "d::d $this $p $q"
        }
        proc c::d::~d {this} {}
        class c::e {}
        proc c::e::e {this p q} c::d {
            $p $q
        } {
            lappend ::result "e::e $this $p $q"
        }
        proc c::e::~e {this} {}
        new c::e {x y} z

        class C {
            class D {
                proc D {this p q} {
                    lappend ::result "D::D $this $p $q"
                }
                proc ~D {this} {}
            }
            class E {
                proc E {this p q} C::D {
                    $p $q
                } {
                    lappend ::result "E::E $this $p $q"
                }
                proc ~E {this} {}
            }
            new E {x y} z
        }
        new C::E {x y} z

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 x y z}\
    {b::b 1 x y z}\
    {A::A 2 x y z}\
    {B::B 2 x y z}\
    {d::d 3 x y z}\
    {e::e 3 x y z}\
    {D::D 4 x y z}\
    {E::E 4 x y z}\
    {D::D 5 x y z}\
    {E::E 5 x y z}\
]

test stooop-30 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            lappend ::result "a::a $this"
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        virtual proc a::f {this p q} {
            lappend ::result "a::h $this $p $q"
        }
        virtual proc a::g {this p args} {
            lappend ::result "a::g $this $p $args"
        }
        class b {}
        proc b::b {this} a {} {
            lappend ::result "b::b $this"
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        proc b::f {this p q} {
            lappend ::result "b::f $this $p $q"
            a::_f $this $p $q
        }
        proc b::g {this p args} {
            lappend ::result "b::g $this $p $args"
            eval a::_g $this $p $args
        }
        set o [new b]
        a::f $o x {y z}
        a::g $o {x y} {1 2} 3 {4 5}

        class A {
            proc A {this} {
                lappend ::result "A::A $this"
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
            virtual proc f {this p q} {
                lappend ::result "A::h $this $p $q"
            }
            virtual proc g {this p args} {
                lappend ::result "A::g $this $p $args"
            }
        }
        class B {
            proc B {this} A {} {
                lappend ::result "B::B $this"
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
            proc f {this p q} {
                lappend ::result "B::f $this $p $q"
                A::_f $this $p $q
            }
            proc g {this p args} {
                lappend ::result "B::g $this $p $args"
                eval A::_g $this $p $args
            }
        }
        set o [new B]
        A::f $o x {y z}
        A::g $o {x y} {1 2} 3 {4 5}

        class c {}
        class c::d {}
        proc c::d::d {this} {
            lappend ::result "d::d $this"
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        virtual proc c::d::f {this p q} {
            lappend ::result "d::h $this $p $q"
        }
        virtual proc c::d::g {this p args} {
            lappend ::result "d::g $this $p $args"
        }
        class c::e {}
        proc c::e::e {this} c::d {} {
            lappend ::result "e::e $this"
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        proc c::e::f {this p q} {
            lappend ::result "e::f $this $p $q"
            c::d::_f $this $p $q
        }
        proc c::e::g {this p args} {
            lappend ::result "e::g $this $p $args"
            eval c::d::_g $this $p $args
        }
        set o [new c::e]
        c::d::f $o x {y z}
        c::d::g $o {x y} {1 2} 3 {4 5}

        class C {
            class D {
                proc D {this} {
                    lappend ::result "D::D $this"
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
                virtual proc f {this p q} {
                    lappend ::result "D::h $this $p $q"
                }
                virtual proc g {this p args} {
                    lappend ::result "D::g $this $p $args"
                }
            }
            class E {
                proc E {this} C::D {} {
                    lappend ::result "E::E $this"
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
                proc f {this p q} {
                    lappend ::result "E::f $this $p $q"
                    C::D::_f $this $p $q
                }
                proc g {this p args} {
                    lappend ::result "E::g $this $p $args"
                    eval C::D::_g $this $p $args
                }
            }
            set o [new E]
            D::f $o x {y z}
            D::g $o {x y} {1 2} 3 {4 5}
        }
        set o [new C::E]
        C::D::f $o x {y z}
        C::D::g $o {x y} {1 2} 3 {4 5}

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {b::f 1 x y z}\
    {a::h 1 x y z}\
    {b::g 1 x y {1 2} 3 {4 5}}\
    {a::g 1 x y {1 2} 3 {4 5}}\
    {A::A 2}\
    {B::B 2}\
    {B::f 2 x y z}\
    {A::h 2 x y z}\
    {B::g 2 x y {1 2} 3 {4 5}}\
    {A::g 2 x y {1 2} 3 {4 5}}\
    {d::d 3}\
    {e::e 3}\
    {e::f 3 x y z}\
    {d::h 3 x y z}\
    {e::g 3 x y {1 2} 3 {4 5}}\
    {d::g 3 x y {1 2} 3 {4 5}}\
    {D::D 4}\
    {E::E 4}\
    {E::f 4 x y z}\
    {D::h 4 x y z}\
    {E::g 4 x y {1 2} 3 {4 5}}\
    {D::g 4 x y {1 2} 3 {4 5}}\
    {D::D 5}\
    {E::E 5}\
    {E::f 5 x y z}\
    {D::h 5 x y z}\
    {E::g 5 x y {1 2} 3 {4 5}}\
    {D::g 5 x y {1 2} 3 {4 5}}\
]

test stooop-31 {
    check multiple inheritance construction order, destruction order and data
    deallocation
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p} {
            lappend ::result "b::b $this"
            set ($this,n) $p
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class c {}
        proc c::c {this p q r} a {$p} b {$q} {
            lappend ::result "c::c $this"
            set ($this,o) $r
        }
        proc c::~c {this} {
            lappend ::result "c::~c $this"
        }
        set o [new c {x y} z {1 2}]
        eval lappend ::result [dumpArrays a:: b:: c::]
        delete $o
        eval lappend ::result [dumpArrays a:: b:: c::]

        class A {
            proc A {this p} {
                lappend ::result "A::A $this"
                set ($this,m) $p
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p} {
                lappend ::result "B::B $this"
                set ($this,n) $p
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        class C {
            proc C {this p q r} A {$p} B {$q} {
                lappend ::result "C::C $this"
                set ($this,o) $r
            }
            proc ~C {this} {
                lappend ::result "C::~C $this"
            }
        }
        set o [new C {x y} z {1 2}]
        eval lappend ::result [dumpArrays A:: B:: C::]
        delete $o
        eval lappend ::result [dumpArrays A:: B:: C::]

        class d {}
        class d::e {}
        proc d::e::e {this p} {
            lappend ::result "e::e $this"
            set ($this,m) $p
        }
        proc d::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        class d::f {}
        proc d::f::f {this p} {
            lappend ::result "f::f $this"
            set ($this,n) $p
        }
        proc d::f::~f {this} {
            lappend ::result "f::~f $this"
        }
        class d::g {}
        proc d::g::g {this p q r} d::e {$p} d::f {$q} {
            lappend ::result "g::g $this"
            set ($this,o) $r
        }
        proc d::g::~g {this} {
            lappend ::result "g::~g $this"
        }
        set o [new d::g {x y} z {1 2}]
        eval lappend ::result [dumpArrays d::e:: d::f:: d::g::]
        delete $o
        eval lappend ::result [dumpArrays d::e:: d::f:: d::g::]

        class C {
            class E {
                proc E {this p} {
                    lappend ::result "E::E $this"
                    set ($this,m) $p
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            class F {
                proc F {this p} {
                    lappend ::result "F::F $this"
                    set ($this,n) $p
                }
                proc ~F {this} {
                    lappend ::result "F::~F $this"
                }
            }
            class G {
                proc G {this p q r} C::E {$p} C::F {$q} {
                    lappend ::result "G::G $this"
                    set ($this,o) $r
                }
                proc ~G {this} {
                    lappend ::result "G::~G $this"
                }
            }
            set o [new G {x y} z {1 2}]
            eval lappend ::result [dumpArrays E:: F:: G::]
            delete $o
            eval lappend ::result [dumpArrays E:: F:: G::]
        }
        set o [new C::G {x y} z {1 2}]
        eval lappend ::result [dumpArrays C::E:: C::F:: C::G::]
        delete $o
        eval lappend ::result [dumpArrays C::E:: C::F:: C::G::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {c::c 1}\
    {a::(1,_derived) = ::c}\
    {a::(1,m) = x y}\
    {b::(1,_derived) = ::c}\
    {b::(1,n) = z}\
    {c::(1,o) = 1 2}\
    {c::~c 1}\
    {b::~b 1}\
    {a::~a 1}\
    {A::A 2}\
    {B::B 2}\
    {C::C 2}\
    {A::(2,_derived) = ::C}\
    {A::(2,m) = x y}\
    {B::(2,_derived) = ::C}\
    {B::(2,n) = z}\
    {C::(2,o) = 1 2}\
    {C::~C 2}\
    {B::~B 2}\
    {A::~A 2}\
    {e::e 3}\
    {f::f 3}\
    {g::g 3}\
    {d::e::(3,_derived) = ::d::g}\
    {d::e::(3,m) = x y}\
    {d::f::(3,_derived) = ::d::g}\
    {d::f::(3,n) = z}\
    {d::g::(3,o) = 1 2}\
    {g::~g 3}\
    {f::~f 3}\
    {e::~e 3}\
    {E::E 4}\
    {F::F 4}\
    {G::G 4}\
    {E::(4,_derived) = ::C::G}\
    {E::(4,m) = x y}\
    {F::(4,_derived) = ::C::G}\
    {F::(4,n) = z}\
    {G::(4,o) = 1 2}\
    {G::~G 4}\
    {F::~F 4}\
    {E::~E 4}\
    {E::E 5}\
    {F::F 5}\
    {G::G 5}\
    {C::E::(5,_derived) = ::C::G}\
    {C::E::(5,m) = x y}\
    {C::F::(5,_derived) = ::C::G}\
    {C::F::(5,n) = z}\
    {C::G::(5,o) = 1 2}\
    {G::~G 5}\
    {F::~F 5}\
    {E::~E 5}\
]

test stooop-32 {
    check that class constructor with multiple base classes has correct number
    of base class / argument pairs
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class c {}
            proc c::c {this} a {} b {}
        } message
        lappend ::result $message

        catch {
            class C {
                proc C {this} A {} B {}
            }
        } message
        lappend ::result $message

        catch {
            class d {}
            class d::g {}
            proc d::g::g {this} d::e {} d::f {}
        } message
        lappend ::result $message

        catch {
            class C {
                class G {
                    proc G {this} C::E {} C::F {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {bad class ::c constructor declaration, a base class, contructor arguments or body may be missing}\
    {bad class ::C constructor declaration, a base class, contructor arguments or body may be missing}\
    {bad class ::d::g constructor declaration, a base class, contructor arguments or body may be missing}\
    {bad class ::C::G constructor declaration, a base class, contructor arguments or body may be missing}\
]

test stooop-33 {
    check that base class of class with multiple base classes is defined
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this} {}
            class b {}
            class c {}
            proc c::c {this} a {} b {} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
            }
            class B {}
            class C {
                proc C {this} A {} B {} {}
            }
        } message
        lappend ::result $message

        catch {
            class d {}
            class d::e {}
            proc d::e::e {this} {}
            class d::f {}
            class d::g {}
            proc d::g::g {this} d::e {} d::f {} {}
        } message
        lappend ::result $message

        catch {
            class C {
                class E {
                    proc E {this} {}
                }
                class F {}
                class G {
                    proc G {this} C::E {} C::F {} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::c constructor defined before base class b constructor}\
    {class ::C constructor defined before base class B constructor}\
    {class ::d::g constructor defined before base class d::f constructor}\
    {class ::C::G constructor defined before base class C::F constructor}\
]

test stooop-34 {
    check that a direct base class is not specified more than once in a class
    constructor declaration
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this} {}
            class c {}
            proc c::c {this} a {} a {} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
            }
            class C {
                proc C {this} A {} A {} {}
            }
        } message
        lappend ::result $message

        catch {
            class d {}
            class d::e {}
            proc d::e::e {this} {}
            class d::g {}
            proc d::g::g {this} d::e {} d::e {} {}
        } message
        lappend ::result $message

        catch {
            class D {
                class E {
                    proc E {this} {}
                }
                class G {
                    proc G {this} D::E {} D::E {} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::c directly inherits from class ::a more than once}\
    {class ::C directly inherits from class ::A more than once}\
    {class ::d::g directly inherits from class ::d::e more than once}\
    {class ::D::G directly inherits from class ::D::E more than once}\
]

test stooop-35 {
    check that class constructor with multiple base classes allows new lines
    within base class constructors arguments
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p} {
            lappend ::result "b::b $this"
            set ($this,n) $p
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class c {}
        proc c::c {this p q r} a {
            $p
        } b {
            $q
        } {
            lappend ::result "c::c $this"
            set ($this,o) $r
        }
        proc c::~c {this} {
            lappend ::result "c::~c $this"
        }
        new c {x y} z {1 2}
        eval lappend ::result [dumpArrays a:: b:: c::]

        class A {
            proc A {this p} {
                lappend ::result "A::A $this"
                set ($this,m) $p
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p} {
                lappend ::result "B::B $this"
                set ($this,n) $p
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        class C {
            proc C {this p q r} A {
                $p
            } B {
                $q
            } {
                lappend ::result "C::C $this"
                set ($this,o) $r
            }
            proc ~C {this} {
                lappend ::result "C::~C $this"
            }
        }
        new C {x y} z {1 2}
        eval lappend ::result [dumpArrays A:: B:: C::]

        class d {}
        class d::e {}
        proc d::e::e {this p} {
            lappend ::result "e::e $this"
            set ($this,m) $p
        }
        proc d::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        class d::f {}
        proc d::f::f {this p} {
            lappend ::result "f::f $this"
            set ($this,n) $p
        }
        proc d::f::~f {this} {
            lappend ::result "f::~f $this"
        }
        class d::g {}
        proc d::g::g {this p q r} d::e {
            $p
        } d::f {
            $q
        } {
            lappend ::result "g::g $this"
            set ($this,o) $r
        }
        proc d::g::~g {this} {
            lappend ::result "g::~g $this"
        }
        new d::g {x y} z {1 2}
        eval lappend ::result [dumpArrays d::e:: d::f:: d::g::]

        class D {
            class E {
                proc E {this p} {
                    lappend ::result "E::E $this"
                    set ($this,m) $p
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            class F {
                proc F {this p} {
                    lappend ::result "F::F $this"
                    set ($this,n) $p
                }
                proc ~F {this} {
                    lappend ::result "F::~F $this"
                }
            }
            class G {
                proc G {this p q r} D::E {
                    $p
                } D::F {
                    $q
                } {
                    lappend ::result "G::G $this"
                    set ($this,o) $r
                }
                proc ~G {this} {
                    lappend ::result "G::~G $this"
                }
            }
            new G {x y} z {1 2}
            eval lappend ::result [dumpArrays E:: F:: G::]
        }
        new D::G {x y} z {1 2}
        eval lappend ::result [dumpArrays D::E:: D::F:: D::G::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {c::c 1}\
    {a::(1,_derived) = ::c}\
    {a::(1,m) = x y}\
    {b::(1,_derived) = ::c}\
    {b::(1,n) = z}\
    {c::(1,o) = 1 2}\
    {A::A 2}\
    {B::B 2}\
    {C::C 2}\
    {A::(2,_derived) = ::C}\
    {A::(2,m) = x y}\
    {B::(2,_derived) = ::C}\
    {B::(2,n) = z}\
    {C::(2,o) = 1 2}\
    {e::e 3}\
    {f::f 3}\
    {g::g 3}\
    {d::e::(3,_derived) = ::d::g}\
    {d::e::(3,m) = x y}\
    {d::f::(3,_derived) = ::d::g}\
    {d::f::(3,n) = z}\
    {d::g::(3,o) = 1 2}\
    {E::E 4}\
    {F::F 4}\
    {G::G 4}\
    {E::(4,_derived) = ::D::G}\
    {E::(4,m) = x y}\
    {F::(4,_derived) = ::D::G}\
    {F::(4,n) = z}\
    {G::(4,o) = 1 2}\
    {E::E 5}\
    {F::F 5}\
    {G::G 5}\
    {D::E::(4,_derived) = ::D::G}\
    {D::E::(4,m) = x y}\
    {D::E::(5,_derived) = ::D::G}\
    {D::E::(5,m) = x y}\
    {D::F::(4,_derived) = ::D::G}\
    {D::F::(4,n) = z}\
    {D::F::(5,_derived) = ::D::G}\
    {D::F::(5,n) = z}\
    {D::G::(4,o) = 1 2}\
    {D::G::(5,o) = 1 2}\
]

test stooop-36 {
    check multiple inheritance construction order, destruction order and data
    deallocation with a common indirect base class
    (see test 71 for nested class version)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p} {
            lappend ::result "b::b $this"
            set ($this,n) $p
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class c {}
        proc c::c {this p q r} a {$p} b {$q} {
            lappend ::result "c::c $this"
            set ($this,o) $r
        }
        proc c::~c {this} {
            lappend ::result "c::~c $this"
        }
        class d {}
        proc d::d {this p q r} a {$p} b {$q} {
            lappend ::result "d::d $this"
            set ($this,p) $p
        }
        proc d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class e {}
        proc e::e {this p q r} c {$p $q $r} d {$q $q $r} {
            lappend ::result "e::e $this"
            set ($this,q) $q
        }
        proc e::~e {this} {
            lappend ::result "e::~e $this"
        }
        set o [new e {x y} z {1 2}]
        eval lappend ::result [dumpArrays a:: b:: c:: d:: e::]
        delete $o
        eval lappend ::result [dumpArrays a:: b:: c:: d:: e::]

        class A {
            proc A {this p} {
                lappend ::result "A::A $this"
                set ($this,m) $p
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p} {
                lappend ::result "B::B $this"
                set ($this,n) $p
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        class C {
            proc C {this p q r} A {$p} B {$q} {
                lappend ::result "C::C $this"
                set ($this,o) $r
            }
            proc ~C {this} {
                lappend ::result "C::~C $this"
            }
        }
        class D {
            proc D {this p q r} A {$p} B {$q} {
                lappend ::result "D::D $this"
                set ($this,p) $p
            }
            proc ~D {this} {
                lappend ::result "D::~D $this"
            }
        }
        class E {
            proc E {this p q r} C {$p $q $r} D {$q $q $r} {
                lappend ::result "E::E $this"
                set ($this,q) $q
            }
            proc ~E {this} {
                lappend ::result "E::~E $this"
            }
        }
        set o [new E {x y} z {1 2}]
        eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
        delete $o
        eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {c::c 1}\
    {a::a 1}\
    {b::b 1}\
    {d::d 1}\
    {e::e 1}\
    {a::(1,_derived) = ::d}\
    {a::(1,m) = z}\
    {b::(1,_derived) = ::d}\
    {b::(1,n) = z}\
    {c::(1,_derived) = ::e}\
    {c::(1,o) = 1 2}\
    {d::(1,_derived) = ::e}\
    {d::(1,p) = z}\
    {e::(1,q) = z}\
    {e::~e 1}\
    {d::~d 1}\
    {b::~b 1}\
    {a::~a 1}\
    {c::~c 1}\
    {b::~b 1}\
    {a::~a 1}\
    {A::A 2}\
    {B::B 2}\
    {C::C 2}\
    {A::A 2}\
    {B::B 2}\
    {D::D 2}\
    {E::E 2}\
    {A::(2,_derived) = ::D}\
    {A::(2,m) = z}\
    {B::(2,_derived) = ::D}\
    {B::(2,n) = z}\
    {C::(2,_derived) = ::E}\
    {C::(2,o) = 1 2}\
    {D::(2,_derived) = ::E}\
    {D::(2,p) = z}\
    {E::(2,q) = z}\
    {E::~E 2}\
    {D::~D 2}\
    {B::~B 2}\
    {A::~A 2}\
    {C::~C 2}\
    {B::~B 2}\
    {A::~A 2}\
]

test stooop-37 {
    check that multiply inherited base classes constructors work with variable
    number of arguments (see test 72 for nested class version)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this args} {
            lappend ::result "a::a $this $args"
            set ($this,m) [lindex $args 0]
        }
        class b {}
        proc b::b {this p} {
            lappend ::result "b::b $this $p"
            set ($this,n) $p
        }
        class c {}
        proc c::c {this p args} {
            lappend ::result "c::c $this $p $args"
            set ($this,o) $p
            set ($this,p) [lindex $args 0]
        }
        class d {}
        proc d::d {this p args} a {$args} b {$p} c {$p $args} {
            lappend ::result "d::d $this $p $args"
            set ($this,q) $p
            set ($this,r) [lindex $args 0]
        }
        new d {x y} {1 2} 3
        eval lappend ::result [dumpArrays a:: b:: c:: d::]

        class A {
            proc A {this args} {
                lappend ::result "A::A $this $args"
                set ($this,m) [lindex $args 0]
            }
        }
        class B {
            proc B {this p} {
                lappend ::result "B::B $this $p"
                set ($this,n) $p
            }
        }
        class C {
            proc C {this p args} {
                lappend ::result "C::C $this $p $args"
                set ($this,o) $p
                set ($this,p) [lindex $args 0]
            }
        }
        class D {
            proc D {this p args} A {$args} B {$p} C {$p $args} {
                lappend ::result "D::D $this $p $args"
                set ($this,q) $p
                set ($this,r) [lindex $args 0]
            }
        }
        new D {x y} {1 2} 3
        eval lappend ::result [dumpArrays A:: B:: C:: D::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 {1 2} 3}\
    {b::b 1 x y}\
    {c::c 1 x y {1 2} 3}\
    {d::d 1 x y {1 2} 3}\
    {a::(1,_derived) = ::d}\
    {a::(1,m) = 1 2}\
    {b::(1,_derived) = ::d}\
    {b::(1,n) = x y}\
    {c::(1,_derived) = ::d}\
    {c::(1,o) = x y}\
    {c::(1,p) = 1 2}\
    {d::(1,q) = x y}\
    {d::(1,r) = 1 2}\
    {A::A 2 {1 2} 3}\
    {B::B 2 x y}\
    {C::C 2 x y {1 2} 3}\
    {D::D 2 x y {1 2} 3}\
    {A::(2,_derived) = ::D}\
    {A::(2,m) = 1 2}\
    {B::(2,_derived) = ::D}\
    {B::(2,n) = x y}\
    {C::(2,_derived) = ::D}\
    {C::(2,o) = x y}\
    {C::(2,p) = 1 2}\
    {D::(2,q) = x y}\
    {D::(2,r) = 1 2}\
]

test stooop-38 {
    check multiple inheritance destruction order and data deallocation with a
    common indirect base class (see test 73 for nested class version)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p} {
            lappend ::result "b::b $this"
            set ($this,n) $p
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class c {}
        proc c::c {this p q r} a {$p} b {$q} {
            lappend ::result "c::c $this"
            set ($this,o) $r
        }
        proc c::~c {this} {
            lappend ::result "c::~c $this"
        }
        class d {}
        proc d::d {this p q r} a {$p} b {$q} {
            lappend ::result "d::d $this"
            set ($this,p) $p
        }
        proc d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class e {}
        proc e::e {this p q r} c {$p $q $r} d {$q $q $r} {
            lappend ::result "e::e $this"
            set ($this,q) $q
        }
        proc e::~e {this} {
            lappend ::result "e::~e $this"
        }
        set o [new e {x y} z {1 2}]
        eval lappend ::result [dumpArrays a:: b:: c:: d:: e::]
        delete $o
        eval lappend ::result [dumpArrays a:: b:: c:: d:: e::]

        class A {
            proc A {this p} {
                lappend ::result "A::A $this"
                set ($this,m) $p
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p} {
                lappend ::result "B::B $this"
                set ($this,n) $p
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        class C {
            proc C {this p q r} A {$p} B {$q} {
                lappend ::result "C::C $this"
                set ($this,o) $r
            }
            proc ~C {this} {
                lappend ::result "C::~C $this"
            }
        }
        class D {
            proc D {this p q r} A {$p} B {$q} {
                lappend ::result "D::D $this"
                set ($this,p) $p
            }
            proc ~D {this} {
                lappend ::result "D::~D $this"
            }
        }
        class E {
            proc E {this p q r} C {$p $q $r} D {$q $q $r} {
                lappend ::result "E::E $this"
                set ($this,q) $q
            }
            proc ~E {this} {
                lappend ::result "E::~E $this"
            }
        }
        set o [new E {x y} z {1 2}]
        eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
        delete $o
        eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {c::c 1}\
    {a::a 1}\
    {b::b 1}\
    {d::d 1}\
    {e::e 1}\
    {a::(1,_derived) = ::d}\
    {a::(1,m) = z}\
    {b::(1,_derived) = ::d}\
    {b::(1,n) = z}\
    {c::(1,_derived) = ::e}\
    {c::(1,o) = 1 2}\
    {d::(1,_derived) = ::e}\
    {d::(1,p) = z}\
    {e::(1,q) = z}\
    {e::~e 1}\
    {d::~d 1}\
    {b::~b 1}\
    {a::~a 1}\
    {c::~c 1}\
    {b::~b 1}\
    {a::~a 1}\
    {A::A 2}\
    {B::B 2}\
    {C::C 2}\
    {A::A 2}\
    {B::B 2}\
    {D::D 2}\
    {E::E 2}\
    {A::(2,_derived) = ::D}\
    {A::(2,m) = z}\
    {B::(2,_derived) = ::D}\
    {B::(2,n) = z}\
    {C::(2,_derived) = ::E}\
    {C::(2,o) = 1 2}\
    {D::(2,_derived) = ::E}\
    {D::(2,p) = z}\
    {E::(2,q) = z}\
    {E::~E 2}\
    {D::~D 2}\
    {B::~B 2}\
    {A::~A 2}\
    {C::~C 2}\
    {B::~B 2}\
    {A::~A 2}\
]

test stooop-39 {
    check that optional arguments in constructors and multiple inheritance work
    together (see test 74 for nested class version)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this {p 0}} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this {p 1}} {
            lappend ::result "b::b $this"
            set ($this,n) $p
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class c {}
        proc c::c {this {p 2} {q 3}} a {$p} b {$q} {
            lappend ::result "c::c $this"
            set ($this,o) $p
            set ($this,p) $q
        }
        proc c::~c {this} {
            lappend ::result "c::~c $this"
        }
        set o [new c {x y} z]
        eval lappend ::result [dumpArrays a:: b:: c::]
        delete $o
        set o [new c]
        eval lappend ::result [dumpArrays a:: b:: c::]

        class A {
            proc A {this {p 0}} {
                lappend ::result "A::A $this"
                set ($this,m) $p
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this {p 1}} {
                lappend ::result "B::B $this"
                set ($this,n) $p
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        class C {
            proc C {this {p 2} {q 3}} A {$p} B {$q} {
                lappend ::result "C::C $this"
                set ($this,o) $p
                set ($this,p) $q
            }
            proc ~C {this} {
                lappend ::result "C::~C $this"
            }
        }
        set o [new C {x y} z]
        eval lappend ::result [dumpArrays A:: B:: C::]
        delete $o
        set o [new C]
        eval lappend ::result [dumpArrays A:: B:: C::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {c::c 1}\
    {a::(1,_derived) = ::c}\
    {a::(1,m) = x y}\
    {b::(1,_derived) = ::c}\
    {b::(1,n) = z}\
    {c::(1,o) = x y}\
    {c::(1,p) = z}\
    {c::~c 1}\
    {b::~b 1}\
    {a::~a 1}\
    {a::a 2}\
    {b::b 2}\
    {c::c 2}\
    {a::(2,_derived) = ::c}\
    {a::(2,m) = 2}\
    {b::(2,_derived) = ::c}\
    {b::(2,n) = 3}\
    {c::(2,o) = 2}\
    {c::(2,p) = 3}\
    {A::A 3}\
    {B::B 3}\
    {C::C 3}\
    {A::(3,_derived) = ::C}\
    {A::(3,m) = x y}\
    {B::(3,_derived) = ::C}\
    {B::(3,n) = z}\
    {C::(3,o) = x y}\
    {C::(3,p) = z}\
    {C::~C 3}\
    {B::~B 3}\
    {A::~A 3}\
    {A::A 4}\
    {B::B 4}\
    {C::C 4}\
    {A::(4,_derived) = ::C}\
    {A::(4,m) = 2}\
    {B::(4,_derived) = ::C}\
    {B::(4,n) = 3}\
    {C::(4,o) = 2}\
    {C::(4,p) = 3}\
]

test stooop-40 {
    check various virtual procedures configurations in a 3 level deep class
    hierarchy (see test 75 for nested class version)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        virtual proc a::f {this p q} {}
        virtual proc a::g {this p q}
        virtual proc a::h {this p q} {
            lappend ::result "a::h $this $p $q"
        }
        virtual proc a::i {this p q} {
            lappend ::result "a::i $this $p $q"
        }
        virtual proc a::k {this p q}
        virtual proc a::l {this p q} {
            lappend ::result "a::l $this $p $q"
        }
        class b {}
        proc b::b {this} a {} {}
        proc b::~b {this} {}
        virtual proc b::f {this p q} {
            lappend ::result "b::f $this $p $q"
        }
        virtual proc b::g {this p q}
        virtual proc b::h {this p q} {
            lappend ::result "b::h $this $p $q"
        }
        proc b::i {this p q} {
            lappend ::result "b::i $this $p $q"
        }
        virtual proc b::k {this p q} {
            lappend ::result "b::k $this $p $q"
        }
        virtual proc b::l {this p q}
        class c {}
        proc c::c {this} b {} {}
        proc c::~c {this} {}
        proc c::f {this p q} {
            lappend ::result "c::f $this $p $q"
        }
        proc c::g {this p q} {
            lappend ::result "c::g $this $p $q"
        }
        proc c::i {this p q} {
            lappend ::result "c::i $this $p $q"
        }
        proc c::k {this p q} {
            lappend ::result "c::k $this $p $q"
        }
        proc c::l {this p q} {
            lappend ::result "c::l $this $p $q"
        }
        set o [new c]
        a::f $o x {y z}
        a::g $o x {y z}
        a::h $o x {y z}
        a::i $o x {y z}
        a::k $o x {y z}
        a::l $o x {y z}

        class A {
            proc A {this} {}
            proc ~A {this} {}
            virtual proc f {this p q} {}
            virtual proc g {this p q}
            virtual proc h {this p q} {
                lappend ::result "A::h $this $p $q"
            }
            virtual proc i {this p q} {
                lappend ::result "A::i $this $p $q"
            }
            virtual proc k {this p q}
            virtual proc l {this p q} {
                lappend ::result "A::l $this $p $q"
            }
        }
        class B {
            proc B {this} A {} {}
            proc ~B {this} {}
            virtual proc f {this p q} {
                lappend ::result "B::f $this $p $q"
            }
            virtual proc g {this p q}
            virtual proc h {this p q} {
                lappend ::result "B::h $this $p $q"
            }
            proc i {this p q} {
                lappend ::result "B::i $this $p $q"
            }
            virtual proc k {this p q} {
                lappend ::result "B::k $this $p $q"
            }
            virtual proc l {this p q}
        }
        class C {
            proc C {this} B {} {}
            proc ~C {this} {}
            proc f {this p q} {
                lappend ::result "C::f $this $p $q"
            }
            proc g {this p q} {
                lappend ::result "C::g $this $p $q"
            }
            proc i {this p q} {
                lappend ::result "C::i $this $p $q"
            }
            proc k {this p q} {
                lappend ::result "C::k $this $p $q"
            }
            proc l {this p q} {
                lappend ::result "C::l $this $p $q"
            }
        }
        set o [new C]
        A::f $o x {y z}
        A::g $o x {y z}
        A::h $o x {y z}
        A::i $o x {y z}
        A::k $o x {y z}
        A::l $o x {y z}

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {c::f 1 x y z}\
    {c::g 1 x y z}\
    {b::h 1 x y z}\
    {b::i 1 x y z}\
    {c::k 1 x y z}\
    {c::l 1 x y z}\
    {C::f 2 x y z}\
    {C::g 2 x y z}\
    {B::h 2 x y z}\
    {B::i 2 x y z}\
    {C::k 2 x y z}\
    {C::l 2 x y z}\
]

test stooop-41 {
    check various virtual procedures with variable number of arguments
    configurations in a 3 level deep class hierarchy
    (see 76.tcl for nested class version)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        virtual proc a::f {this p args} {}
        virtual proc a::g {this p args}
        virtual proc a::h {this p args} {
            lappend ::result "a::h $this $p $args"
        }
        virtual proc a::i {this p args} {
            lappend ::result "a::i $this $p $args"
        }
        virtual proc a::k {this p args}
        virtual proc a::l {this p args} {
            lappend ::result "a::l $this $p $args"
        }
        class b {}
        proc b::b {this} a {} {}
        proc b::~b {this} {}
        virtual proc b::f {this p args} {
            lappend ::result "b::f $this $p $args"
        }
        virtual proc b::g {this p args}
        virtual proc b::h {this p args} {
            lappend ::result "b::h $this $p $args"
        }
        proc b::i {this p args} {
            lappend ::result "b::i $this $p $args"
        }
        virtual proc b::k {this p args} {
            lappend ::result "b::k $this $p $args"
        }
        virtual proc b::l {this p args}
        class c {}
        proc c::c {this} b {} {}
        proc c::~c {this} {}
        proc c::f {this p args} {
            lappend ::result "c::f $this $p $args"
        }
        proc c::g {this p args} {
            lappend ::result "c::g $this $p $args"
        }
        proc c::i {this p args} {
            lappend ::result "c::i $this $p $args"
        }
        proc c::k {this p args} {
            lappend ::result "c::k $this $p $args"
        }
        proc c::l {this p args} {
            lappend ::result "c::l $this $p $args"
        }
        set o [new c]
        a::f $o x {y z}
        a::g $o x {y z}
        a::h $o x {y z}
        a::i $o x {y z}
        a::k $o x {y z}
        a::l $o x {y z}

        class A {
            proc A {this} {}
            proc ~A {this} {}
            virtual proc f {this p args} {}
            virtual proc g {this p args}
            virtual proc h {this p args} {
                lappend ::result "A::h $this $p $args"
            }
            virtual proc i {this p args} {
                lappend ::result "A::i $this $p $args"
            }
            virtual proc k {this p args}
            virtual proc l {this p args} {
                lappend ::result "A::l $this $p $args"
            }
        }
        class B {
            proc B {this} A {} {}
            proc ~B {this} {}
            virtual proc f {this p args} {
                lappend ::result "B::f $this $p $args"
            }
            virtual proc g {this p args}
            virtual proc h {this p args} {
                lappend ::result "B::h $this $p $args"
            }
            proc i {this p args} {
                lappend ::result "B::i $this $p $args"
            }
            virtual proc k {this p args} {
                lappend ::result "B::k $this $p $args"
            }
            virtual proc l {this p args}
        }
        class C {
            proc C {this} B {} {}
            proc ~C {this} {}
            proc f {this p args} {
                lappend ::result "C::f $this $p $args"
            }
            proc g {this p args} {
                lappend ::result "C::g $this $p $args"
            }
            proc i {this p args} {
                lappend ::result "C::i $this $p $args"
            }
            proc k {this p args} {
                lappend ::result "C::k $this $p $args"
            }
            proc l {this p args} {
                lappend ::result "C::l $this $p $args"
            }
        }
        set o [new C]
        A::f $o x {y z}
        A::g $o x {y z}
        A::h $o x {y z}
        A::i $o x {y z}
        A::k $o x {y z}
        A::l $o x {y z}

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {c::f 1 x {y z}}\
    {c::g 1 x {y z}}\
    {b::h 1 x {y z}}\
    {b::i 1 x {y z}}\
    {c::k 1 x {y z}}\
    {c::l 1 x {y z}}\
    {C::f 2 x {y z}}\
    {C::g 2 x {y z}}\
    {B::h 2 x {y z}}\
    {B::i 2 x {y z}}\
    {C::k 2 x {y z}}\
    {C::l 2 x {y z}}\
]

test stooop-42 {
    check basic cloning operation (see nested class version in test 70)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            set ($this,x) 0
        }
        new [new a]
        eval lappend ::result [dumpArrays a::]

        class A {
            proc A {this} {
                set ($this,x) 0
            }
        }
        new [new A]
        eval lappend ::result [dumpArrays A::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(1,x) = 0}\
    {a::(2,x) = 0}\
    {A::(3,x) = 0}\
    {A::(4,x) = 0}\
]

test stooop-43 {
    check user defined cloning operation (see nested class version in test 69)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            set ($this,x) 0
        }
        proc a::a {this copy} {
            set ($this,x) [expr $($copy,x)+1]
        }
        new [new a]
        eval lappend ::result [dumpArrays a::]

        class A {
            proc A {this} {
                set ($this,x) 0
            }
            proc A {this copy} {
                set ($this,x) [expr $($copy,x)+1]
            }
        }
        new [new A]
        eval lappend ::result [dumpArrays A::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(1,x) = 0}\
    {a::(2,x) = 1}\
    {A::(3,x) = 0}\
    {A::(4,x) = 1}\
]

test stooop-44 {
    check cloning operation in a 3 level deep class hierarchy
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            set ($this,x) 0
        }
        class b {}
        proc b::b {this} a {} {
            set ($this,y) 1
        }
        class c {}
        proc c::c {this} b {} {
            set ($this,z) 2
        }
        new [new c]
        eval lappend ::result [dumpArrays a:: b:: c::]

        class A {
            proc A {this} {
                set ($this,x) 0
            }
        }
        class B {
            proc B {this} A {} {
                set ($this,y) 1
            }
        }
        class C {
            proc C {this} B {} {
                set ($this,z) 2
            }
        }
        new [new C]
        eval lappend ::result [dumpArrays A:: B:: C::]

        class d {}
        class d::e {}
        proc d::e::e {this} {
            set ($this,x) 0
        }
        class d::f {}
        proc d::f::f {this} d::e {} {
            set ($this,y) 1
        }
        class d::g {}
        proc d::g::g {this} d::f {} {
            set ($this,z) 2
        }
        new [new d::g]
        eval lappend ::result [dumpArrays d::e:: d::f:: d::g::]

        class D {
            class E {
                proc E {this} {
                    set ($this,x) 0
                }
            }
            class F {
                proc F {this} D::E {} {
                    set ($this,y) 1
                }
            }
            class G {
                proc G {this} D::F {} {
                    set ($this,z) 2
                }
            }
            new [new G]
            eval lappend ::result [dumpArrays E:: F:: G::]
        }
        new [new D::G]
        eval lappend ::result [dumpArrays D::E:: D::F:: D::G::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(1,_derived) = ::b}\
    {a::(1,x) = 0}\
    {a::(2,_derived) = ::b}\
    {a::(2,x) = 0}\
    {b::(1,_derived) = ::c}\
    {b::(1,y) = 1}\
    {b::(2,_derived) = ::c}\
    {b::(2,y) = 1}\
    {c::(1,z) = 2}\
    {c::(2,z) = 2}\
    {A::(3,_derived) = ::B}\
    {A::(3,x) = 0}\
    {A::(4,_derived) = ::B}\
    {A::(4,x) = 0}\
    {B::(3,_derived) = ::C}\
    {B::(3,y) = 1}\
    {B::(4,_derived) = ::C}\
    {B::(4,y) = 1}\
    {C::(3,z) = 2}\
    {C::(4,z) = 2}\
    {d::e::(5,_derived) = ::d::f}\
    {d::e::(5,x) = 0}\
    {d::e::(6,_derived) = ::d::f}\
    {d::e::(6,x) = 0}\
    {d::f::(5,_derived) = ::d::g}\
    {d::f::(5,y) = 1}\
    {d::f::(6,_derived) = ::d::g}\
    {d::f::(6,y) = 1}\
    {d::g::(5,z) = 2}\
    {d::g::(6,z) = 2}\
    {E::(7,_derived) = ::D::F}\
    {E::(7,x) = 0}\
    {E::(8,_derived) = ::D::F}\
    {E::(8,x) = 0}\
    {F::(7,_derived) = ::D::G}\
    {F::(7,y) = 1}\
    {F::(8,_derived) = ::D::G}\
    {F::(8,y) = 1}\
    {G::(7,z) = 2}\
    {G::(8,z) = 2}\
    {D::E::(10,_derived) = ::D::F}\
    {D::E::(10,x) = 0}\
    {D::E::(7,_derived) = ::D::F}\
    {D::E::(7,x) = 0}\
    {D::E::(8,_derived) = ::D::F}\
    {D::E::(8,x) = 0}\
    {D::E::(9,_derived) = ::D::F}\
    {D::E::(9,x) = 0}\
    {D::F::(10,_derived) = ::D::G}\
    {D::F::(10,y) = 1}\
    {D::F::(7,_derived) = ::D::G}\
    {D::F::(7,y) = 1}\
    {D::F::(8,_derived) = ::D::G}\
    {D::F::(8,y) = 1}\
    {D::F::(9,_derived) = ::D::G}\
    {D::F::(9,y) = 1}\
    {D::G::(10,z) = 2}\
    {D::G::(7,z) = 2}\
    {D::G::(8,z) = 2}\
    {D::G::(9,z) = 2}\
]

test stooop-45 {
    check user defined cloning operation error checking
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this} {
                set ($this,x) 0
            }
            proc a::a {destination source} {}
            new [new a]
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {
                    set ($this,x) 0
                }
                proc A {destination source} {}
            }
            new [new A]
        } message
        lappend ::result $message

        catch {
            class b {}
            class b::c {}
            proc b::c::c {this} {
                set ($this,x) 0
            }
            proc b::c::c {destination source} {}
            new [new b::c]
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc C {this} {
                        set ($this,x) 0
                    }
                    proc C {destination source} {}
                }
                new [new C]
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a constructor first argument must be this}\
    {class ::A constructor first argument must be this}\
    {class ::b::c constructor first argument must be this}\
    {class ::B::C constructor first argument must be this}\
]

test stooop-46 {
    check user defined cloning operation error checking
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this} {
                set ($this,x) 0
            }
            proc a::a {this copy dummy} {}
            new [new a]
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {
                    set ($this,x) 0
                }
                proc A {this copy dummy} {}
            }
            new [new A]
        } message
        lappend ::result $message

        catch {
            class b {}
            class b::c {}
            proc b::c::c {this} {
                set ($this,x) 0
            }
            proc b::c::c {this copy dummy} {}
            new [new b::c]
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc C {this} {
                        set ($this,x) 0
                    }
                    proc C {this copy dummy} {}
                }
                new [new C]
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a copy constructor must have 2 arguments exactly}\
    {class ::A copy constructor must have 2 arguments exactly}\
    {class ::b::c copy constructor must have 2 arguments exactly}\
    {class ::B::C copy constructor must have 2 arguments exactly}\
]

test stooop-47 {
    check normal and user defined cloning operation with multiple inheritance
    and member objects (see test 77 for nested class version)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p} {
            set ($this,m) $p
        }
        class b {}
        proc b::b {this p} {
            set ($this,n) $p
        }
        class c {}
        proc c::c {this p q r} a {$p} b {$q} {
            set ($this,o) $r
            set ($this,O) [new f]
        }
        proc c::c {this copy} a {$a::($copy,m)} b 1 {
            set ($this,o) $($copy,o)
            set ($this,O) [new f]
        }
        class d {}
        proc d::d {this p q r} a {$p} b {$q} {
            set ($this,p) $p
        }
        class e {}
        proc e::e {this p q r} c {$p $q $r} d {$q $q $r} {
            set ($this,q) $q
        }
        class f {}
        proc f::f {this} {
            set ($this,x) 0
        }
        new [new e {x y} z {1 2}]
        eval lappend ::result [dumpArrays a:: b:: c:: d:: e:: f::]

        class A {
            proc A {this p} {
                set ($this,m) $p
            }
        }
        class B {
            proc B {this p} {
                set ($this,n) $p
            }
        }
        class C {
            proc C {this p q r} A {$p} B {$q} {
                set ($this,o) $r
                set ($this,O) [new F]
            }
            proc C {this copy} A {$A::($copy,m)} B 1 {
                set ($this,o) $($copy,o)
                set ($this,O) [new F]
            }
        }
        class D {
            proc D {this p q r} A {$p} B {$q} {
                set ($this,p) $p
            }
        }
        class E {
            proc E {this p q r} C {$p $q $r} D {$q $q $r} {
                set ($this,q) $q
            }
        }
        class F {
            proc F {this} {
                set ($this,x) 0
            }
        }
        new [new E {x y} z {1 2}]
        eval lappend ::result [dumpArrays A:: B:: C:: D:: E:: F::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(1,_derived) = ::d}\
    {a::(1,m) = z}\
    {a::(3,_derived) = ::d}\
    {a::(3,m) = z}\
    {b::(1,_derived) = ::d}\
    {b::(1,n) = z}\
    {b::(3,_derived) = ::d}\
    {b::(3,n) = z}\
    {c::(1,O) = 2}\
    {c::(1,_derived) = ::e}\
    {c::(1,o) = 1 2}\
    {c::(3,O) = 4}\
    {c::(3,_derived) = ::e}\
    {c::(3,o) = 1 2}\
    {d::(1,_derived) = ::e}\
    {d::(1,p) = z}\
    {d::(3,_derived) = ::e}\
    {d::(3,p) = z}\
    {e::(1,q) = z}\
    {e::(3,q) = z}\
    {f::(2,x) = 0}\
    {f::(4,x) = 0}\
    {A::(5,_derived) = ::D}\
    {A::(5,m) = z}\
    {A::(7,_derived) = ::D}\
    {A::(7,m) = z}\
    {B::(5,_derived) = ::D}\
    {B::(5,n) = z}\
    {B::(7,_derived) = ::D}\
    {B::(7,n) = z}\
    {C::(5,O) = 6}\
    {C::(5,_derived) = ::E}\
    {C::(5,o) = 1 2}\
    {C::(7,O) = 8}\
    {C::(7,_derived) = ::E}\
    {C::(7,o) = 1 2}\
    {D::(5,_derived) = ::E}\
    {D::(5,p) = z}\
    {D::(7,_derived) = ::E}\
    {D::(7,p) = z}\
    {E::(5,q) = z}\
    {E::(7,q) = z}\
    {F::(6,x) = 0}\
    {F::(8,x) = 0}\
]

test stooop-48 {
    check basic cloning operation with array members
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            variable ${this}x
            set ${this}x(0) 0
            set ($this,y) 1
        }
        proc a::a {this copy} {
            variable ${this}x
            variable ${copy}x
            array set ${this}x [array get ${copy}x]
            set ($this,y) $($copy,y)
        }
        new [new a]
        eval lappend ::result [dumpArrays a:: a::1x a::2x]

        class A {
            proc A {this} {
                variable ${this}x
                set ${this}x(0) 0
                set ($this,y) 1
            }
            proc A {this copy} {
                variable ${this}x
                variable ${copy}x
                array set ${this}x [array get ${copy}x]
                set ($this,y) $($copy,y)
            }
        }
        new [new A]
        eval lappend ::result [dumpArrays A:: A::3x A::4x]

        class b {}
        class b::c {}
        proc b::c::c {this} {
            variable ${this}x
            set ${this}x(0) 0
            set ($this,y) 1
        }
        proc b::c::c {this copy} {
            variable ${this}x
            variable ${copy}x
            array set ${this}x [array get ${copy}x]
            set ($this,y) $($copy,y)
        }
        new [new b::c]
        eval lappend ::result [dumpArrays b::c:: b::c::5x b::c::6x]

        class B {
            class C {
                proc C {this} {
                    variable ${this}x
                    set ${this}x(0) 0
                    set ($this,y) 1
                }
                proc C {this copy} {
                    variable ${this}x
                    variable ${copy}x
                    array set ${this}x [array get ${copy}x]
                    set ($this,y) $($copy,y)
                }
            }
            new [new C]
            eval lappend ::result [dumpArrays C:: C::7x C::8x]
        }
        new [new B::C]
        eval lappend ::result [dumpArrays B::C:: B::C::9x B::C::10x]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(1,y) = 1}\
    {a::(2,y) = 1}\
    {a::1x(0) = 0}\
    {a::2x(0) = 0}\
    {A::(3,y) = 1}\
    {A::(4,y) = 1}\
    {A::3x(0) = 0}\
    {A::4x(0) = 0}\
    {b::c::(5,y) = 1}\
    {b::c::(6,y) = 1}\
    {b::c::5x(0) = 0}\
    {b::c::6x(0) = 0}\
    {C::(7,y) = 1}\
    {C::(8,y) = 1}\
    {C::7x(0) = 0}\
    {C::8x(0) = 0}\
    {B::C::(10,y) = 1}\
    {B::C::(7,y) = 1}\
    {B::C::(8,y) = 1}\
    {B::C::(9,y) = 1}\
    {B::C::9x(0) = 0}\
    {B::C::10x(0) = 0}\
]

test stooop-49 {
    check user defined cloning operation error checking
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this copy} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this copy} {}
            }
        } message
        lappend ::result $message

        catch {
            class b {}
            class b::c {}
            proc b::c::c {this copy} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc C {this copy} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a copy constructor defined before constructor}\
    {class ::A copy constructor defined before constructor}\
    {class ::b::c copy constructor defined before constructor}\
    {class ::B::C copy constructor defined before constructor}\
]

test stooop-50 {
    check copy constructor base class(es) initialization errors
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this p} {}
            class b {}
            proc b::b {this} a 0 {}
            proc b::b {this copy} {}
            new [new b]
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this p} {}
            }
            class B {
                proc B {this} A 0 {}
                proc B {this copy} {}
            }
            new [new B]
        } message
        lappend ::result $message

        catch {
            class c {}
            class c::d {}
            proc c::d::d {this p} {}
            class c::e {}
            proc c::e::e {this} c::d 0 {}
            proc c::e::e {this copy} {}
            new [new c::e]
        } message
        lappend ::result $message

        catch {
            class C {
                class D {
                    proc D {this p} {}
                }
                class E {
                    proc E {this} C::D 0 {}
                    proc E {this copy} {}
                }
                new [new E]
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {missing base class ::a constructor arguments from class ::b constructor}\
    {missing base class ::A constructor arguments from class ::B constructor}\
    {missing base class ::c::d constructor arguments from class ::c::e constructor}\
    {missing base class ::C::D constructor arguments from class ::C::E constructor}\
]

test stooop-51 {
    check that multiple declarations that can occur when a class declaration
    file is sourced multiple times have no adverse effects
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        class b {}
        proc b::b {this} a {} {}
        proc b::b {this} a {} {}

        class A {
            proc A {this} {}
        }
        class B {
            proc B {this} A {} {}
        }
        class B {
            proc B {this} A {} {}
        }

        class c {}
        class c::d {}
        proc c::d::d {this} {}
        class c::e {}
        proc c::e::e {this} c::d {} {}
        proc c::e::e {this} c::d {} {}

        class C {
            class D {
                proc D {this} {}
            }
            class E {
                proc E {this} C::D {} {}
            }
            class E {
                proc E {this} C::D {} {}
            }
        }

        set ::result {}
    }]
    interp delete $interpreter
    set result
} {}

test stooop-52 {
    check that member procedure cannot be defined before constructor
    declaration for we need ancestors for global ancestors array declaration
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::p {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc p {this} {}
            }
        } message
        lappend ::result $message

        catch {
            class b {}
            class b::c {}
            proc b::c::p {this} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc p {this} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a member procedure p defined before constructor}\
    {class ::A member procedure p defined before constructor}\
    {class ::b::c member procedure p defined before constructor}\
    {class ::B::C member procedure p defined before constructor}\
]

test stooop-53 {
    check that embedded command in base class constructor arguments does not
    interfere with variable number of arguments processing special case
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this p args} {}
        proc a::~a {this} {}
        class b {}
        proc b::b {this args} a {[list {}] $args} {}
        proc b::b {this args} a {[list {}] $args } {}
        proc b::b {this args} a {
            [list {}] $args
        } {}

        class A {
            proc A {this p args} {}
            proc ~A {this} {}
        }
        class B {
            proc B {this args} A {[list {}] $args} {}
            proc B {this args} A {[list {}] $args } {}
            proc B {this args} A {
                [list {}] $args
            } {}
        }

        class c {}
        class c::d {}
        proc c::d::d {this p args} {}
        proc c::d::~d {this} {}
        class c::e {}
        proc c::e::e {this args} c::d {[list {}] $args} {}
        proc c::e::e {this args} c::d {[list {}] $args } {}
        proc c::e::e {this args} c::d {
            [list {}] $args
        } {}

        class C {
            class D {
                proc D {this p args} {}
                proc ~D {this} {}
            }
            class E {
                proc E {this args} C::D {[list {}] $args} {}
                proc E {this args} C::D {[list {}] $args } {}
                proc E {this args} C::D {
                    [list {}] $args
                } {}
            }
        }

        set ::result {}
    }]
    interp delete $interpreter
    set result
} {}

test stooop-54 {
    check that virtual procedure invocations from base class constructor behave
    as in C++ (see test 78 for nested class version)
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            a::f $this x
            a::g $this x {y z}
            # pure virtual invocations behavior is undefined
            lappend ::result [catch {a::h $this x}]
            lappend ::result [catch {a::i $this x {y z}}]
        }
        proc a::~a {this} {}
        virtual proc a::f {this p} {
            lappend ::result "a::f $this $p"
        }
        virtual proc a::g {this p args} {
            lappend ::result "a::g $this $p $args"
        }
        virtual proc a::h {this p}
        virtual proc a::i {this p args}
        class b {}
        proc b::b {this} a {} {}
        proc b::~b {this} {}
        virtual proc b::f {this p} {
            lappend ::result "b::f $this $p"
        }
        virtual proc b::g {this p args} {
            lappend ::result "b::g $this $p $args"
        }
        virtual proc b::h {this p} {
            lappend ::result "b::h $this $p"
        }
        proc b::i {this p args} {
            lappend ::result "b::i $this $p $args"
        }
        new b

        class A {
            proc A {this} {
                A::f $this x
                A::g $this x {y z}
                # pure virtual invocations behavior is undefined
                lappend ::result [catch {A::h $this x}]
                lappend ::result [catch {A::i $this x {y z}}]
            }
            proc ~A {this} {}
            virtual proc f {this p} {
                lappend ::result "A::f $this $p"
            }
            virtual proc g {this p args} {
                lappend ::result "A::g $this $p $args"
            }
            virtual proc h {this p}
            virtual proc i {this p args}
        }
        class B {
            proc B {this} A {} {}
            proc ~B {this} {}
            virtual proc f {this p} {
                lappend ::result "B::f $this $p"
            }
            virtual proc g {this p args} {
                lappend ::result "B::g $this $p $args"
            }
            virtual proc h {this p} {
                lappend ::result "B::h $this $p"
            }
            proc i {this p args} {
                lappend ::result "B::i $this $p $args"
            }
        }
        new B

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::f 1 x}\
    {a::g 1 x {y z}}\
    {1}\
    {1}\
    {A::f 2 x}\
    {A::g 2 x {y z}}\
    {1}\
    {1}\
]

test stooop-55 {
    check that procedure invocation on variable arguments in derived class base
    class constructor arguments works
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p args} {
            lappend ::result "a::a $this $p $args"
            set ($this,m) [lindex $args 0]
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this p args} a {$p [concat $args]} {
            lappend ::result "b::b $this $p $args"
            set ($this,n) [lindex $args 0]
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        new b {x y} {1 2} 3
        eval lappend ::result [dumpArrays a:: b::]

        class A {
            proc A {this p args} {
                lappend ::result "A::A $this $p $args"
                set ($this,m) [lindex $args 0]
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this p args} A {$p [concat $args]} {
                lappend ::result "B::B $this $p $args"
                set ($this,n) [lindex $args 0]
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        new B {x y} {1 2} 3
        eval lappend ::result [dumpArrays A:: B::]

        class c {}
        class c::d {}
        proc c::d::d {this p args} {
            lappend ::result "d::d $this $p $args"
            set ($this,m) [lindex $args 0]
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class c::e {}
        proc c::e::e {this p args} c::d {$p [concat $args]} {
            lappend ::result "e::e $this $p $args"
            set ($this,n) [lindex $args 0]
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        new c::e {x y} {1 2} 3
        eval lappend ::result [dumpArrays c::d:: c::e::]

        class C {
            class D {
                proc D {this p args} {
                    lappend ::result "D::D $this $p $args"
                    set ($this,m) [lindex $args 0]
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this p args} C::D {$p [concat $args]} {
                    lappend ::result "E::E $this $p $args"
                    set ($this,n) [lindex $args 0]
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            new E {x y} {1 2} 3
            eval lappend ::result [dumpArrays D:: E::]
        }
        new C::E {x y} {1 2} 3
        eval lappend ::result [dumpArrays C::D:: C::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 x y {1 2} 3}\
    {b::b 1 x y {1 2} 3}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = 1 2}\
    {b::(1,n) = 1 2}\
    {A::A 2 x y {1 2} 3}\
    {B::B 2 x y {1 2} 3}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = 1 2}\
    {B::(2,n) = 1 2}\
    {d::d 3 x y {1 2} 3}\
    {e::e 3 x y {1 2} 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = 1 2}\
    {c::e::(3,n) = 1 2}\
    {D::D 4 x y {1 2} 3}\
    {E::E 4 x y {1 2} 3}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = 1 2}\
    {E::(4,n) = 1 2}\
    {D::D 5 x y {1 2} 3}\
    {E::E 5 x y {1 2} 3}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = 1 2}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = 1 2}\
    {C::E::(4,n) = 1 2}\
    {C::E::(5,n) = 1 2}\
]

test stooop-56 {
    check that procedure invocation on variable arguments in derived class base
    class constructor arguments works
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this args} {
            lappend ::result "a::a $this $args"
            set ($this,m) [lindex $args 0]
        }
        proc a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class b {}
        proc b::b {this args} a {[concat $args]} {
            lappend ::result "b::b $this $args"
            set ($this,n) [lindex $args 0]
        }
        proc b::~b {this} {
            lappend ::result "b::~b $this"
        }
        new b {1 2} 3
        eval lappend ::result [dumpArrays a:: b::]

        class A {
            proc A {this args} {
                lappend ::result "A::A $this $args"
                set ($this,m) [lindex $args 0]
            }
            proc ~A {this} {
                lappend ::result "A::~A $this"
            }
        }
        class B {
            proc B {this args} A {[concat $args]} {
                lappend ::result "B::B $this $args"
                set ($this,n) [lindex $args 0]
            }
            proc ~B {this} {
                lappend ::result "B::~B $this"
            }
        }
        new B {1 2} 3
        eval lappend ::result [dumpArrays A:: B::]

        class c {}
        class c::d {}
        proc c::d::d {this args} {
            lappend ::result "d::d $this $args"
            set ($this,m) [lindex $args 0]
        }
        proc c::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class c::e {}
        proc c::e::e {this args} c::d {[concat $args]} {
            lappend ::result "e::e $this $args"
            set ($this,n) [lindex $args 0]
        }
        proc c::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        new c::e {1 2} 3
        eval lappend ::result [dumpArrays c::d:: c::e::]

        class C {
            class D {
                proc D {this args} {
                    lappend ::result "D::D $this $args"
                    set ($this,m) [lindex $args 0]
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this args} C::D {[concat $args]} {
                    lappend ::result "E::E $this $args"
                    set ($this,n) [lindex $args 0]
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            new E {1 2} 3
            eval lappend ::result [dumpArrays D:: E::]
        }
        new C::E {1 2} 3
        eval lappend ::result [dumpArrays C::D:: C::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 {1 2} 3}\
    {b::b 1 {1 2} 3}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = 1 2}\
    {b::(1,n) = 1 2}\
    {A::A 2 {1 2} 3}\
    {B::B 2 {1 2} 3}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = 1 2}\
    {B::(2,n) = 1 2}\
    {d::d 3 {1 2} 3}\
    {e::e 3 {1 2} 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = 1 2}\
    {c::e::(3,n) = 1 2}\
    {D::D 4 {1 2} 3}\
    {E::E 4 {1 2} 3}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = 1 2}\
    {E::(4,n) = 1 2}\
    {D::D 5 {1 2} 3}\
    {E::E 5 {1 2} 3}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = 1 2}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = 1 2}\
    {C::E::(4,n) = 1 2}\
    {C::E::(5,n) = 1 2}\
]

test stooop-57 {
    check that variable arguments in derived class work with base class
    constructor constant arguments
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p} {
            lappend ::result "a::a $this $p"
            set ($this,m) $p
        }
        proc a::~a {this} {}
        class b {}
        proc b::b {this p args} a {$args} {
            lappend ::result "b::b $this $p $args"
        }
        proc b::~b {this} {}
        new b {x y} {1 2} 3
        eval lappend ::result [dumpArrays a::]

        class A {
            proc A {this p} {
                lappend ::result "A::A $this $p"
                set ($this,m) $p
            }
            proc ~A {this} {}
        }
        class B {
            proc B {this p args} A {$args} {
                lappend ::result "B::B $this $p $args"
            }
            proc ~B {this} {}
        }
        new B {x y} {1 2} 3
        eval lappend ::result [dumpArrays A::]

        class c {}
        class c::d {}
        proc c::d::d {this p} {
            lappend ::result "d::d $this $p"
            set ($this,m) $p
        }
        proc c::d::~d {this} {}
        class c::e {}
        proc c::e::e {this p args} c::d {$args} {
            lappend ::result "e::e $this $p $args"
        }
        proc c::e::~e {this} {}
        new c::e {x y} {1 2} 3
        eval lappend ::result [dumpArrays c::d::]

        class C {
            class D {
                proc D {this p} {
                    lappend ::result "D::D $this $p"
                    set ($this,m) $p
                }
                proc ~D {this} {}
            }
            class E {
                proc E {this p args} C::D {$args} {
                    lappend ::result "E::E $this $p $args"
                }
                proc ~E {this} {}
            }
            new E {x y} {1 2} 3
            eval lappend ::result [dumpArrays D::]
        }
        new C::E {x y} {1 2} 3
        eval lappend ::result [dumpArrays C::D::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 {1 2} 3}\
    {b::b 1 x y {1 2} 3}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = {1 2} 3}\
    {A::A 2 {1 2} 3}\
    {B::B 2 x y {1 2} 3}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = {1 2} 3}\
    {d::d 3 {1 2} 3}\
    {e::e 3 x y {1 2} 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = {1 2} 3}\
    {D::D 4 {1 2} 3}\
    {E::E 4 x y {1 2} 3}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = {1 2} 3}\
    {D::D 5 {1 2} 3}\
    {E::E 5 x y {1 2} 3}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = {1 2} 3}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = {1 2} 3}\
]

test stooop-58 {
    check that variable arguments in derived class work with base class
    constructor constant arguments
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p args} {
            lappend ::result "a::a $this $p $args"
            set ($this,m) [lindex $args 0]
        }
        proc a::~a {this} {}
        class b {}
        proc b::b {this p args} a {$p z} {
            lappend ::result "b::b $this $p $args"
            set ($this,n) [lindex $args 0]
        }
        proc b::~b {this} {}
        new b {x y} {1 2} 3
        eval lappend ::result [dumpArrays a::]

        class A {
            proc A {this p args} {
                lappend ::result "A::A $this $p $args"
                set ($this,m) [lindex $args 0]
            }
            proc ~A {this} {}
        }
        class B {
            proc B {this p args} A {$p z} {
                lappend ::result "B::B $this $p $args"
                set ($this,n) [lindex $args 0]
            }
            proc ~B {this} {}
        }
        new B {x y} {1 2} 3
        eval lappend ::result [dumpArrays A::]

        class c {}
        class c::d {}
        proc c::d::d {this p args} {
            lappend ::result "d::d $this $p $args"
            set ($this,m) [lindex $args 0]
        }
        proc c::d::~d {this} {}
        class c::e {}
        proc c::e::e {this p args} c::d {$p z} {
            lappend ::result "e::e $this $p $args"
            set ($this,n) [lindex $args 0]
        }
        proc c::e::~e {this} {}
        new c::e {x y} {1 2} 3
        eval lappend ::result [dumpArrays c::d::]

        class C {
            class D {
                proc D {this p args} {
                    lappend ::result "D::D $this $p $args"
                    set ($this,m) [lindex $args 0]
                }
                proc ~D {this} {}
            }
            class E {
                proc E {this p args} C::D {$p z} {
                    lappend ::result "E::E $this $p $args"
                    set ($this,n) [lindex $args 0]
                }
                proc ~E {this} {}
            }
            new E {x y} {1 2} 3
            eval lappend ::result [dumpArrays D::]
        }
        new C::E {x y} {1 2} 3
        eval lappend ::result [dumpArrays C::D::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 x y z}\
    {b::b 1 x y {1 2} 3}\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = z}\
    {A::A 2 x y z}\
    {B::B 2 x y {1 2} 3}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = z}\
    {d::d 3 x y z}\
    {e::e 3 x y {1 2} 3}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = z}\
    {D::D 4 x y z}\
    {E::E 4 x y {1 2} 3}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = z}\
    {D::D 5 x y z}\
    {E::E 5 x y {1 2} 3}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = z}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = z}\
]

test stooop-59 {
    check that construction, copy and deletion work transparently for variable
    context
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p} {
            upvar $p q
            eval lappend ::result [dumpArrays q]
        }
        proc a::a {this copy} {
            upvar d q
            eval lappend ::result [dumpArrays q]
        }
        proc a::~a {this} {
            upvar d q
            eval lappend ::result [dumpArrays q]
        }
        set d(0) 0
        set o [new a d]
        new $o
        delete $o

        class A {
            proc A {this p} {
                upvar $p q
                eval lappend ::result [dumpArrays q]
            }
            proc A {this copy} {
                upvar d q
                eval lappend ::result [dumpArrays q]
            }
            proc ~A {this} {
                upvar d q
                eval lappend ::result [dumpArrays q]
            }
        }
        set d(0) 1
        set o [new A d]
        new $o
        delete $o

        class b {}
        class b::c {}
        proc b::c::c {this p} {
            upvar $p q
            eval lappend ::result [dumpArrays q]
        }
        proc b::c::c {this copy} {
            upvar d q
            eval lappend ::result [dumpArrays q]
        }
        proc b::c::~c {this} {
            upvar d q
            eval lappend ::result [dumpArrays q]
        }
        set d(0) 2
        set o [new b::c d]
        new $o
        delete $o

        class B {
            class C {
                proc C {this p} {
                    upvar $p q
                    eval lappend ::result [dumpArrays q]
                }
                proc C {this copy} {
                    upvar d q
                    eval lappend ::result [dumpArrays q]
                }
                proc ~C {this} {
                    upvar d q
                    eval lappend ::result [dumpArrays q]
                }
            }
            set d(0) 3
            set o [new C d]
            new $o
            delete $o
        }
        set d(0) 4
        set o [new B::C d]
        new $o
        delete $o

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {q(0) = 0}\
    {q(0) = 0}\
    {q(0) = 0}\
    {q(0) = 1}\
    {q(0) = 1}\
    {q(0) = 1}\
    {q(0) = 2}\
    {q(0) = 2}\
    {q(0) = 2}\
    {q(0) = 3}\
    {q(0) = 3}\
    {q(0) = 3}\
    {q(0) = 4}\
    {q(0) = 4}\
    {q(0) = 4}\
]

test stooop-60 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a::p {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A::p {this} {}
            }
        } message
        lappend ::result $message

        catch {
            class b {}
            class b::c {}
            proc b::c::c::p {this} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc C::p {this} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {can't create procedure "a::a::p": unknown namespace}\
    {can't create procedure "A::p": unknown namespace}\
    {can't create procedure "b::c::c::p": unknown namespace}\
    {can't create procedure "C::p": unknown namespace}\
]

test stooop-61 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {new 1} ::result
        set ::result
    }]
    interp delete $interpreter
    set result
} {invalid object identifier 1}

test stooop-62 {
    check that multiple class definitions for the same class are possible
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {
            proc a {this} {}
            proc ~a {this} {}
        }
        proc a::p {this p} {
            set ($this,m) $p
        }
        class a {
            proc q {this} {
                lappend ::result $($this,m)
            }
        }
        set o [new a]
        a::p $o 0
        a::q $o

        class b {
            class c {
                proc c {this} {}
                proc ~c {this} {}
            }
            proc c::p {this p} {
                set ($this,m) $p
            }
            class c {
                proc q {this} {
                    lappend ::result $($this,m)
                }
            }
            set o [new c]
            c::p $o 0
            c::q $o
        }
        set o [new b::c]
        b::c::p $o 0
        b::c::q $o

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    0\
    0\
    0\
]

test stooop-63 {
    check that non qualified procedure invocation in derived class base class
    constructor arguments works
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        proc p {p} {error "::p invoked"}

        class a {}
        proc a::a {this p} {
            set ($this,m) $p
        }
        proc a::~a {this} {}
        class b {}
        proc b::b {this p} a {[p $p]} {
            set ($this,n) $p
        }
        proc b::~b {this} {}
        proc b::p {p} {
            return [incr p]
        }
        new b 0
        eval lappend ::result [dumpArrays a:: b::]

        class A {
            proc A {this p} {
                set ($this,m) $p
            }
            proc ~A {this} {}
        }
        class B {
            proc B {this p} A {[p $p]} {
                set ($this,n) $p
            }
            proc ~B {this} {}
            proc p {p} {
                return [incr p]
            }
        }
        new B 0
        eval lappend ::result [dumpArrays A:: B::]

        class c {}
        class c::d {}
        proc c::d::d {this p} {
            set ($this,m) $p
        }
        proc c::d::~d {this} {}
        class c::e {}
        proc c::e::e {this p} c::d {[p $p]} {
            set ($this,n) $p
        }
        proc c::e::~e {this} {}
        proc c::e::p {p} {
            return [incr p]
        }
        new c::e 0
        eval lappend ::result [dumpArrays c::d:: c::e::]

        class C {
            class D {
                proc D {this p} {
                    set ($this,m) $p
                }
                proc ~D {this} {}
            }
            class E {
                proc E {this p} C::D {[p $p]} {
                    set ($this,n) $p
                }
                proc ~E {this} {}
                proc p {p} {
                    return [incr p]
                }
            }
            new E 0
            eval lappend ::result [dumpArrays D:: E::]
        }
        new C::E 0
        eval lappend ::result [dumpArrays C::D:: C::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = 1}\
    {b::(1,n) = 0}\
    {A::(2,_derived) = ::B}\
    {A::(2,m) = 1}\
    {B::(2,n) = 0}\
    {c::d::(3,_derived) = ::c::e}\
    {c::d::(3,m) = 1}\
    {c::e::(3,n) = 0}\
    {D::(4,_derived) = ::C::E}\
    {D::(4,m) = 1}\
    {E::(4,n) = 0}\
    {C::D::(4,_derived) = ::C::E}\
    {C::D::(4,m) = 1}\
    {C::D::(5,_derived) = ::C::E}\
    {C::D::(5,m) = 1}\
    {C::E::(4,n) = 0}\
    {C::E::(5,n) = 0}\
]

test stooop-64 {
    check static member initialization within class body
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {
            set (l) {}
        }
        proc a::a {this} {
            lappend (l) $this
        }
        proc a::~a {this} {}
        new a
        new a
        eval lappend ::result [dumpArrays a::]

        class A {
            set A::(l) {}
            proc A {this} {
                lappend (l) $this
            }
            proc ~A {this} {}
        }
        new A
        new A
        eval lappend ::result [dumpArrays A::]

        class b {}
        class b::c {
            set (l) {}
        }
        proc b::c::c {this} {
            lappend (l) $this
        }
        proc b::c::~c {this} {}
        new b::c
        new b::c
        eval lappend ::result [dumpArrays b::c::]

        class B {
            class C {
                set (l) {}
                proc C {this} {
                    lappend (l) $this
                }
                proc ~C {this} {}
            }
            new C
            new C
            eval lappend ::result [dumpArrays C::]
        }
        new B::C
        new B::C
        eval lappend ::result [dumpArrays B::C::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(l) = 1 2}\
    {A::(l) = 3 4}\
    {b::c::(l) = 5 6}\
    {C::(l) = 7 8}\
    {B::C::(l) = 7 8 9 10}\
]

test stooop-65 {
    undocumented
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        catch {
            class a {}
            proc a::a {this} {}
            virtual proc a::a::p {this} {}
        } message
        lappend ::result $message

        catch {
            class A {
                proc A {this} {}
                virtual proc A::p {this} {}
            }
        } message
        lappend ::result $message

        catch {
            class b {}
            class b::c {}
            proc b::c::c {this} {}
            virtual proc b::c::c::p {this} {}
        } message
        lappend ::result $message

        catch {
            class B {
                class C {
                    proc C {this} {}
                    virtual proc C::p {this} {}
                }
            }
        } message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {procedure ::a::a::p class ::a::a is unknown}\
    {procedure ::A::A::p class ::A::A is unknown}\
    {procedure ::b::c::c::p class ::b::c::c is unknown}\
    {procedure ::B::C::C::p class ::B::C::C is unknown}\
]

test stooop-66 {
    check that nested class procedure definition works inside and outside
    nested class or namespace
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {
            class b {
                proc b {this} {}
                proc p {this} {
                    lappend ::result 1
                }
            }
            set o [new b]
            b::p $o
            proc b::p {this} {
                lappend ::result 2
            }
            b::p $o
        }

        namespace eval c {
            class b {
                proc b {this} {}
                proc p {this} {
                    lappend ::result 3
                }
            }
            set o [new b]
            b::p $o
            proc b::p {this} {
                lappend ::result 4
            }
            b::p $o
        }

        set o [new a::b]
        proc a::b::p {this} {
            lappend ::result 5
        }
        a::b::p $o

        set o [new c::b]
        proc c::b::p {this} {
            lappend ::result 6
        }
        c::b::p $o

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    1\
    2\
    3\
    4\
    5\
    6\
]

test stooop-67 {
    check that nested class procedure definition works inside a separate
    namespace and is free from interferences
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {
            proc a {this} {}
            proc p {this} {
                lappend ::result 1
            }
        }
        set o [new a]
        a::p $o

        namespace eval b {
            namespace eval a {}
            proc a::p {this} {
                lappend ::result 2
            }
        }
        a::p $o

        namespace eval c {
            proc ::a::p {this} {
                lappend ::result 3
            }
        }
        a::p $o

        namespace eval d {
            class a {
                proc a {this} {}
                proc p {this} {
                    lappend ::result 4
                }
            }
            set o [new a]
            a::p $o

            namespace eval b {
                namespace eval a {}
                proc a::p {this} {
                    lappend ::result 5
                }
            }
            a::p $o

            namespace eval c {
                proc ::d::a::p {this} {
                    lappend ::result 6
                }
            }
            a::p $o
        }

        class e {
            proc e {this} {}
            class a {
                proc a {this} {}
                proc p {this} {
                    lappend ::result 7
                }
            }
            set o [new a]
            a::p $o

            namespace eval b {
                namespace eval a {}
                proc a::p {this} {
                    lappend ::result 8
                }
            }
            a::p $o

            namespace eval c {
                proc ::e::a::p {this} {
                    lappend ::result 9
                }
            }
            a::p $o
        }

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    1\
    1\
    3\
    4\
    4\
    6\
    7\
    7\
    9\
]

test stooop-68 {
    check inheritance within a deep nested class hierarchy
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {
            proc a {this} {
                lappend ::result a::a
            }
            class b {
                proc b {this} a {} {
                    lappend ::result b::b
                }
                class c {
                    catch {
                        proc c {this} b {} {}
                    } message
                    lappend ::result $message
                    proc c {this} a::b {} {
                        lappend ::result c::c
                    }
                }
                new c
            }
        }

        namespace eval d {
            proc d {this} {
                lappend ::result d::d
            }
            namespace eval e {
                proc e {this} {
                    d::d $this
                    lappend ::result e::e
                }
                namespace eval f {
                    proc f {this} {
                        catch {
                            e::e $this
                        } message
                        lappend ::result $message
                        d::e::e $this
                        lappend ::result f::f
                    }
                }
                f::f 0
            }
        }

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class ::a::b::c constructor defined before base class b constructor}\
    {a::a}\
    {b::b}\
    {c::c}\
    {invalid command name "e::e"}\
    {d::d}\
    {e::e}\
    {f::f}\
]

test stooop-69 {
    check user defined cloning operation in nested class context
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        class a::b {}
        proc a::b::b {this} {
            set ($this,x) 0
        }
        proc a::b::b {this copy} {
            set ($this,x) [expr $($copy,x)+1]
        }
        new [new a::b]
        eval lappend ::result [dumpArrays a::b::]

        class A {
            proc A {this} {}
            class B {
                proc B {this} {
                    set ($this,x) 0
                }
                proc B {this copy} {
                    set ($this,x) [expr $($copy,x)+1]
                }
            }
            new [new B]
            eval lappend ::result [dumpArrays B::]
        }
        new [new A::B]
        eval lappend ::result [dumpArrays A::B::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::b::(1,x) = 0}\
    {a::b::(2,x) = 1}\
    {B::(3,x) = 0}\
    {B::(4,x) = 1}\
    {A::B::(3,x) = 0}\
    {A::B::(4,x) = 1}\
    {A::B::(5,x) = 0}\
    {A::B::(6,x) = 1}\
]

test stooop-70 {
    check basic cloning operation in nested class context
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        class a::b {}
        proc a::b::b {this} {
            set ($this,x) 0
        }
        new [new a::b]
        eval lappend ::result [dumpArrays a::b::]

        class A {
            proc A {this} {}
            class B {
                proc B {this} {
                    set ($this,x) 0
                }
            }
            new [new B]
            eval lappend ::result [dumpArrays B::]
        }
        new [new A::B]
        eval lappend ::result [dumpArrays A::B::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::b::(1,x) = 0}\
    {a::b::(2,x) = 0}\
    {B::(3,x) = 0}\
    {B::(4,x) = 0}\
    {A::B::(3,x) = 0}\
    {A::B::(4,x) = 0}\
    {A::B::(5,x) = 0}\
    {A::B::(6,x) = 0}\
]

test stooop-71 {
    check multiple inheritance construction order, destruction order and data
    deallocation with a common indirect base class
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class z {}
        class z::a {}
        proc z::a::a {this p} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc z::a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class z::b {}
        proc z::b::b {this p} {
            lappend ::result "b::b $this"
            set ($this,n) $p
        }
        proc z::b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class z::c {}
        proc z::c::c {this p q r} z::a {$p} z::b {$q} {
            lappend ::result "c::c $this"
            set ($this,o) $r
        }
        proc z::c::~c {this} {
            lappend ::result "c::~c $this"
        }
        class z::d {}
        proc z::d::d {this p q r} z::a {$p} z::b {$q} {
            lappend ::result "d::d $this"
            set ($this,p) $p
        }
        proc z::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class z::e {}
        proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} {
            lappend ::result "e::e $this"
            set ($this,q) $q
        }
        proc z::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        set o [new z::e {x y} z {1 2}]
        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::]
        delete $o
        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::]

        class Z {
            class A {
                proc A {this p} {
                    lappend ::result "A::A $this"
                    set ($this,m) $p
                }
                proc ~A {this} {
                    lappend ::result "A::~A $this"
                }
            }
            class B {
                proc B {this p} {
                    lappend ::result "B::B $this"
                    set ($this,n) $p
                }
                proc ~B {this} {
                    lappend ::result "B::~B $this"
                }
            }
            class C {
                proc C {this p q r} Z::A {$p} Z::B {$q} {
                    lappend ::result "C::C $this"
                    set ($this,o) $r
                }
                proc ~C {this} {
                    lappend ::result "C::~C $this"
                }
            }
            class D {
                proc D {this p q r} Z::A {$p} Z::B {$q} {
                    lappend ::result "D::D $this"
                    set ($this,p) $p
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} {
                    lappend ::result "E::E $this"
                    set ($this,q) $q
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            set o [new E {x y} z {1 2}]
            eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
            delete $o
            eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
        }
        set o [new Z::E {x y} z {1 2}]
        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::]
        delete $o
        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {c::c 1}\
    {a::a 1}\
    {b::b 1}\
    {d::d 1}\
    {e::e 1}\
    {z::a::(1,_derived) = ::z::d}\
    {z::a::(1,m) = z}\
    {z::b::(1,_derived) = ::z::d}\
    {z::b::(1,n) = z}\
    {z::c::(1,_derived) = ::z::e}\
    {z::c::(1,o) = 1 2}\
    {z::d::(1,_derived) = ::z::e}\
    {z::d::(1,p) = z}\
    {z::e::(1,q) = z}\
    {e::~e 1}\
    {d::~d 1}\
    {b::~b 1}\
    {a::~a 1}\
    {c::~c 1}\
    {b::~b 1}\
    {a::~a 1}\
    {A::A 2}\
    {B::B 2}\
    {C::C 2}\
    {A::A 2}\
    {B::B 2}\
    {D::D 2}\
    {E::E 2}\
    {A::(2,_derived) = ::Z::D}\
    {A::(2,m) = z}\
    {B::(2,_derived) = ::Z::D}\
    {B::(2,n) = z}\
    {C::(2,_derived) = ::Z::E}\
    {C::(2,o) = 1 2}\
    {D::(2,_derived) = ::Z::E}\
    {D::(2,p) = z}\
    {E::(2,q) = z}\
    {E::~E 2}\
    {D::~D 2}\
    {B::~B 2}\
    {A::~A 2}\
    {C::~C 2}\
    {B::~B 2}\
    {A::~A 2}\
    {A::A 3}\
    {B::B 3}\
    {C::C 3}\
    {A::A 3}\
    {B::B 3}\
    {D::D 3}\
    {E::E 3}\
    {Z::A::(3,_derived) = ::Z::D}\
    {Z::A::(3,m) = z}\
    {Z::B::(3,_derived) = ::Z::D}\
    {Z::B::(3,n) = z}\
    {Z::C::(3,_derived) = ::Z::E}\
    {Z::C::(3,o) = 1 2}\
    {Z::D::(3,_derived) = ::Z::E}\
    {Z::D::(3,p) = z}\
    {Z::E::(3,q) = z}\
    {E::~E 3}\
    {D::~D 3}\
    {B::~B 3}\
    {A::~A 3}\
    {C::~C 3}\
    {B::~B 3}\
    {A::~A 3}\
]

test stooop-72 {
    check that multiply inherited base classes constructors work with variable
    number of arguments
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class z {}
        class z::a {}
        proc z::a::a {this args} {
            lappend ::result "a::a $this $args"
            set ($this,m) [lindex $args 0]
        }
        class z::b {}
        proc z::b::b {this p} {
            lappend ::result "b::b $this $p"
            set ($this,n) $p
        }
        class z::c {}
        proc z::c::c {this p args} {
            lappend ::result "c::c $this $p $args"
            set ($this,o) $p
            set ($this,p) [lindex $args 0]
        }
        class z::d {}
        proc z::d::d {this p args} z::a {$args} z::b {$p} z::c {$p $args} {
            lappend ::result "d::d $this $p $args"
            set ($this,q) $p
            set ($this,r) [lindex $args 0]
        }
        new z::d {x y} {1 2} 3
        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d::]

        class Z {
            class A {
                proc A {this args} {
                    lappend ::result "A::A $this $args"
                    set ($this,m) [lindex $args 0]
                }
            }
            class B {
                proc B {this p} {
                    lappend ::result "B::B $this $p"
                    set ($this,n) $p
                }
            }
            class C {
                proc C {this p args} {
                    lappend ::result "C::C $this $p $args"
                    set ($this,o) $p
                    set ($this,p) [lindex $args 0]
                }
            }
            class D {
                proc D {this p args} Z::A {$args} Z::B {$p} Z::C {$p $args} {
                    lappend ::result "D::D $this $p $args"
                    set ($this,q) $p
                    set ($this,r) [lindex $args 0]
                }
            }
            new D {x y} {1 2} 3
            eval lappend ::result [dumpArrays A:: B:: C:: D::]
        }
        new Z::D {x y} {1 2} 3
        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1 {1 2} 3}\
    {b::b 1 x y}\
    {c::c 1 x y {1 2} 3}\
    {d::d 1 x y {1 2} 3}\
    {z::a::(1,_derived) = ::z::d}\
    {z::a::(1,m) = 1 2}\
    {z::b::(1,_derived) = ::z::d}\
    {z::b::(1,n) = x y}\
    {z::c::(1,_derived) = ::z::d}\
    {z::c::(1,o) = x y}\
    {z::c::(1,p) = 1 2}\
    {z::d::(1,q) = x y}\
    {z::d::(1,r) = 1 2}\
    {A::A 2 {1 2} 3}\
    {B::B 2 x y}\
    {C::C 2 x y {1 2} 3}\
    {D::D 2 x y {1 2} 3}\
    {A::(2,_derived) = ::Z::D}\
    {A::(2,m) = 1 2}\
    {B::(2,_derived) = ::Z::D}\
    {B::(2,n) = x y}\
    {C::(2,_derived) = ::Z::D}\
    {C::(2,o) = x y}\
    {C::(2,p) = 1 2}\
    {D::(2,q) = x y}\
    {D::(2,r) = 1 2}\
    {A::A 3 {1 2} 3}\
    {B::B 3 x y}\
    {C::C 3 x y {1 2} 3}\
    {D::D 3 x y {1 2} 3}\
    {Z::A::(2,_derived) = ::Z::D}\
    {Z::A::(2,m) = 1 2}\
    {Z::A::(3,_derived) = ::Z::D}\
    {Z::A::(3,m) = 1 2}\
    {Z::B::(2,_derived) = ::Z::D}\
    {Z::B::(2,n) = x y}\
    {Z::B::(3,_derived) = ::Z::D}\
    {Z::B::(3,n) = x y}\
    {Z::C::(2,_derived) = ::Z::D}\
    {Z::C::(2,o) = x y}\
    {Z::C::(2,p) = 1 2}\
    {Z::C::(3,_derived) = ::Z::D}\
    {Z::C::(3,o) = x y}\
    {Z::C::(3,p) = 1 2}\
    {Z::D::(2,q) = x y}\
    {Z::D::(2,r) = 1 2}\
    {Z::D::(3,q) = x y}\
    {Z::D::(3,r) = 1 2}\
]

test stooop-73 {
    check multiple inheritance destruction order and data deallocation with a
    common indirect base class
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class z {}
        class z::a {}
        proc z::a::a {this p} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc z::a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class z::b {}
        proc z::b::b {this p} {
            lappend ::result "b::b $this"
            set ($this,n) $p
        }
        proc z::b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class z::c {}
        proc z::c::c {this p q r} z::a {$p} z::b {$q} {
            lappend ::result "c::c $this"
            set ($this,o) $r
        }
        proc z::c::~c {this} {
            lappend ::result "c::~c $this"
        }
        class z::d {}
        proc z::d::d {this p q r} z::a {$p} z::b {$q} {
            lappend ::result "d::d $this"
            set ($this,p) $p
        }
        proc z::d::~d {this} {
            lappend ::result "d::~d $this"
        }
        class z::e {}
        proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} {
            lappend ::result "e::e $this"
            set ($this,q) $q
        }
        proc z::e::~e {this} {
            lappend ::result "e::~e $this"
        }
        set o [new z::e {x y} z {1 2}]
        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::]
        delete $o
        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::]

        class Z {
            class A {
                proc A {this p} {
                    lappend ::result "A::A $this"
                    set ($this,m) $p
                }
                proc ~A {this} {
                    lappend ::result "A::~A $this"
                }
            }
            class B {
                proc B {this p} {
                    lappend ::result "B::B $this"
                    set ($this,n) $p
                }
                proc ~B {this} {
                    lappend ::result "B::~B $this"
                }
            }
            class C {
                proc C {this p q r} Z::A {$p} Z::B {$q} {
                    lappend ::result "C::C $this"
                    set ($this,o) $r
                }
                proc ~C {this} {
                    lappend ::result "C::~C $this"
                }
            }
            class D {
                proc D {this p q r} Z::A {$p} Z::B {$q} {
                    lappend ::result "D::D $this"
                    set ($this,p) $p
                }
                proc ~D {this} {
                    lappend ::result "D::~D $this"
                }
            }
            class E {
                proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} {
                    lappend ::result "E::E $this"
                    set ($this,q) $q
                }
                proc ~E {this} {
                    lappend ::result "E::~E $this"
                }
            }
            set o [new E {x y} z {1 2}]
            eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
            delete $o
            eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
        }
        set o [new Z::E {x y} z {1 2}]
        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::]
        delete $o
        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {c::c 1}\
    {a::a 1}\
    {b::b 1}\
    {d::d 1}\
    {e::e 1}\
    {z::a::(1,_derived) = ::z::d}\
    {z::a::(1,m) = z}\
    {z::b::(1,_derived) = ::z::d}\
    {z::b::(1,n) = z}\
    {z::c::(1,_derived) = ::z::e}\
    {z::c::(1,o) = 1 2}\
    {z::d::(1,_derived) = ::z::e}\
    {z::d::(1,p) = z}\
    {z::e::(1,q) = z}\
    {e::~e 1}\
    {d::~d 1}\
    {b::~b 1}\
    {a::~a 1}\
    {c::~c 1}\
    {b::~b 1}\
    {a::~a 1}\
    {A::A 2}\
    {B::B 2}\
    {C::C 2}\
    {A::A 2}\
    {B::B 2}\
    {D::D 2}\
    {E::E 2}\
    {A::(2,_derived) = ::Z::D}\
    {A::(2,m) = z}\
    {B::(2,_derived) = ::Z::D}\
    {B::(2,n) = z}\
    {C::(2,_derived) = ::Z::E}\
    {C::(2,o) = 1 2}\
    {D::(2,_derived) = ::Z::E}\
    {D::(2,p) = z}\
    {E::(2,q) = z}\
    {E::~E 2}\
    {D::~D 2}\
    {B::~B 2}\
    {A::~A 2}\
    {C::~C 2}\
    {B::~B 2}\
    {A::~A 2}\
    {A::A 3}\
    {B::B 3}\
    {C::C 3}\
    {A::A 3}\
    {B::B 3}\
    {D::D 3}\
    {E::E 3}\
    {Z::A::(3,_derived) = ::Z::D}\
    {Z::A::(3,m) = z}\
    {Z::B::(3,_derived) = ::Z::D}\
    {Z::B::(3,n) = z}\
    {Z::C::(3,_derived) = ::Z::E}\
    {Z::C::(3,o) = 1 2}\
    {Z::D::(3,_derived) = ::Z::E}\
    {Z::D::(3,p) = z}\
    {Z::E::(3,q) = z}\
    {E::~E 3}\
    {D::~D 3}\
    {B::~B 3}\
    {A::~A 3}\
    {C::~C 3}\
    {B::~B 3}\
    {A::~A 3}\
]

test stooop-74 {
    check that optional arguments in constructors and multiple inheritance work
    together
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class z {}
        class z::a {}
        proc z::a::a {this {p 0}} {
            lappend ::result "a::a $this"
            set ($this,m) $p
        }
        proc z::a::~a {this} {
            lappend ::result "a::~a $this"
        }
        class z::b {}
        proc z::b::b {this {p 1}} {
            lappend ::result "b::b $this"
            set ($this,n) $p
        }
        proc z::b::~b {this} {
            lappend ::result "b::~b $this"
        }
        class z::c {}
        proc z::c::c {this {p 2} {q 3}} z::a {$p} z::b {$q} {
            lappend ::result "c::c $this"
            set ($this,o) $p
            set ($this,p) $q
        }
        proc z::c::~c {this} {
            lappend ::result "c::~c $this"
        }
        set o [new z::c {x y} z]
        eval lappend ::result [dumpArrays z::a:: z::b:: z::c::]
        delete $o
        set o [new z::c]
        eval lappend ::result [dumpArrays z::a:: z::b:: z::c::]

        class Z {
            class A {
                proc A {this {p 0}} {
                    lappend ::result "A::A $this"
                    set ($this,m) $p
                }
                proc ~A {this} {
                    lappend ::result "A::~A $this"
                }
            }
            class B {
                proc B {this {p 1}} {
                    lappend ::result "B::B $this"
                    set ($this,n) $p
                }
                proc ~B {this} {
                    lappend ::result "B::~B $this"
                }
            }
            class C {
                proc C {this {p 2} {q 3}} Z::A {$p} Z::B {$q} {
                    lappend ::result "C::C $this"
                    set ($this,o) $p
                    set ($this,p) $q
                }
                proc ~C {this} {
                    lappend ::result "C::~C $this"
                }
            }
            set o [new C {x y} z]
            eval lappend ::result [dumpArrays A:: B:: C::]
            delete $o
            set o [new C]
            eval lappend ::result [dumpArrays A:: B:: C::]
            delete $o
        }
        set o [new Z::C {x y} z]
        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C::]
        delete $o
        set o [new Z::C]
        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 1}\
    {c::c 1}\
    {z::a::(1,_derived) = ::z::c}\
    {z::a::(1,m) = x y}\
    {z::b::(1,_derived) = ::z::c}\
    {z::b::(1,n) = z}\
    {z::c::(1,o) = x y}\
    {z::c::(1,p) = z}\
    {c::~c 1}\
    {b::~b 1}\
    {a::~a 1}\
    {a::a 2}\
    {b::b 2}\
    {c::c 2}\
    {z::a::(2,_derived) = ::z::c}\
    {z::a::(2,m) = 2}\
    {z::b::(2,_derived) = ::z::c}\
    {z::b::(2,n) = 3}\
    {z::c::(2,o) = 2}\
    {z::c::(2,p) = 3}\
    {A::A 3}\
    {B::B 3}\
    {C::C 3}\
    {A::(3,_derived) = ::Z::C}\
    {A::(3,m) = x y}\
    {B::(3,_derived) = ::Z::C}\
    {B::(3,n) = z}\
    {C::(3,o) = x y}\
    {C::(3,p) = z}\
    {C::~C 3}\
    {B::~B 3}\
    {A::~A 3}\
    {A::A 4}\
    {B::B 4}\
    {C::C 4}\
    {A::(4,_derived) = ::Z::C}\
    {A::(4,m) = 2}\
    {B::(4,_derived) = ::Z::C}\
    {B::(4,n) = 3}\
    {C::(4,o) = 2}\
    {C::(4,p) = 3}\
    {C::~C 4}\
    {B::~B 4}\
    {A::~A 4}\
    {A::A 5}\
    {B::B 5}\
    {C::C 5}\
    {Z::A::(5,_derived) = ::Z::C}\
    {Z::A::(5,m) = x y}\
    {Z::B::(5,_derived) = ::Z::C}\
    {Z::B::(5,n) = z}\
    {Z::C::(5,o) = x y}\
    {Z::C::(5,p) = z}\
    {C::~C 5}\
    {B::~B 5}\
    {A::~A 5}\
    {A::A 6}\
    {B::B 6}\
    {C::C 6}\
    {Z::A::(6,_derived) = ::Z::C}\
    {Z::A::(6,m) = 2}\
    {Z::B::(6,_derived) = ::Z::C}\
    {Z::B::(6,n) = 3}\
    {Z::C::(6,o) = 2}\
    {Z::C::(6,p) = 3}\
]

test stooop-75 {
    check various virtual procedures configurations in a 3 level deep class
    hierarchy
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class z {}
        class z::a {}
        proc z::a::a {this} {}
        proc z::a::~a {this} {}
        virtual proc z::a::f {this p q} {}
        virtual proc z::a::g {this p q}
        virtual proc z::a::h {this p q} {
            lappend ::result "a::h $this $p $q"
        }
        virtual proc z::a::i {this p q} {
            lappend ::result "a::i $this $p $q"
        }
        virtual proc z::a::k {this p q}
        virtual proc z::a::l {this p q} {
            lappend ::result "a::l $this $p $q"
        }
        class z::b {}
        proc z::b::b {this} z::a {} {}
        proc z::b::~b {this} {}
        virtual proc z::b::f {this p q} {
            lappend ::result "b::f $this $p $q"
        }
        virtual proc z::b::g {this p q}
        virtual proc z::b::h {this p q} {
            lappend ::result "b::h $this $p $q"
        }
        proc z::b::i {this p q} {
            lappend ::result "b::i $this $p $q"
        }
        virtual proc z::b::k {this p q} {
            lappend ::result "b::k $this $p $q"
        }
        virtual proc z::b::l {this p q}
        class z::c {}
        proc z::c::c {this} z::b {} {}
        proc z::c::~c {this} {}
        proc z::c::f {this p q} {
            lappend ::result "c::f $this $p $q"
        }
        proc z::c::g {this p q} {
            lappend ::result "c::g $this $p $q"
        }
        proc z::c::i {this p q} {
            lappend ::result "c::i $this $p $q"
        }
        proc z::c::k {this p q} {
            lappend ::result "c::k $this $p $q"
        }
        proc z::c::l {this p q} {
            lappend ::result "c::l $this $p $q"
        }
        set o [new z::c]
        z::a::f $o x {y z}
        z::a::g $o x {y z}
        z::a::h $o x {y z}
        z::a::i $o x {y z}
        z::a::k $o x {y z}
        z::a::l $o x {y z}

        class Z {
            class A {
                proc A {this} {}
                proc ~A {this} {}
                virtual proc f {this p q} {}
                virtual proc g {this p q}
                virtual proc h {this p q} {
                    lappend ::result "A::h $this $p $q"
                }
                virtual proc i {this p q} {
                    lappend ::result "A::i $this $p $q"
                }
                virtual proc k {this p q}
                virtual proc l {this p q} {
                    lappend ::result "A::l $this $p $q"
                }
            }
            class B {
                proc B {this} Z::A {} {}
                proc ~B {this} {}
                virtual proc f {this p q} {
                    lappend ::result "B::f $this $p $q"
                }
                virtual proc g {this p q}
                virtual proc h {this p q} {
                    lappend ::result "B::h $this $p $q"
                }
                proc i {this p q} {
                    lappend ::result "B::i $this $p $q"
                }
                virtual proc k {this p q} {
                    lappend ::result "B::k $this $p $q"
                }
                virtual proc l {this p q}
            }
            class C {
                proc C {this} Z::B {} {}
                proc ~C {this} {}
                proc f {this p q} {
                    lappend ::result "C::f $this $p $q"
                }
                proc g {this p q} {
                    lappend ::result "C::g $this $p $q"
                }
                proc i {this p q} {
                    lappend ::result "C::i $this $p $q"
                }
                proc k {this p q} {
                    lappend ::result "C::k $this $p $q"
                }
                proc l {this p q} {
                    lappend ::result "C::l $this $p $q"
                }
            }
            set o [new C]
            A::f $o x {y z}
            A::g $o x {y z}
            A::h $o x {y z}
            A::i $o x {y z}
            A::k $o x {y z}
            A::l $o x {y z}
        }
        set o [new Z::C]
        Z::A::f $o x {y z}
        Z::A::g $o x {y z}
        Z::A::h $o x {y z}
        Z::A::i $o x {y z}
        Z::A::k $o x {y z}
        Z::A::l $o x {y z}

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {c::f 1 x y z}\
    {c::g 1 x y z}\
    {b::h 1 x y z}\
    {b::i 1 x y z}\
    {c::k 1 x y z}\
    {c::l 1 x y z}\
    {C::f 2 x y z}\
    {C::g 2 x y z}\
    {B::h 2 x y z}\
    {B::i 2 x y z}\
    {C::k 2 x y z}\
    {C::l 2 x y z}\
    {C::f 3 x y z}\
    {C::g 3 x y z}\
    {B::h 3 x y z}\
    {B::i 3 x y z}\
    {C::k 3 x y z}\
    {C::l 3 x y z}\
]

test stooop-76 {
    check various virtual procedures with variable number of arguments
    configurations in a 3 level deep class hierarchy
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class z {}
        class z::a {}
        proc z::a::a {this} {}
        proc z::a::~a {this} {}
        virtual proc z::a::f {this p args} {}
        virtual proc z::a::g {this p args}
        virtual proc z::a::h {this p args} {
            lappend ::result "a::h $this $p $args"
        }
        virtual proc z::a::i {this p args} {
            lappend ::result "a::i $this $p $args"
        }
        virtual proc z::a::k {this p args}
        virtual proc z::a::l {this p args} {
            lappend ::result "a::l $this $p $args"
        }
        class z::b {}
        proc z::b::b {this} z::a {} {}
        proc z::b::~b {this} {}
        virtual proc z::b::f {this p args} {
            lappend ::result "b::f $this $p $args"
        }
        virtual proc z::b::g {this p args}
        virtual proc z::b::h {this p args} {
            lappend ::result "b::h $this $p $args"
        }
        proc z::b::i {this p args} {
            lappend ::result "b::i $this $p $args"
        }
        virtual proc z::b::k {this p args} {
            lappend ::result "b::k $this $p $args"
        }
        virtual proc z::b::l {this p args}
        class z::c {}
        proc z::c::c {this} z::b {} {}
        proc z::c::~c {this} {}
        proc z::c::f {this p args} {
            lappend ::result "c::f $this $p $args"
        }
        proc z::c::g {this p args} {
            lappend ::result "c::g $this $p $args"
        }
        proc z::c::i {this p args} {
            lappend ::result "c::i $this $p $args"
        }
        proc z::c::k {this p args} {
            lappend ::result "c::k $this $p $args"
        }
        proc z::c::l {this p args} {
            lappend ::result "c::l $this $p $args"
        }
        set o [new z::c]
        z::a::f $o x {y z}
        z::a::g $o x {y z}
        z::a::h $o x {y z}
        z::a::i $o x {y z}
        z::a::k $o x {y z}
        z::a::l $o x {y z}

        class Z {
            class A {
                proc A {this} {}
                proc ~A {this} {}
                virtual proc f {this p args} {}
                virtual proc g {this p args}
                virtual proc h {this p args} {
                    lappend ::result "A::h $this $p $args"
                }
                virtual proc i {this p args} {
                    lappend ::result "A::i $this $p $args"
                }
                virtual proc k {this p args}
                virtual proc l {this p args} {
                    lappend ::result "A::l $this $p $args"
                }
            }
            class B {
                proc B {this} Z::A {} {}
                proc ~B {this} {}
                virtual proc f {this p args} {
                    lappend ::result "B::f $this $p $args"
                }
                virtual proc g {this p args}
                virtual proc h {this p args} {
                    lappend ::result "B::h $this $p $args"
                }
                proc i {this p args} {
                    lappend ::result "B::i $this $p $args"
                }
                virtual proc k {this p args} {
                    lappend ::result "B::k $this $p $args"
                }
                virtual proc l {this p args}
            }
            class C {
                proc C {this} Z::B {} {}
                proc ~C {this} {}
                proc f {this p args} {
                    lappend ::result "C::f $this $p $args"
                }
                proc g {this p args} {
                    lappend ::result "C::g $this $p $args"
                }
                proc i {this p args} {
                    lappend ::result "C::i $this $p $args"
                }
                proc k {this p args} {
                    lappend ::result "C::k $this $p $args"
                }
                proc l {this p args} {
                    lappend ::result "C::l $this $p $args"
                }
            }
            set o [new C]
            A::f $o x {y z}
            A::g $o x {y z}
            A::h $o x {y z}
            A::i $o x {y z}
            A::k $o x {y z}
            A::l $o x {y z}
        }
        set o [new Z::C]
        Z::A::f $o x {y z}
        Z::A::g $o x {y z}
        Z::A::h $o x {y z}
        Z::A::i $o x {y z}
        Z::A::k $o x {y z}
        Z::A::l $o x {y z}

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {c::f 1 x {y z}}\
    {c::g 1 x {y z}}\
    {b::h 1 x {y z}}\
    {b::i 1 x {y z}}\
    {c::k 1 x {y z}}\
    {c::l 1 x {y z}}\
    {C::f 2 x {y z}}\
    {C::g 2 x {y z}}\
    {B::h 2 x {y z}}\
    {B::i 2 x {y z}}\
    {C::k 2 x {y z}}\
    {C::l 2 x {y z}}\
    {C::f 3 x {y z}}\
    {C::g 3 x {y z}}\
    {B::h 3 x {y z}}\
    {B::i 3 x {y z}}\
    {C::k 3 x {y z}}\
    {C::l 3 x {y z}}\
]

test stooop-77 {
    check normal and user defined cloning operation with multiple inheritance
    and member objects
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class z {}
        class z::a {}
        proc z::a::a {this p} {
            set ($this,m) $p
        }
        class z::b {}
        proc z::b::b {this p} {
            set ($this,n) $p
        }
        class z::c {}
        proc z::c::c {this p q r} z::a {$p} z::b {$q} {
            set ($this,o) $r
            set ($this,O) [new z::f]
        }
        proc z::c::c {this copy} z::a {$z::a::($copy,m)} z::b 1 {
            set ($this,o) $($copy,o)
            set ($this,O) [new z::f]
        }
        class z::d {}
        proc z::d::d {this p q r} z::a {$p} z::b {$q} {
            set ($this,p) $p
        }
        class z::e {}
        proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} {
            set ($this,q) $q
        }
        class z::f {}
        proc z::f::f {this} {
            set ($this,x) 0
        }
        new [new z::e {x y} z {1 2}]
        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e:: z::f::]

        class Z {
            class A {
                proc A {this p} {
                    set ($this,m) $p
                }
            }
            class B {
                proc B {this p} {
                    set ($this,n) $p
                }
            }
            class C {
                proc C {this p q r} Z::A {$p} Z::B {$q} {
                    set ($this,o) $r
                    set ($this,O) [new Z::F]
                }
                proc C {this copy} Z::A {$Z::A::($copy,m)} Z::B 1 {
                    set ($this,o) $($copy,o)
                    set ($this,O) [new Z::F]
                }
            }
            class D {
                proc D {this p q r} Z::A {$p} Z::B {$q} {
                    set ($this,p) $p
                }
            }
            class E {
                proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} {
                    set ($this,q) $q
                }
            }
            class F {
                proc F {this} {
                    set ($this,x) 0
                }
            }
            new [new E {x y} z {1 2}]
            eval lappend ::result [dumpArrays A:: B:: C:: D:: E:: F::]
        }
        new [new Z::E {x y} z {1 2}]
        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E:: Z::F::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {z::a::(1,_derived) = ::z::d}\
    {z::a::(1,m) = z}\
    {z::a::(3,_derived) = ::z::d}\
    {z::a::(3,m) = z}\
    {z::b::(1,_derived) = ::z::d}\
    {z::b::(1,n) = z}\
    {z::b::(3,_derived) = ::z::d}\
    {z::b::(3,n) = z}\
    {z::c::(1,O) = 2}\
    {z::c::(1,_derived) = ::z::e}\
    {z::c::(1,o) = 1 2}\
    {z::c::(3,O) = 4}\
    {z::c::(3,_derived) = ::z::e}\
    {z::c::(3,o) = 1 2}\
    {z::d::(1,_derived) = ::z::e}\
    {z::d::(1,p) = z}\
    {z::d::(3,_derived) = ::z::e}\
    {z::d::(3,p) = z}\
    {z::e::(1,q) = z}\
    {z::e::(3,q) = z}\
    {z::f::(2,x) = 0}\
    {z::f::(4,x) = 0}\
    {A::(5,_derived) = ::Z::D}\
    {A::(5,m) = z}\
    {A::(7,_derived) = ::Z::D}\
    {A::(7,m) = z}\
    {B::(5,_derived) = ::Z::D}\
    {B::(5,n) = z}\
    {B::(7,_derived) = ::Z::D}\
    {B::(7,n) = z}\
    {C::(5,O) = 6}\
    {C::(5,_derived) = ::Z::E}\
    {C::(5,o) = 1 2}\
    {C::(7,O) = 8}\
    {C::(7,_derived) = ::Z::E}\
    {C::(7,o) = 1 2}\
    {D::(5,_derived) = ::Z::E}\
    {D::(5,p) = z}\
    {D::(7,_derived) = ::Z::E}\
    {D::(7,p) = z}\
    {E::(5,q) = z}\
    {E::(7,q) = z}\
    {F::(6,x) = 0}\
    {F::(8,x) = 0}\
    {Z::A::(11,_derived) = ::Z::D}\
    {Z::A::(11,m) = z}\
    {Z::A::(5,_derived) = ::Z::D}\
    {Z::A::(5,m) = z}\
    {Z::A::(7,_derived) = ::Z::D}\
    {Z::A::(7,m) = z}\
    {Z::A::(9,_derived) = ::Z::D}\
    {Z::A::(9,m) = z}\
    {Z::B::(11,_derived) = ::Z::D}\
    {Z::B::(11,n) = z}\
    {Z::B::(5,_derived) = ::Z::D}\
    {Z::B::(5,n) = z}\
    {Z::B::(7,_derived) = ::Z::D}\
    {Z::B::(7,n) = z}\
    {Z::B::(9,_derived) = ::Z::D}\
    {Z::B::(9,n) = z}\
    {Z::C::(11,O) = 12}\
    {Z::C::(11,_derived) = ::Z::E}\
    {Z::C::(11,o) = 1 2}\
    {Z::C::(5,O) = 6}\
    {Z::C::(5,_derived) = ::Z::E}\
    {Z::C::(5,o) = 1 2}\
    {Z::C::(7,O) = 8}\
    {Z::C::(7,_derived) = ::Z::E}\
    {Z::C::(7,o) = 1 2}\
    {Z::C::(9,O) = 10}\
    {Z::C::(9,_derived) = ::Z::E}\
    {Z::C::(9,o) = 1 2}\
    {Z::D::(11,_derived) = ::Z::E}\
    {Z::D::(11,p) = z}\
    {Z::D::(5,_derived) = ::Z::E}\
    {Z::D::(5,p) = z}\
    {Z::D::(7,_derived) = ::Z::E}\
    {Z::D::(7,p) = z}\
    {Z::D::(9,_derived) = ::Z::E}\
    {Z::D::(9,p) = z}\
    {Z::E::(11,q) = z}\
    {Z::E::(5,q) = z}\
    {Z::E::(7,q) = z}\
    {Z::E::(9,q) = z}\
    {Z::F::(10,x) = 0}\
    {Z::F::(12,x) = 0}\
    {Z::F::(6,x) = 0}\
    {Z::F::(8,x) = 0}\
]

test stooop-78 {
    check that virtual procedure invocations from base class constructor behave
    as in C++
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class z {}
        class z::a {}
        proc z::a::a {this} {
            z::a::f $this x
            z::a::g $this x {y z}
            # pure virtual invocations behavior is undefined
            lappend ::result [catch {z::a::h $this x}]
            lappend ::result [catch {z::a::i $this x {y z}}]
        }
        proc z::a::~a {this} {}
        virtual proc z::a::f {this p} {
            lappend ::result "a::f $this $p"
        }
        virtual proc z::a::g {this p args} {
            lappend ::result "a::g $this $p $args"
        }
        virtual proc z::a::h {this p}
        virtual proc z::a::i {this p args}
        class z::b {}
        proc z::b::b {this} z::a {} {}
        proc z::b::~b {this} {}
        virtual proc z::b::f {this p} {
            lappend ::result "b::f $this $p"
        }
        virtual proc z::b::g {this p args} {
            lappend ::result "b::g $this $p $args"
        }
        virtual proc z::b::h {this p} {
            lappend ::result "b::h $this $p"
        }
        proc z::b::i {this p args} {
            lappend ::result "b::i $this $p $args"
        }
        new z::b

        class Z {
            class A {
                proc A {this} {
                    f $this x
                    g $this x {y z}
                    # pure virtual invocations behavior is undefined
                    lappend ::result [catch {A::h $this x}]
                    lappend ::result [catch {A::i $this x {y z}}]
                }
                proc ~A {this} {}
                virtual proc f {this p} {
                    lappend ::result "A::f $this $p"
                }
                virtual proc g {this p args} {
                    lappend ::result "A::g $this $p $args"
                }
                virtual proc h {this p}
                virtual proc i {this p args}
            }
            class B {
                proc B {this} Z::A {} {}
                proc ~B {this} {}
                virtual proc f {this p} {
                    lappend ::result "B::f $this $p"
                }
                virtual proc g {this p args} {
                    lappend ::result "B::g $this $p $args"
                }
                virtual proc h {this p} {
                    lappend ::result "B::h $this $p"
                }
                proc i {this p args} {
                    lappend ::result "B::i $this $p $args"
                }
            }
            new B
        }
        new Z::B

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::f 1 x}\
    {a::g 1 x {y z}}\
    {1}\
    {1}\
    {A::f 2 x}\
    {A::g 2 x {y z}}\
    {1}\
    {1}\
    {A::f 3 x}\
    {A::g 3 x {y z}}\
    {1}\
    {1}\
]

test stooop-79 {
    check that child nested class is visible within parent namespace
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            lappend ::result "a::a $this"
            new b
        }
        class a::b {}
        proc a::b::b {this} {
            lappend ::result "b::b $this"
        }
        new a

        class a {
            proc a {this} {
                lappend ::result "a::a $this"
                new b
            }
            class b {
                proc b {this} {
                    lappend ::result "b::b $this"
                }
            }
            new a
        }

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {b::b 2}\
    {a::a 3}\
    {b::b 4}\
]

test stooop-80 {
    verify regular member procedure checking in procedure checking debug mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKPROCEDURES) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::p {this} {}
        class b {}
        proc b::b {this} {}
        proc b::p {this} {}
        set o [new a]
        a::p $o
        catch {b::p $o} message
        lappend ::result $message

        class A {
            proc A {this} {}
            proc p {this} {}
        }
        class B {
            proc B {this} {}
            proc p {this} {}
        }
        set o [new A]
        A::p $o
        catch {B::p $o} message
        lappend ::result $message

        class c {}
        class c::d {}
        proc c::d::d {this} {}
        proc c::d::p {this} {}
        class c::e {}
        proc c::e::e {this} {}
        proc c::e::p {this} {}
        set o [new c::d]
        c::d::p $o
        catch {c::e::p $o} message
        lappend ::result $message

        class C {
            class D {
                proc D {this} {}
                proc p {this} {}
            }
            class E {
                proc E {this} {}
                proc p {this} {}
            }
            set o [new D]
            D::p $o
            catch {E::p $o} message
            lappend ::result $message
        }
        set o [new C::D]
        C::D::p $o
        catch {C::E::p $o} message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class b of ::b::p procedure not an ancestor of object 1 class a}\
    {class B of ::B::p procedure not an ancestor of object 2 class A}\
    {class c::e of ::c::e::p procedure not an ancestor of object 3 class c::d}\
    {class C::E of ::C::E::p procedure not an ancestor of object 4 class C::D}\
    {class C::E of ::C::E::p procedure not an ancestor of object 5 class C::D}\
]

test stooop-81 {
    verify regular member procedure checking within class hierarchy in
    procedure checking debug mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKPROCEDURES) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        proc a::p {this} {}
        class b {}
        proc b::b {this} a {} {}
        proc b::~b {this} {}
        proc b::p {this} {}
        class c {}
        proc c::c {this} b {} {}
        proc c::~c {this} {}
        proc c::p {this} {}
        set o [new a]
        a::p $o
        catch {b::p $o} message
        lappend ::result $message
        catch {c::p $o} message
        lappend ::result $message
        delete $o
        set o [new b]
        a::p $o
        b::p $o
        catch {c::p $o} message
        lappend ::result $message
        delete $o
        set o [new c]
        a::p $o
        b::p $o
        c::p $o
        delete $o

        class a {
            proc a {this} {}
            proc ~a {this} {}
            proc p {this} {}
        }
        class b {
            proc b {this} a {} {}
            proc ~b {this} {}
            proc p {this} {}
        }
        class c {
            proc c {this} b {} {}
            proc ~c {this} {}
            proc p {this} {}
        }
        set o [new a]
        a::p $o
        catch {b::p $o} message
        lappend ::result $message
        catch {c::p $o} message
        lappend ::result $message
        delete $o
        set o [new b]
        a::p $o
        b::p $o
        catch {c::p $o} message
        lappend ::result $message
        delete $o
        set o [new c]
        a::p $o
        b::p $o
        c::p $o
        delete $o

        class d {}
        class d::e {}
        proc d::e::e {this} {}
        proc d::e::~e {this} {}
        proc d::e::p {this} {}
        class d::f {}
        proc d::f::f {this} d::e {} {}
        proc d::f::~f {this} {}
        proc d::f::p {this} {}
        class d::g {}
        proc d::g::g {this} d::f {} {}
        proc d::g::~g {this} {}
        proc d::g::p {this} {}
        set o [new d::e]
        d::e::p $o
        catch {d::f::p $o} message
        lappend ::result $message
        catch {d::g::p $o} message
        lappend ::result $message
        delete $o
        set o [new d::f]
        d::e::p $o
        d::f::p $o
        catch {d::g::p $o} message
        lappend ::result $message
        delete $o
        set o [new d::g]
        d::e::p $o
        d::f::p $o
        d::g::p $o
        delete $o

        class C {
            class D {
                proc D {this} {}
                proc ~D {this} {}
                proc p {this} {}
            }
            class E {
                proc E {this} C::D {} {}
                proc ~E {this} {}
                proc p {this} {}
            }
            class F {
                proc F {this} C::E {} {}
                proc ~F {this} {}
                proc p {this} {}
            }
            set o [new D]
            D::p $o
            catch {E::p $o} message
            lappend ::result $message
            catch {F::p $o} message
            lappend ::result $message
            delete $o
            set o [new E]
            D::p $o
            E::p $o
            catch {F::p $o} message
            lappend ::result $message
            delete $o
            set o [new F]
            D::p $o
            E::p $o
            F::p $o
            delete $o
        }
        set o [new C::D]
        C::D::p $o
        catch {C::E::p $o} message
        lappend ::result $message
        catch {C::F::p $o} message
        lappend ::result $message
        delete $o
        set o [new C::E]
        C::D::p $o
        C::E::p $o
        catch {C::F::p $o} message
        lappend ::result $message
        delete $o
        set o [new C::F]
        C::D::p $o
        C::E::p $o
        C::F::p $o
        delete $o

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class b of ::b::p procedure not an ancestor of object 1 class a}\
    {class c of ::c::p procedure not an ancestor of object 1 class a}\
    {class c of ::c::p procedure not an ancestor of object 2 class b}\
    {class b of ::b::p procedure not an ancestor of object 4 class a}\
    {class c of ::c::p procedure not an ancestor of object 4 class a}\
    {class c of ::c::p procedure not an ancestor of object 5 class b}\
    {class d::f of ::d::f::p procedure not an ancestor of object 7 class d::e}\
    {class d::g of ::d::g::p procedure not an ancestor of object 7 class d::e}\
    {class d::g of ::d::g::p procedure not an ancestor of object 8 class d::f}\
    {class C::E of ::C::E::p procedure not an ancestor of object 10 class C::D}\
    {class C::F of ::C::F::p procedure not an ancestor of object 10 class C::D}\
    {class C::F of ::C::F::p procedure not an ancestor of object 11 class C::E}\
    {class C::E of ::C::E::p procedure not an ancestor of object 13 class C::D}\
    {class C::F of ::C::F::p procedure not an ancestor of object 13 class C::D}\
    {class C::F of ::C::F::p procedure not an ancestor of object 14 class C::E}\
]

test stooop-82 {
    verify regular member procedure checking within multiple inheritance class
    hierarchy in procedure checking debug mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKPROCEDURES) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::p {this} {}
        class b {}
        proc b::b {this} {}
        proc b::p {this} {}
        class c {}
        proc c::c {this} a {} b {} {}
        proc c::p {this} {}
        set o [new a]
        a::p $o
        catch {b::p $o} message
        lappend ::result $message
        catch {c::p $o} message
        lappend ::result $message

        class A {
            proc A {this} {}
            proc p {this} {}
        }
        class B {
            proc B {this} {}
            proc p {this} {}
        }
        class C {
            proc C {this} A {} B {} {}
            proc p {this} {}
        }
        set o [new A]
        A::p $o
        catch {B::p $o} message
        lappend ::result $message
        catch {C::p $o} message
        lappend ::result $message

        class d {}
        class d::e {}
        proc d::e::e {this} {}
        proc d::e::p {this} {}
        class d::f {}
        proc d::f::f {this} {}
        proc d::f::p {this} {}
        class d::g {}
        proc d::g::g {this} d::e {} d::f {} {}
        proc d::g::p {this} {}
        set o [new d::e]
        d::e::p $o
        catch {d::f::p $o} message
        lappend ::result $message
        catch {d::g::p $o} message
        lappend ::result $message

        class D {
            class E {
                proc E {this} {}
                proc p {this} {}
            }
            class F {
                proc F {this} {}
                proc p {this} {}
            }
            class G {
                proc G {this} D::E {} D::F {} {}
                proc p {this} {}
            }
            set o [new E]
            E::p $o
            catch {F::p $o} message
            lappend ::result $message
            catch {G::p $o} message
            lappend ::result $message
        }
        set o [new D::E]
        D::E::p $o
        catch {D::F::p $o} message
        lappend ::result $message
        catch {D::G::p $o} message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {class b of ::b::p procedure not an ancestor of object 1 class a}\
    {class c of ::c::p procedure not an ancestor of object 1 class a}\
    {class B of ::B::p procedure not an ancestor of object 2 class A}\
    {class C of ::C::p procedure not an ancestor of object 2 class A}\
    {class d::f of ::d::f::p procedure not an ancestor of object 3 class d::e}\
    {class d::g of ::d::g::p procedure not an ancestor of object 3 class d::e}\
    {class D::F of ::D::F::p procedure not an ancestor of object 4 class D::E}\
    {class D::G of ::D::G::p procedure not an ancestor of object 4 class D::E}\
    {class D::F of ::D::F::p procedure not an ancestor of object 5 class D::E}\
    {class D::G of ::D::G::p procedure not an ancestor of object 5 class D::E}\
]

test stooop-83 {
    verify object identifier checking in procedure checking debug mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKPROCEDURES) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::p {this} {}
        catch {a::p 1} message
        lappend ::result $message

        class A {
            proc A {this} {}
            proc p {this} {}
        }
        catch {A::p 2} message
        lappend ::result $message

        class b {}
        class b::c {}
        proc b::c::c {this} {}
        proc b::c::p {this} {}
        catch {b::c::p 3} message
        lappend ::result $message

        class B {
            class C {
                proc C {this} {}
                proc p {this} {}
            }
            catch {C::p 4} message
            lappend ::result $message
        }
        catch {B::C::p 5} message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {1 is not a valid object identifier}\
    {2 is not a valid object identifier}\
    {3 is not a valid object identifier}\
    {4 is not a valid object identifier}\
    {5 is not a valid object identifier}\
]

test stooop-84 {
    verify virtual member procedure checking in procedure checking debug mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKPROCEDURES) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        virtual proc a::p {this} {
            lappend ::result "a::p $this"
        }
        virtual proc a::q {this}
        virtual proc a::r {this} {
            lappend ::result "a::r $this"
        }
        class b {}
        proc b::b {this} a {} {}
        proc b::~b {this} {}
        proc b::p {this} {
            lappend ::result "b::p $this"
        }
        proc b::q {this} {
            lappend ::result "b::q $this"
        }
        set o [new b]
        a::p $o
        a::q $o
        a::r $o
        b::p $o
        b::q $o
        delete $o
        catch {a::p $o} message; lappend ::result $message
        catch {a::q $o} message; lappend ::result $message
        catch {a::r $o} message; lappend ::result $message
        catch {b::p $o} message; lappend ::result $message
        catch {b::q $o} message; lappend ::result $message

        class A {
            proc A {this} {}
            proc ~A {this} {}
            virtual proc p {this} {
                lappend ::result "A::p $this"
            }
            virtual proc q {this}
            virtual proc r {this} {
                lappend ::result "A::r $this"
            }
        }
        class B {
            proc B {this} A {} {}
            proc ~B {this} {}
            proc p {this} {
                lappend ::result "B::p $this"
            }
            proc q {this} {
                lappend ::result "B::q $this"
            }
        }
        set o [new B]
        A::p $o
        A::q $o
        A::r $o
        B::p $o
        B::q $o
        delete $o
        catch {A::p $o} message; lappend ::result $message
        catch {A::q $o} message; lappend ::result $message
        catch {A::r $o} message; lappend ::result $message
        catch {B::p $o} message; lappend ::result $message
        catch {B::q $o} message; lappend ::result $message

        class c {}
        class c::d {}
        proc c::d::d {this} {}
        proc c::d::~d {this} {}
        virtual proc c::d::p {this} {
            lappend ::result "d::p $this"
        }
        virtual proc c::d::q {this}
        virtual proc c::d::r {this} {
            lappend ::result "d::r $this"
        }
        class c::e {}
        proc c::e::e {this} c::d {} {}
        proc c::e::~e {this} {}
        proc c::e::p {this} {
            lappend ::result "e::p $this"
        }
        proc c::e::q {this} {
            lappend ::result "e::q $this"
        }
        set o [new c::e]
        c::d::p $o
        c::d::q $o
        c::d::r $o
        c::e::p $o
        c::e::q $o
        delete $o
        catch {c::d::p $o} message; lappend ::result $message
        catch {c::d::q $o} message; lappend ::result $message
        catch {c::d::r $o} message; lappend ::result $message
        catch {c::e::p $o} message; lappend ::result $message
        catch {c::e::q $o} message; lappend ::result $message

        class C {
            class D {
                proc D {this} {}
                proc ~D {this} {}
                virtual proc p {this} {
                    lappend ::result "D::p $this"
                }
                virtual proc q {this}
                virtual proc r {this} {
                    lappend ::result "D::r $this"
                }
            }
            class E {
                proc E {this} C::D {} {}
                proc ~E {this} {}
                proc p {this} {
                    lappend ::result "E::p $this"
                }
                proc q {this} {
                    lappend ::result "E::q $this"
                }
            }
            set o [new E]
            D::p $o
            D::q $o
            D::r $o
            E::p $o
            E::q $o
            delete $o
            catch {D::p $o} message; lappend ::result $message
            catch {D::q $o} message; lappend ::result $message
            catch {D::r $o} message; lappend ::result $message
            catch {E::p $o} message; lappend ::result $message
            catch {E::q $o} message; lappend ::result $message
        }
        set o [new C::E]
        C::D::p $o
        C::D::q $o
        C::D::r $o
        C::E::p $o
        C::E::q $o
        delete $o
        catch {C::D::p $o} message; lappend ::result $message
        catch {C::D::q $o} message; lappend ::result $message
        catch {C::D::r $o} message; lappend ::result $message
        catch {C::E::p $o} message; lappend ::result $message
        catch {C::E::q $o} message; lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {b::p 1}\
    {b::q 1}\
    {a::r 1}\
    {b::p 1}\
    {b::q 1}\
    {1 is not a valid object identifier}\
    {1 is not a valid object identifier}\
    {1 is not a valid object identifier}\
    {1 is not a valid object identifier}\
    {1 is not a valid object identifier}\
    {B::p 2}\
    {B::q 2}\
    {A::r 2}\
    {B::p 2}\
    {B::q 2}\
    {2 is not a valid object identifier}\
    {2 is not a valid object identifier}\
    {2 is not a valid object identifier}\
    {2 is not a valid object identifier}\
    {2 is not a valid object identifier}\
    {e::p 3}\
    {e::q 3}\
    {d::r 3}\
    {e::p 3}\
    {e::q 3}\
    {3 is not a valid object identifier}\
    {3 is not a valid object identifier}\
    {3 is not a valid object identifier}\
    {3 is not a valid object identifier}\
    {3 is not a valid object identifier}\
    {E::p 4}\
    {E::q 4}\
    {D::r 4}\
    {E::p 4}\
    {E::q 4}\
    {4 is not a valid object identifier}\
    {4 is not a valid object identifier}\
    {4 is not a valid object identifier}\
    {4 is not a valid object identifier}\
    {4 is not a valid object identifier}\
    {E::p 5}\
    {E::q 5}\
    {D::r 5}\
    {E::p 5}\
    {E::q 5}\
    {5 is not a valid object identifier}\
    {5 is not a valid object identifier}\
    {5 is not a valid object identifier}\
    {5 is not a valid object identifier}\
    {5 is not a valid object identifier}\
]

test stooop-85 {
    verify pure interface class object creation in procedure checking debug mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKPROCEDURES) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            lappend ::result "a::a $this"
        }
        proc a::~a {this} {}
        virtual proc a::p {this} {}
        set o [new a]
        delete $o
        virtual proc a::q {this}
        catch {new a} message
        lappend ::result $message

        class A {
            proc A {this} {
                lappend ::result "A::A $this"
            }
            proc ~A {this} {}
            virtual proc p {this} {}
        }
        set o [new A]
        delete $o
        class A {
            virtual proc q {this}
        }
        catch {new A} message
        lappend ::result $message

        class b {}
        class b::c {}
        proc b::c::c {this} {
            lappend ::result "c::c $this"
        }
        proc b::c::~c {this} {}
        virtual proc b::c::p {this} {}
        set o [new b::c]
        delete $o
        virtual proc b::c::q {this}
        catch {new b::c} message
        lappend ::result $message

        class B {
            class C {
                proc C {this} {
                    lappend ::result "C::C $this"
                }
                proc ~C {this} {}
                virtual proc p {this} {}
            }
            set o [new C]
            delete $o
            class C {
                virtual proc q {this}
            }
            catch {new C} message
            lappend ::result $message
        }
        catch {new B::C} message
        lappend ::result $message

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::a 1}\
    {class ::a with pure virtual procedures should not be instanciated}\
    {A::A 2}\
    {class ::A with pure virtual procedures should not be instanciated}\
    {c::c 3}\
    {class ::b::c with pure virtual procedures should not be instanciated}\
    {C::C 4}\
    {class ::B::C with pure virtual procedures should not be instanciated}\
    {class ::B::C with pure virtual procedures should not be instanciated}\
]

test stooop-86 {
    verify member writing and unsetting within class procedures in member data
    checking mode
    (it seems that unset tracing prevents error reporting at this time (bug?))
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKDATA) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        proc a::p {this} {
            set b::($this,m) 0
        }
        proc a::q {this} {
            set b::(n) 0
        }
        proc a::r {this} {
            unset b::($this,m)
        }
        proc a::s {this} {
            unset b::(n)
        }
        set o [new a]
        class b {}
        set b::($o,m) 0
        set b::(n) 0
        catch {a::p $o} message; lappend ::result $message
        catch {a::q $o} message; lappend ::result $message
        catch {a::r $o} message; lappend ::result bug
        catch {a::s $o} message; lappend ::result bug
        delete $o

        class A {
            proc A {this} {}
            proc ~A {this} {}
            proc p {this} {
                set B::($this,m) 0
            }
            proc q {this} {
                set B::(n) 0
            }
            proc r {this} {
                unset B::($this,m)
            }
            proc s {this} {
                unset B::(n)
            }
        }
        set o [new A]
        class B {
            set ($o,m) 0
            set (n) 0
        }
        class A {
            catch {p $o} message; lappend ::result $message
            catch {q $o} message; lappend ::result $message
            catch {r $o} message; lappend ::result bug
            catch {s $o} message; lappend ::result bug
        }
        delete $o

        class c {}
        class c::d {}
        proc c::d::d {this} {}
        proc c::d::~d {this} {}
        proc c::d::p {this} {
            set c::e::($this,m) 0
        }
        proc c::d::q {this} {
            set c::e::(n) 0
        }
        proc c::d::r {this} {
            unset c::e::($this,m)
        }
        proc c::d::s {this} {
            unset c::e::(n)
        }
        class c::e {}
        set o [new c::d]
        set c::e::($o,m) 0
        set c::e::(n) 0
        catch {c::d::p $o} message; lappend ::result $message
        catch {c::d::q $o} message; lappend ::result $message
        catch {c::d::r $o} message; lappend ::result bug
        catch {c::d::s $o} message; lappend ::result bug
        delete $o

        class C {
            class D {
                proc D {this} {}
                proc ~D {this} {}
                proc p {this} {
                    set C::E::($this,m) 0
                }
                proc q {this} {
                    set C::E::(n) 0
                }
                proc r {this} {
                    unset C::E::($this,m)
                }
                proc s {this} {
                    unset C::E::(n)
                }
            }
            set ::o [new D]
            class E {
                set ($o,m) 0
                set (n) 0
            }
            class D {
                catch {p $o} message; lappend ::result $message
                catch {q $o} message; lappend ::result $message
                catch {r $o} message; lappend ::result bug
                catch {s $o} message; lappend ::result bug
            }
        }
        catch {C::D::p $o} message; lappend ::result $message
        catch {C::D::q $o} message; lappend ::result $message
        catch {C::D::r $o} message; lappend ::result bug
        catch {C::D::s $o} message; lappend ::result bug
        delete $o

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {can't set "b::(1,m)": class access violation in procedure ::a::p}\
    {can't set "b::(n)": class access violation in procedure ::a::q}\
    bug\
    bug\
    {can't set "B::(2,m)": class access violation in procedure ::A::p}\
    {can't set "B::(n)": class access violation in procedure ::A::q}\
    bug\
    bug\
    {can't set "c::e::(3,m)": class access violation in procedure ::c::d::p}\
    {can't set "c::e::(n)": class access violation in procedure ::c::d::q}\
    bug\
    bug\
    {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\
    {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\
    bug\
    bug\
    {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\
    {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\
    bug\
    bug\
]

test stooop-87 {verify member writing and unsetting within class namespaces in member data checking mode (it seems that unset tracing prevents error reporting at this time (bug?))} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKDATA) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {
            set (m) 0
        }
        proc a::a {this} {
            set ($this,n) 0
        }
        proc a::~a {this} {}
        set o [new a]
        catch {class b {incr a::(m)}} message; lappend ::result $message
        catch {class b {incr a::($o,n)}} message; lappend ::result $message
        catch {class b {unset a::(m)}} message; lappend ::result bug
        catch {class b {unset a::($o,n)}} message; lappend ::result bug
        delete $o

        class A {
            set (m) 0
            proc A {this} {
                set ($this,n) 0
            }
            proc ~A {this} {}
        }
        set o [new A]
        class B {
            catch {incr A::(m)} message; lappend ::result $message
            catch {incr A::($o,n)} message; lappend ::result $message
            catch {unset A::(m)} message; lappend ::result bug
            catch {unset A::($o,n)} message; lappend ::result bug
        }
        delete $o

        class c {}
        class c::d {
            set (m) 0
        }
        proc c::d::d {this} {
            set ($this,n) 0
        }
        proc c::d::~d {this} {}
        set o [new c::d]
        catch {class c::e {incr c::d::(m)}} message; lappend ::result $message
        catch {class c::e {incr c::d::($o,n)}} message; lappend ::result $message
        catch {class c::e {unset c::d::(m)}} message; lappend ::result bug
        catch {class c::e {unset c::d::($o,n)}} message; lappend ::result bug
        delete $o

        class C {
            class D {
                set (m) 0
                proc D {this} {
                    set ($this,n) 0
                }
                proc ~D {this} {}
            }
            set ::o [new D]
            class B {
                catch {incr C::D::(m)} message; lappend ::result $message
                catch {incr C::D::($o,n)} message; lappend ::result $message
                catch {unset C::D::(m)} message; lappend ::result bug
                catch {unset C::D::($o,n)} message; lappend ::result bug
            }
        }
        catch {set C::D::(m)} message; lappend ::result $message
        catch {set C::D::($o,n)} message; lappend ::result $message
        catch {unset C::D::(m)} message; lappend ::result bug
        catch {unset C::D::($o,n)} message; lappend ::result bug
        delete $o

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {can't set "a::(m)": class access violation in class b namespace}\
    {can't set "a::(1,n)": class access violation in class b namespace}\
    bug\
    bug\
    {can't set "A::(m)": class access violation in class B namespace}\
    {can't set "A::(2,n)": class access violation in class B namespace}\
    bug\
    bug\
    {can't set "c::d::(m)": class access violation in class c::e namespace}\
    {can't set "c::d::(3,n)": class access violation in class c::e namespace}\
    bug\
    bug\
    {can't set "C::D::(m)": class access violation in class C::B namespace}\
    {can't set "C::D::(4,n)": class access violation in class C::B namespace}\
    bug\
    bug\
    {can't read "C::D::(m)": no such element in array}\
    {can't read "C::D::(4,n)": no such element in array}\
    bug\
    bug\
]

test stooop-88 {
    verify that object copying still works in member data checking mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKDATA) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            set ($this,n) 0
        }
        new [new a]

        class A {
            proc A {this} {
                set ($this,n) 0
            }
        }
        new [new A]

        class b {}
        class b::c {}
        proc b::c::c {this} {
            set ($this,n) 0
        }
        new [new b::c]

        class B {
            class C {
                proc C {this} {
                    set ($this,n) 0
                }
            }
            new [new C]
        }
        new [new B::C]

        set ::result {}
    }]
    interp delete $interpreter
    set result
} {}

test stooop-89 {
    verify both data and procedure static access in member data checking mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKDATA) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {
            set (m) 0
        }
        proc a::a {this} {
            set ($this,n) 0
        }
        proc a::~a {this} {}
        proc a::p {this} {
            incr (m)
            incr b::(o)
        }
        proc a::q {object} {
            incr ($object,n)
            incr b::($object,p)
        }
        class b {
            set (o) 0
        }
        proc b::b {this} a {} {
            set ($this,p) 0
        }
        proc b::~b {this} {}
        proc b::r {this} {
            incr (o)
            incr a::(m)
        }
        proc b::s {object} {
            incr ($object,p)
            incr a::($object,n)
        }
        set o [new b]
        catch {a::p $o} message; lappend ::result $message
        catch {a::q $o} message; lappend ::result $message
        catch {b::r $o} message; lappend ::result $message
        catch {b::s $o} message; lappend ::result $message
        delete $o

        class A {
            set (m) 0
            proc A {this} {
                set ($this,n) 0
            }
            proc ~A {this} {}
            proc p {this} {
                incr (m)
                incr B::(o)
            }
            proc q {object} {
                incr ($object,n)
                incr B::($object,p)
            }
        }
        class B {
            set (o) 0
            proc B {this} A {} {
                set ($this,p) 0
            }
            proc ~B {this} {}
            proc r {this} {
                incr (o)
                incr A::(m)
            }
            proc s {object} {
                incr ($object,p)
                incr A::($object,n)
            }
        }
        set o [new B]
        catch {A::p $o} message; lappend ::result $message
        catch {A::q $o} message; lappend ::result $message
        catch {B::r $o} message; lappend ::result $message
        catch {B::s $o} message; lappend ::result $message
        delete $o

        class c {}
        class c::d {
            set (m) 0
        }
        proc c::d::d {this} {
            set ($this,n) 0
        }
        proc c::d::~d {this} {}
        proc c::d::p {this} {
            incr (m)
            incr c::e::(o)
        }
        proc c::d::q {object} {
            incr ($object,n)
            incr c::e::($object,p)
        }
        class c::e {
            set (o) 0
        }
        proc c::e::e {this} c::d {} {
            set ($this,p) 0
        }
        proc c::e::~e {this} {}
        proc c::e::r {this} {
            incr (o)
            incr c::d::(m)
        }
        proc c::e::s {object} {
            incr ($object,p)
            incr c::d::($object,n)
        }
        set o [new c::e]
        catch {c::d::p $o} message; lappend ::result $message
        catch {c::d::q $o} message; lappend ::result $message
        catch {c::e::r $o} message; lappend ::result $message
        catch {c::e::s $o} message; lappend ::result $message
        delete $o

        class C {
            class D {
                set (m) 0
                proc D {this} {
                    set ($this,n) 0
                }
                proc ~D {this} {}
                proc p {this} {
                    incr (m)
                    incr C::E::(o)
                }
                proc q {object} {
                    incr ($object,n)
                    incr C::E::($object,p)
                }
            }
            class E {
                set (o) 0
                proc E {this} C::D {} {
                    set ($this,p) 0
                }
                proc ~E {this} {}
                proc r {this} {
                    incr (o)
                    incr C::D::(m)
                }
                proc s {object} {
                    incr ($object,p)
                    incr C::D::($object,n)
                }
            }
            set ::o [new E]
            catch {D::p $o} message; lappend ::result $message
            catch {D::q $o} message; lappend ::result $message
            catch {E::r $o} message; lappend ::result $message
            catch {E::s $o} message; lappend ::result $message
        }
        catch {C::D::p $o} message; lappend ::result $message
        catch {C::D::q $o} message; lappend ::result $message
        catch {C::E::r $o} message; lappend ::result $message
        catch {C::E::s $o} message; lappend ::result $message
        delete $o

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {can't set "b::(o)": class access violation in procedure ::a::p}\
    {can't set "b::(1,p)": class access violation in procedure ::a::q}\
    {can't set "a::(m)": class access violation in procedure ::b::r}\
    {can't set "a::(1,n)": class access violation in procedure ::b::s}\
    {can't set "B::(o)": class access violation in procedure ::A::p}\
    {can't set "B::(2,p)": class access violation in procedure ::A::q}\
    {can't set "A::(m)": class access violation in procedure ::B::r}\
    {can't set "A::(2,n)": class access violation in procedure ::B::s}\
    {can't set "c::e::(o)": class access violation in procedure ::c::d::p}\
    {can't set "c::e::(3,p)": class access violation in procedure ::c::d::q}\
    {can't set "c::d::(m)": class access violation in procedure ::c::e::r}\
    {can't set "c::d::(3,n)": class access violation in procedure ::c::e::s}\
    {can't set "C::E::(o)": class access violation in procedure ::C::D::p}\
    {can't set "C::E::(4,p)": class access violation in procedure ::C::D::q}\
    {can't set "C::D::(m)": class access violation in procedure ::C::E::r}\
    {can't set "C::D::(4,n)": class access violation in procedure ::C::E::s}\
    {can't set "C::E::(o)": class access violation in procedure ::C::D::p}\
    {can't set "C::E::(4,p)": class access violation in procedure ::C::D::q}\
    {can't set "C::D::(m)": class access violation in procedure ::C::E::r}\
    {can't set "C::D::(4,n)": class access violation in procedure ::C::E::s}\
]

test stooop-90 {
    verify member data checking when "array set" is used
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKDATA) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        proc a::p {this} {
            array set b:: "$this,m 0"
        }
        proc a::q {this} {
            array set b:: {n 0}
        }
        set o [new a]
        class b {}
        array set b:: "$o,m 0 n 0"
        catch {a::p $o} message; lappend ::result $message
        catch {a::q $o} message; lappend ::result $message
        delete $o

        class A {
            proc A {this} {}
            proc ~A {this} {}
            proc p {this} {
                array set B:: "$this,m 0"
            }
            proc q {this} {
                array set B:: {n 0}
            }
        }
        set o [new A]
        class B {
            array set B:: "$o,m 0 n 0"
        }
        class A {
            catch {p $o} message; lappend ::result $message
            catch {q $o} message; lappend ::result $message
        }
        delete $o

        class c {}
        class c::d {}
        proc c::d::d {this} {}
        proc c::d::~d {this} {}
        proc c::d::p {this} {
            array set c::e:: "$this,m 0"
        }
        proc c::d::q {this} {
            array set c::e:: {n 0}
        }
        class c::e {}
        set o [new c::d]
        array set c::e:: "$o,m 0 n 0"
        catch {c::d::p $o} message; lappend ::result $message
        catch {c::d::q $o} message; lappend ::result $message
        delete $o

        class C {
            class D {
                proc D {this} {}
                proc ~D {this} {}
                proc p {this} {
                    array set C::E:: "$this,m 0"
                }
                proc q {this} {
                    array set C::E:: {n 0}
                }
            }
            set ::o [new D]
            class E {
                array set C::E:: "$o,m 0 n 0"
            }
            class D {
                catch {p $o} message; lappend ::result $message
                catch {q $o} message; lappend ::result $message
            }
        }
        catch {C::D::p $o} message; lappend ::result $message
        catch {C::D::q $o} message; lappend ::result $message
        delete $o

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {can't set "b::(1,m)": class access violation in procedure ::a::p}\
    {can't set "b::(n)": class access violation in procedure ::a::q}\
    {can't set "B::(2,m)": class access violation in procedure ::A::p}\
    {can't set "B::(n)": class access violation in procedure ::A::q}\
    {can't set "c::e::(3,m)": class access violation in procedure ::c::d::p}\
    {can't set "c::e::(n)": class access violation in procedure ::c::d::q}\
    {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\
    {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\
    {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\
    {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\
]

test stooop-91 {
    verify that packaged class works even in debugging mode
} {
    makeDirectory 91
    makeFile {package ifneeded 91 1 [list tclPkgSetup $dir 91 1 {{p.tcl source {::a::_copy ::a::a}}}]}\
        [file join 91 pkgIndex.tcl]
    makeFile {package provide 91 1; class a {proc a {this} {}}}\
        [file join 91 p.tcl]
    set interpreter [interp create]
    $interpreter eval {
        # search in test directory sub-directories:
        lappend auto_path [file dirname [info script]]
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKPROCEDURES) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        package require 91
        new a
        set ::result {}
    }]
    interp delete $interpreter
    removeDirectory 91
    set result
} {}

test stooop-92 {
    check that parameter passing by reference works with virtual declarations
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        virtual proc a::f {this a} {}
        virtual proc a::g {this a}
        virtual proc a::h {this a} {
            upvar $a d
            set d(0) 0
        }
        virtual proc a::i {this a} {}
        virtual proc a::j {this a}
        virtual proc a::k {this a} {}
        class b {}
        proc b::b {this} a {} {}
        proc b::~b {this} {}
        proc b::f {this a} {
            upvar $a d
            set d(1) 1
        }
        proc b::g {this a} {
            upvar $a d
            set d(2) 2
        }
        virtual proc b::i {this a} {}
        virtual proc b::j {this a}
        virtual proc b::k {this a} {
            upvar $a d
            set d(3) 3
        }
        class c {}
        proc c::c {this} b {} {}
        proc c::~c {this} {}
        proc c::i {this a} {
            upvar $a d
            set d(4) 4
        }
        proc c::j {this a} {
            upvar $a d
            set d(5) 5
        }
        set o [new c]
        a::f $o z
        a::g $o z
        a::h $o z
        a::i $o z
        a::j $o z
        a::k $o z
        eval lappend ::result [dumpArrays z]

        class A {
            proc A {this} {}
            proc ~A {this} {}
            virtual proc f {this a} {}
            virtual proc g {this a}
            virtual proc h {this a} {
                upvar $a d
                set d(0) 0
            }
            virtual proc i {this a} {}
            virtual proc j {this a}
            virtual proc k {this a} {}
        }
        class B {
            proc B {this} A {} {}
            proc ~B {this} {}
            proc f {this a} {
                upvar $a d
                set d(1) 1
            }
            proc g {this a} {
                upvar $a d
                set d(2) 2
            }
            virtual proc i {this a} {}
            virtual proc j {this a}
            virtual proc k {this a} {
                upvar $a d
                set d(3) 3
            }
        }
        class C {
            proc C {this} B {} {}
            proc ~C {this} {}
            proc i {this a} {
                upvar $a d
                set d(4) 4
            }
            proc j {this a} {
                upvar $a d
                set d(5) 5
            }
        }
        set o [new C]
        A::f $o Z
        A::g $o Z
        A::h $o Z
        A::i $o Z
        A::j $o Z
        A::k $o Z
        eval lappend ::result [dumpArrays Z]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {z(0) = 0}\
    {z(1) = 1}\
    {z(2) = 2}\
    {z(3) = 3}\
    {z(4) = 4}\
    {z(5) = 5}\
    {Z(0) = 0}\
    {Z(1) = 1}\
    {Z(2) = 2}\
    {Z(3) = 3}\
    {Z(4) = 4}\
    {Z(5) = 5}\
]

test stooop-93 {
    check that member procedure invocation within constructor does not break
    procedure checking debug mode
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKPROCEDURES) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    set result [$interpreter eval {
        class a {}
        proc a::a {this} {
            p $this
            q
        }
        proc a::~a {this} {}
        proc a::p {this} {}
        proc a::q {} {}
        new a

        class A {
            proc A {this} {
                p $this
                q
            }
            proc ~A {this} {}
            proc p {this} {}
            proc q {} {}
        }
        new A

        class b {}
        class b::c {}
        proc b::c::c {this} {
            p $this
            q
        }
        proc b::c::~c {this} {}
        proc b::c::p {this} {}
        proc b::c::q {} {}
        new b::c

        class B {
            class C {
                proc C {this} {
                    p $this
                    q
                }
                proc ~C {this} {}
                proc p {this} {}
                proc q {} {}
            }
        }
        new B::C

        set ::result {}
    }]
    interp delete $interpreter
    set result
} {}

test stooop-94 {
    basic objects checking
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKOBJECTS) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    # alias puts to be able to collect standard output data:
    proc appendResult {string} {lappend ::result $string}
    $interpreter alias puts appendResult
    set result {}
    $interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        proc p {} {
            new a
        }
        namespace eval n {
            proc p {} {
                new a
            }
        }
        stooop::record
        new a
        stooop::report
        p
        stooop::report
        n::p
        stooop::report
        stooop::record
        delete 1
        stooop::report
        delete 2
        stooop::report
        delete 3
        stooop::report

        class A {
            proc A {this} {}
            proc ~A {this} {}
        }
        proc q {} {
            new A
        }
        namespace eval m {
            proc q {} {
                new A
            }
        }
        stooop::record
        new A
        stooop::report
        q
        stooop::report
        m::q
        stooop::report
        stooop::record
        delete 4
        stooop::report
        delete 5
        stooop::report
        delete 6
        stooop::report
    }
    interp delete $interpreter
    set result
} [list\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {+ ::a(1) + top level}\
    {stooop::report invoked from top level:}\
    {+ ::a(1) + top level}\
    {+ ::a(2) + ::p}\
    {stooop::report invoked from top level:}\
    {+ ::a(1) + top level}\
    {+ ::a(2) + ::p}\
    {+ ::a(3) + ::n::p}\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {- ::a(1) - top level + top level}\
    {stooop::report invoked from top level:}\
    {- ::a(1) - top level + top level}\
    {- ::a(2) - top level + ::p}\
    {stooop::report invoked from top level:}\
    {- ::a(1) - top level + top level}\
    {- ::a(2) - top level + ::p}\
    {- ::a(3) - top level + ::n::p}\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {+ ::A(4) + top level}\
    {stooop::report invoked from top level:}\
    {+ ::A(4) + top level}\
    {+ ::A(5) + ::q}\
    {stooop::report invoked from top level:}\
    {+ ::A(4) + top level}\
    {+ ::A(5) + ::q}\
    {+ ::A(6) + ::m::q}\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {- ::A(4) - top level + top level}\
    {stooop::report invoked from top level:}\
    {- ::A(4) - top level + top level}\
    {- ::A(5) - top level + ::q}\
    {stooop::report invoked from top level:}\
    {- ::A(4) - top level + top level}\
    {- ::A(5) - top level + ::q}\
    {- ::A(6) - top level + ::m::q}\
]

test stooop-95 {
    objects checking from namespace body and namespace procedure
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKOBJECTS) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    # alias puts to be able to collect standard output data:
    proc appendResult {string} {lappend ::result $string}
    $interpreter alias puts appendResult
    set result {}
    $interpreter eval {
        class a {
            proc a {this} {}
            proc ~a {this} {}
        }
        namespace eval n {
            proc p {} {
                new a
            }
            namespace eval m {
                proc q {} {
                    new a
                }
            }
        }
        stooop::record
        namespace eval n {
            new a
        }
        stooop::report
        n::p
        stooop::report
        namespace eval n::m {
            new a
        }
        stooop::report
        n::m::q
        stooop::report
        delete 1 2 3 4
    }
    interp delete $interpreter
    set result
} [list\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {+ ::a(1) + namespace ::n}\
    {stooop::report invoked from top level:}\
    {+ ::a(1) + namespace ::n}\
    {+ ::a(2) + ::n::p}\
    {stooop::report invoked from top level:}\
    {+ ::a(1) + namespace ::n}\
    {+ ::a(2) + ::n::p}\
    {+ ::a(3) + namespace ::n::m}\
    {stooop::report invoked from top level:}\
    {+ ::a(1) + namespace ::n}\
    {+ ::a(2) + ::n::p}\
    {+ ::a(3) + namespace ::n::m}\
    {+ ::a(4) + ::n::m::q}\
]

test stooop-96 {
    objects checking from within derived class constructor
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKOBJECTS) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    # alias puts to be able to collect standard output data:
    proc appendResult {string} {lappend ::result $string}
    $interpreter alias puts appendResult
    set result {}
    $interpreter eval {
        class a {
            proc a {this i} {}
            proc ~a {this} {}
        }
        class b {
            proc b {this} a {[new c]} {}
            proc ~b {this} {}
        }
        class c {
            proc c {this} {}
            proc ~c {this} {}
        }
        stooop::record
        new b
        stooop::report

        class A {
            class a {
                proc a {this i} {}
                proc ~a {this} {}
            }
            class b {
                proc b {this} a {[new c]} {}
                proc ~b {this} {}
            }
            class c {
                proc c {this} {}
                proc ~c {this} {}
            }
            stooop::record
            new b
            stooop::report
        }

    }
    interp delete $interpreter
    set result
} [list\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {+ ::b(1) + top level}\
    {+ ::c(2) + ::b::b}\
    {stooop::record invoked from namespace ::A}\
    {stooop::report invoked from namespace ::A:}\
    {+ ::A::b(3) + namespace ::A}\
    {+ ::c(4) + ::A::b::b}\
]

test stooop-97 {
    objects checking with debugging procedures invocation from namespace body
    and namespace procedure
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKOBJECTS) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    # alias puts to be able to collect standard output data:
    proc appendResult {string} {lappend ::result $string}
    $interpreter alias puts appendResult
    set result {}
    $interpreter eval {
        class a {
            proc a {this} {}
            proc ~a {this} {}
        }
        namespace eval n {
            proc p {} {
                stooop::record
                new a
                stooop::report
            }
            namespace eval m {
                proc q {} {
                    stooop::record
                    new a
                    stooop::report
                }
            }
        }
        n::p
        n::m::q
        namespace eval n {
            stooop::record
            new a
            stooop::report
        }

    }
    interp delete $interpreter
    set result
} [list\
    {stooop::record invoked from ::n::p}\
    {stooop::report invoked from ::n::p:}\
    {+ ::a(1) + ::n::p}\
    {stooop::record invoked from ::n::m::q}\
    {stooop::report invoked from ::n::m::q:}\
    {+ ::a(2) + ::n::m::q}\
    {stooop::record invoked from namespace ::n}\
    {stooop::report invoked from namespace ::n:}\
    {+ ::a(3) + namespace ::n}\
]

test stooop-98 {
    objects checking with missing and extra objects
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKOBJECTS) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    # alias puts to be able to collect standard output data:
    proc appendResult {string} {lappend ::result $string}
    $interpreter alias puts appendResult
    set result {}
    $interpreter eval {
        class a {
            proc a {this} {}
            proc ~a {this} {}
        }
        stooop::record
        set o [new a]
        stooop::report
        stooop::record
        delete $o
        stooop::report

    }
    interp delete $interpreter
    set result
} [list\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {+ ::a(1) + top level}\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {- ::a(1) - top level + top level}\
]

test stooop-99 {
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKOBJECTS) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    # alias puts to be able to collect standard output data:
    proc appendResult {string} {lappend ::result $string}
    $interpreter alias puts appendResult
    set result {}
    $interpreter eval {
        class a {}
        proc a::a {this} {}
        proc a::~a {this} {}
        proc p {} {
            new a
        }
        namespace eval n {
            proc p {} {
                new a
            }
        }
        stooop::printObjects
        new a
        stooop::printObjects
        p
        stooop::printObjects
        n::p
        stooop::printObjects
        delete 1
        stooop::printObjects
        delete 2
        stooop::printObjects
        delete 3
        stooop::printObjects

        class A {
            proc A {this} {}
            proc ~A {this} {}
        }
        proc q {} {
            new A
        }
        namespace eval m {
            proc q {} {
                new A
            }
        }
        stooop::printObjects
        new A
        stooop::printObjects
        q
        stooop::printObjects
        m::q
        stooop::printObjects
        delete 4
        stooop::printObjects
        delete 5
        stooop::printObjects
        delete 6
        stooop::printObjects

    }
    interp delete $interpreter
    set result
} [list\
    {stooop::printObjects invoked from top level:}\
    {stooop::printObjects invoked from top level:}\
    {::a(1) + top level}\
    {stooop::printObjects invoked from top level:}\
    {::a(1) + top level}\
    {::a(2) + ::p}\
    {stooop::printObjects invoked from top level:}\
    {::a(1) + top level}\
    {::a(2) + ::p}\
    {::a(3) + ::n::p}\
    {stooop::printObjects invoked from top level:}\
    {::a(2) + ::p}\
    {::a(3) + ::n::p}\
    {stooop::printObjects invoked from top level:}\
    {::a(3) + ::n::p}\
    {stooop::printObjects invoked from top level:}\
    {stooop::printObjects invoked from top level:}\
    {stooop::printObjects invoked from top level:}\
    {::A(4) + top level}\
    {stooop::printObjects invoked from top level:}\
    {::A(4) + top level}\
    {::A(5) + ::q}\
    {stooop::printObjects invoked from top level:}\
    {::A(4) + top level}\
    {::A(5) + ::q}\
    {::A(6) + ::m::q}\
    {stooop::printObjects invoked from top level:}\
    {::A(5) + ::q}\
    {::A(6) + ::m::q}\
    {stooop::printObjects invoked from top level:}\
    {::A(6) + ::m::q}\
    {stooop::printObjects invoked from top level:}\
]

test stooop-100 {
    objects checking pattern matching
} {
    set interpreter [interp create]
    $interpreter eval {
        # reset any existing environment variables:
        foreach name [array names env STOOOP*] {unset env($name)}
        set env(STOOOPCHECKOBJECTS) 1
    }
    $interpreter eval "source $source; namespace import stooop::*"
    # alias puts to be able to collect standard output data:
    proc appendResult {string} {lappend ::result $string}
    $interpreter alias puts appendResult
    set result {}
    $interpreter eval {
        class aa {
            proc aa {this} {}
            proc ~aa {this} {}
        }
        class ab {
            proc ab {this} {}
            proc ~ab {this} {}
        }
        class bb {
            proc bb {this} {}
            proc ~bb {this} {}
        }
        stooop::record
        new aa
        new ab
        new bb
        stooop::printObjects ::a*
        stooop::printObjects ::*b
        stooop::report ::a*
        stooop::report ::*b
        stooop::record
        delete 1 2 3
        stooop::report ::a*
        stooop::report ::*b

    }
    interp delete $interpreter
    set result
} [list\
    {stooop::record invoked from top level}\
    {stooop::printObjects invoked from top level:}\
    {::aa(1) + top level}\
    {::ab(2) + top level}\
    {stooop::printObjects invoked from top level:}\
    {::ab(2) + top level}\
    {::bb(3) + top level}\
    {stooop::report invoked from top level:}\
    {+ ::aa(1) + top level}\
    {+ ::ab(2) + top level}\
    {stooop::report invoked from top level:}\
    {+ ::ab(2) + top level}\
    {+ ::bb(3) + top level}\
    {stooop::record invoked from top level}\
    {stooop::report invoked from top level:}\
    {- ::aa(1) - top level + top level}\
    {- ::ab(2) - top level + top level}\
    {stooop::report invoked from top level:}\
    {- ::ab(2) - top level + top level}\
    {- ::bb(3) - top level + top level}\
]

test stooop-101 {
    check that new lines within base class constructors arguments work without
    spacing
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p q} {
            set ($this,m) $p
            set ($this,n) $q
        }
        class b {}
        proc b::b {this p q r} a {
        $p
        $q
        } {
            set ($this,o) $r
        }
        new b {x y} z {1 2}
        eval lappend ::result [dumpArrays a:: b::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = x y}\
    {a::(1,n) = z}\
    {b::(1,o) = 1 2}\
]

test stooop-102 {
    check that new lines within base class constructors arguments work without
    spacing, with a DOS formatted file
} {
    set interpreter [interp create]
    $interpreter eval "source $source; namespace import stooop::*"
    $interpreter eval $dumpArraysCode
    set result [$interpreter eval {
        class a {}
        proc a::a {this p q} {
            set ($this,m) $p
            set ($this,n) $q
        }
        class b {}
        proc b::b {this p q r} a {
        $p
        $q
        } {
            set ($this,o) $r
        }
        new b {x y} z {1 2}
        eval lappend ::result [dumpArrays a:: b::]

        set ::result
    }]
    interp delete $interpreter
    set result
} [list\
    {a::(1,_derived) = ::b}\
    {a::(1,m) = x y}\
    {a::(1,n) = z}\
    {b::(1,o) = 1 2}\
]

# -------------------------------------------------------------------------

testsuiteCleanup
return

# Local variables:
# mode: tcl
# End: