Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

12 files changed, 12961 insertions, 0 deletions

diff --git a/tcllib/modules/stooop/ChangeLog b/tcllib/modules/stooop/ChangeLog
new file mode 100644
index 0000000..d418612
--- /dev/null
+++ b/tcllib/modules/stooop/ChangeLog
@@ -0,0 +1,150 @@
+2013-12-17  Andreas Kupries <andreask@activestate.com>
+
+	* switched.man: Created a doctools-based manpage from the provided
+	  HTML documentation.
+
+2013-02-01  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.15 ========================
+	* 
+
+2011-12-13  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.14 ========================
+	* 
+
+2011-01-24  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.13 ========================
+	* 
+
+2009-12-07  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.12 ========================
+	* 
+
+2008-12-12  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.11.1 ========================
+	* 
+
+2008-10-16  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.11 ========================
+	* 
+
+2007-09-12  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.10 ========================
+	* 
+
+2007-03-23  Andreas Kupries <andreask@activestate.com>
+
+	* pkgIndex.tcl: Added MD hints.
+
+2007-03-21  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* stooop.man: Fixed all warnings due to use of now deprecated
+	  commands. Added a section about how to give feedback.
+
+2006-10-08  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* stooop.test: Rewritten to use new features for handling the
+	  environment.
+
+2006-10-03  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.9 ========================
+	* 
+
+2006-09-19  Andreas Kupries  <andreask@activestate.com>
+
+	* switched.tcl: Bumped version to 2.2.1
+	* pkgIndex.tcl:
+
+2006-09-17  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* stooop.test: Description of test 87 modified to be a single line.
+
+2006-01-30  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* stooop.test: Fixed handling of "env", also did the simplified boilerplate.
+
+2006-01-29  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* stooop.test: Fixed use and cleanup of temp. files
+
+2006-01-19  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* stooop.test: Hooked into the new common test support code.
+
+2006-01-10  Andreas Kupries <andreask@activestate.com>
+
+	* switched.tcl: Fixed bug, missing dependency on package
+	  stooop. This bug was introduced by the change to the package
+	  loading of switched.
+
+2005-12-09  Andreas Kupries <andreask@activestate.com>
+
+	* pkgIndex.tcl: Replaced lazy loading setup of package 'switched'
+	  with standard regular source setup.
+
+2005-10-06  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.8 ========================
+	* 
+
+2004-10-05  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.7 ========================
+	* 
+
+2004-05-23  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.6.1 ========================
+	* 
+
+2004-02-15  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.6 ========================
+	* 
+
+2003-05-05  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	*
+	* Released and tagged Tcllib 1.4 ========================
+	* 
+
+2003-04-11  Andreas Kupries  <andreask@activestate.com>
+
+	* stooop.tcl:
+	* stooop.man:
+	* pkgIndex.tcl: Set version of the package to to 4.4.1 throughout.
+
+2003-04-01  Andreas Kupries  <andreask@activestate.com>
+
+	* stooop.man:
+	* stooop.htm: Renamed to 'stoop_man.html'. Updated doctools
+	  documentation to refer to manual under the new name. This
+	  resolves the circular link reported in Tcllib SF bug #687923.
+
+2003-01-16  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* stooop.man: More semantic markup, less visual one.
+
+2002-04-15  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* stooop.man: Added doctools manpage.
+
diff --git a/tcllib/modules/stooop/README b/tcllib/modules/stooop/README
new file mode 100644
index 0000000..4a96c30
--- /dev/null
+++ b/tcllib/modules/stooop/README
@@ -0,0 +1,79 @@
+This is stooop (a Simple Tcl Only Object Oriented Programming scheme)
+version 4.2. Stooop is implemented in a single sourceable file and
+uses simple techniques to provide object orientation to the great Tcl
+language.
+
+If you know C++ or Java, stooop will be easy to use for you. Using the
+familiar class, new, delete and virtual keywords and a few coding
+conventions, you can start object oriented Tcl code right away, as the
+following simple example shows:
+
+
+source stooop.tcl
+namespace import stooop::*
+
+class circle {
+    proc circle {this canvas diameter} {
+        set ($this,diameter) $diameter
+        set ($this,canvas) $canvas
+        set ($this,id) [$canvas create oval 0 0 $diameter $diameter]
+    }
+    proc ~circle {this} {
+        $($this,canvas) delete $($this,id)
+    }
+    proc move {this x y} {
+        $($this,canvas) move $($this,id) $x $y
+    }
+}
+
+pack [canvas .canvas]
+set c [new circle .canvas 50]
+update; after 1000
+circle::move $c 10 10
+update; after 1000
+delete $c
+
+
+Stooop supports single and multiple inheritance, data encapsulation
+(all member data is public), dynamic binding, nested classes, object
+copy, runtime type identification, optional runtime procedure and data
+access checking as well as tracing.
+
+As stooop is entirely written in Tcl, it will run on all Tcl supported
+platforms, including Windows and the Mac Intosh, if you have Tcl
+version 8.3 or above.
+
+The class, new, delete, virtual and classof commands are implemented
+as Tcl procedures.
+
+Stooop was implemented with a constant concern for performance. Member
+data is stored in Tcl associative arrays, which are best for random
+data access. Classes are implemented as namespaces to improve
+encapsulation and reduce naming interferences. Object oriented helper
+code is kept as small and as efficient as possible. Typically, only a
+couple of Tcl lines are added to a member procedure definition.
+Program startup time will be slightly increased due to some class and
+member procedures preprocessing, but runtime overhead is kept to a
+strict minimum. Use of object oriented techniques may actually improve
+the performance of your code.
+
+A full HTML documentation, simple demonstration script, graphical
+demonstration with composite pattern and test files are provided. You
+may also run the test suite and look at the test scripts for
+examples. There is also a utility for creating packages (in the Tcl
+sense) from stooop compatible class files.
+
+There is a companion package to stooop: scwoop (a Simple Composite
+Widget Object Oriented Package). Scwoop is implemented in a single
+sourceable file and uses simple techniques to provide composite widget
+(also known as mega widget) support to the great Tk widget library.
+Moodss (a Modular Object Oriented Dynamic SpreadSheet) implemented
+with stooop, scwoop, tkTable and BLT is also available on my website
+(at http://jfontain.free.fr/).
+
+Whether you like it (or hate it), please let me know. I would like to
+hear about bugs and improvements you would like to see. I will correct
+the bugs quickly, especially if you send me a test script.
+
+Copyright (c) 2001 by Jean-Luc Fontaine <jfontain@free.fr>.
+This code may be distributed under the same terms as Tcl.
diff --git a/tcllib/modules/stooop/mkpkgidx.tcl b/tcllib/modules/stooop/mkpkgidx.tcl
new file mode 100755
index 0000000..d29d170
--- /dev/null
+++ b/tcllib/modules/stooop/mkpkgidx.tcl
@@ -0,0 +1,112 @@
+# command line:
+# $ interpreter mkpkgidx.tcl -p package1.n.n -p package2 -p package3.n ...
+#     packageName file1 file2 ...
+# use wish as interpreter instead of tclsh in order to handle graphical packages
+
+# Copyright (c) 2001 by Jean-Luc Fontaine <jfontain@free.fr>.
+# This code may be distributed under the same terms as Tcl.
+#
+# $Id: mkpkgidx.tcl,v 1.3 2004/01/15 06:36:14 andreas_kupries Exp $
+
+# this utility must be used to create the package index file for a package that
+# uses stooop.
+# it differs from the tcl pkg_mkIndex procedure in the way it sources files.
+# since base classes can usually be found in files separate from the derived
+# class source file, sourcing each file in a different interpreter (as is done
+# in the pkg_mkIndex procedure) results in an error for stooop that catches the
+# fact that the base class is not defined. the solution is to use a single
+# interpreter which will source the class files in order (base classes first at
+# the user's responsibility). since stooop is loaded in that single interpreter,
+# inheritance problems and others are automatically caught in the process.
+# the generated package index file is fully compatible with the tcl generated
+# ones.
+# the stooop library makes sure that base classes source files are automatically
+# sourced when a derived class is defined (see the stooop.tcl source file for
+# more information).
+# if your software requires one or more packages, you may force their loading
+# by using the -p arguments. each package version number is optionally appended
+# to the package name and follows the same rules as the Tcl package require
+# command
+# example: $ tclsh -p switched.1 -p scwoop foo bar.tcl barfoo.tcl foobar.tcl ...
+
+if {[catch {package require stooop 4}]} {
+    # in case stooop package is not installed
+    source stooop.tcl
+}
+namespace import stooop::*
+
+proc indexData {packageName files} {
+    global auto_index
+
+    set index "# Package index file created with stooop version [package provide stooop] for stooop packages\n"
+    set data {}
+
+    foreach command [info commands] {
+        set defined($command) {}
+    }
+
+    foreach file $files {
+        # source at global level to avoid variable names collisions:
+        uplevel #0 source [list $file]
+
+        catch {unset newCommands}                    ;# empty new commands array
+        foreach command [info commands] {
+            # check new commands at the global level
+            # filter out tk widget commands and ignore commands eventually
+            # loaded from a package required by the new commands
+            if {
+                [string match .* $command]||[info exists defined($command)]||
+                [info exists auto_index($command)]||\
+                [info exists auto_index(::$command)]
+            } continue
+            set newCommands($command) {}
+            set defined($command) {}
+        }
+        # check new classes, which actually are namespaces:
+        foreach class [array name stooop::declared] {
+            if {![info exists declared($class)]} {
+                # check new commands at the class namespace level:
+                foreach command [info commands ::${class}::*] {
+                    # ignore commands eventually loaded from a package required
+                    # by the new commands
+                    if {\
+                        [info exists defined($command)]||\
+                        [info exists auto_index($command)]||\
+                        [info exists auto_index(::$command)]\
+                    } continue
+                    set newCommands($command) {}
+                    set defined($command) {}
+                }
+                set declared($class) {}
+            }
+        }
+        # so far only sourceable file, not shared libraries, are handled
+        lappend data [list $file source [lsort [array names newCommands]]]
+    }
+    set version [package provide $packageName]
+    append index "\npackage ifneeded $packageName $version \[list tclPkgSetup \$dir $packageName $version [list $data]\]"
+    return $index
+}
+
+proc printUsage {exitCode} {
+    global argv0
+
+    puts stderr "usage: $argv0 \[\[-p package.n.n\] \[-p package.n.n\] ...\] moduleName tclFile tclFile ..."
+    exit $exitCode
+}
+
+# first gather eventual packages:
+for {set index 0} {$index<[llength $argv]} {incr index} {
+    if {[string compare [lindex $argv $index] -p]!=0} break
+    set version {}
+    scan [lindex $argv [incr index]] {%[^.].%s} name version
+    eval package require $name $version
+}
+
+set argv [lrange $argv $index end]                   ;# keep remaining arguments
+if {[llength $argv]<2} {
+    printUsage 1
+}
+
+puts [open pkgIndex.tcl w] [indexData [lindex $argv 0] [lrange $argv 1 end]]
+exit                                                     ;# in case wish is used
diff --git a/tcllib/modules/stooop/pkgIndex.tcl b/tcllib/modules/stooop/pkgIndex.tcl
new file mode 100644
index 0000000..12b32fe
--- /dev/null
+++ b/tcllib/modules/stooop/pkgIndex.tcl
@@ -0,0 +1,22 @@
+# @mdgen EXCLUDE: xifo.tcl
+# @mdgen EXCLUDE: mkpkgidx.tcl
+#
+# Copyright (c) 2001 by Jean-Luc Fontaine <jfontain@free.fr>.
+# This code may be distributed under the same terms as Tcl.
+#
+# $Id: pkgIndex.tcl,v 1.10 2007/03/23 17:31:51 andreas_kupries Exp $
+
+# Since stooop redefines the proc command and the default package facility will
+# only load the stooop package at the first unknown command, proc being
+# obviously known by default, forcing the loading of stooop is mandatory prior
+# to the first proc declaration.
+
+if {![package vsatisfies [package provide Tcl] 8.3]} {return}
+package ifneeded stooop 4.4.1 [list source [file join $dir stooop.tcl]]
+
+# the following package index instruction was generated using:
+#   "tclsh mkpkgidx.tcl switched switched.tcl"
+# (comment out the following line if you do not want to use the switched class
+# as a package)
+
+package ifneeded switched 2.2.1 [list source [file join $dir switched.tcl]]
diff --git a/tcllib/modules/stooop/stooop.man b/tcllib/modules/stooop/stooop.man
new file mode 100644
index 0000000..9dcf049
--- /dev/null
+++ b/tcllib/modules/stooop/stooop.man
@@ -0,0 +1,223 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin stooop n 4.4.1]
+[keywords C++]
+[keywords class]
+[keywords object]
+[keywords {object oriented}]
+[moddesc   {Simple Tcl Only Object Oriented Programming}]
+[titledesc {Object oriented extension.}]
+[category  {Programming tools}]
+[require Tcl 8.3]
+[require stooop [opt 4.4.1]]
+[description]
+[para]
+
+This package provides commands to extend Tcl in an object oriented
+manner, using a familiar C++ like syntax and behaviour. Stooop only
+introduces a few new commands: [cmd class], [cmd new], [cmd delete],
+[cmd virtual] and [cmd classof]. Along with a few coding conventions,
+that is basically all you need to know to use stooop. Stooop is meant
+to be as simple to use as possible.
+
+[para]
+
+This manual is very succinct and is to be used as a quick reminder for
+the programmer, who should have read the thorough [uri stooop_man.html]
+HTML documentation at this point.
+
+[list_begin definitions]
+
+[call [cmd ::stooop::class] [arg {name body}]]
+
+This command creates a class. The body, similar in contents to a Tcl
+namespace (which a class actually also is), contains member procedure
+definitions. Member procedures can also be defined outside the class
+body, by prefixing their name with [const class::], as you would
+proceed with namespace procedures.
+
+[list_begin definitions]
+
+[def "[cmd proc] [arg class] \{[const this] [opt [arg {arg arg ...}]]\} [opt "[arg base] \{[opt [arg {arg arg ...}]]\} ..."] [arg body]"]
+
+This is the constructor procedure for the class. It is invoked
+following a [cmd new] invocation on the class. It must have the same
+name as the class and a first argument named [const this]. Any number
+of base classes specifications, including arguments to be passed to
+their constructor, are allowed before the actual body of the
+procedure.
+
+[def "[cmd proc] ~[arg class] \{[const this]\} [arg body]"]
+
+This is the destructor procedure for the class. It is invoked
+following a [cmd delete] invocation. Its name must be the
+concatenation of a single [const ~] character followed by the class
+name (as in C++). It must have a single argument named [const this].
+
+[def "[cmd proc] [arg name] \{[const this] [opt [arg {arg arg ...}]]\} [arg body]"]
+
+This is a member procedure of the class, as its first argument is
+named [const this]. It allows a simple access of member data for the
+object referenced by [const this] inside the procedure. For example:
+
+[example {
+   set ($this,data) 0
+}]
+
+[def "[cmd proc] [arg name] \{[opt [arg {arg arg ...}]]\} [arg body]"]
+
+This is a static (as in C++) member procedure of the class, as its
+first argument is not named [const this]. Static (global) class data
+can be accessed as in:
+
+[example {
+   set (data) 0
+}]
+
+[def "[cmd proc] [arg class] \{[const {this copy}]\} [arg body]"]
+
+This is the optional copy procedure for the class. It must have the
+same name as the class and exactly 2 arguments named [const this] and
+[const copy]. It is invoked following a [cmd new] invocation on an
+existing object of the class.
+
+[list_end]
+
+[call [cmd ::stooop::new] [arg class] [opt [arg {arg arg ...}]]]
+
+This command is used to create an object. The first argument is the
+class name and is followed by the arguments needed by the
+corresponding class constructor. A unique identifier for the object
+just created is returned.
+
+[call [cmd ::stooop::delete] [arg object] [opt [arg {object ...}]]]
+
+This command is used to delete one or several objects. It takes one or
+more object identifiers as argument(s).
+
+[call [cmd ::stooop::virtual] [const proc] [arg name] \{[const this] [opt [arg {arg arg ...}]]\} [opt [arg {body}]]]
+
+The [cmd virtual] specifier may be used on member procedures to
+achieve dynamic binding. A procedure in a base class can then be
+redefined (overloaded) in the derived class(es). If the base class
+procedure is invoked on an object, it is actually the derived class
+procedure which is invoked, if it exists. If the base class procedure
+has no body, then it is considered to be a pure virtual and the
+derived class procedure is always invoked.
+
+[call [cmd ::stooop::classof] [arg object]]
+
+This command returns the class of the existing object passed as single
+parameter.
+
+[call [cmd ::stooop::new] [arg object]]
+
+This command is used to create an object by copying an existing
+object. The copy constructor of the corresponding class is invoked if
+it exists, otherwise a simple copy of the copied object data members
+is performed.
+
+[list_end]
+
+[section DEBUGGING]
+
+[list_begin definitions]
+
+[def {Environment variables}]
+
+[list_begin definitions]
+
+[def [var STOOOPCHECKDATA]]
+
+Setting this variable to any true value will cause stooop to check for
+invalid member or class data access.
+
+[def [var STOOOPCHECKPROCEDURES]]
+
+Setting this variable to any true value will cause stooop to check for
+invalid member procedure arguments and pure interface classes
+instanciation.
+
+[def [var STOOOPCHECKALL]]
+
+Setting this variable to any true value will cause stooop to activate
+both procedure and data member checking.
+
+[def [var STOOOPCHECKOBJECTS]]
+
+Setting this variable to any true value will cause stooop to activate
+object checking. The following stooop namespace procedures then become
+available for debugging: [cmd printObjects], [cmd record] and
+[cmd report].
+
+[def [var STOOOPTRACEPROCEDURES]]
+
+Setting this environment variable to either [const stdout],
+
+[const stderr] or a file name, activates procedure tracing. The
+stooop library will then output to the specified channel 1 line of
+informational text for each member procedure invocation.
+
+[def [var STOOOPTRACEPROCEDURESFORMAT]]
+
+Defines the trace procedures output format. Defaults to
+[const {"class: %C, procedure: %p, object: %O, arguments: %a"}].
+
+[def [var STOOOPTRACEDATA]]
+
+Setting this environment variable to either [const stdout],
+
+[const stderr] or a file name, activates data tracing. The stooop
+library will then output to the specified channel 1 line of
+informational text for each member data access.
+
+[def [var STOOOPTRACEDATAFORMAT]]
+
+Defines the trace data output format. Defaults to
+[const {"class: %C, procedure: %p, array: %A, object: %O, member: %m, operation: %o, value: %v"}].
+
+[def [var STOOOPTRACEDATAOPERATIONS]]
+
+When tracing data output, by default, all read, write and unsetting
+accesses are reported, but the user can set this variable to any
+combination of the letters [const r], [const w], and [const u] for
+more specific tracing (please refer to the [cmd trace] Tcl manual page
+for more information).
+
+[def [var STOOOPTRACEALL]]
+
+Setting this environment variable to either [const stdout],
+
+[const stderr] or a file name, enables both procedure and data
+tracing.
+
+[list_end]
+
+[call [cmd ::stooop::printObjects] [opt [arg pattern]]]
+
+Prints an ordered list of existing objects, in creation order, oldest
+first. Each output line contains the class name, object identifier and
+the procedure within which the creation occurred. The optional pattern
+argument (as in the Tcl [cmd {string match}] command) can be used to
+limit the output to matching class names.
+
+[call [cmd ::stooop::record]]
+
+When invoked, a snapshot of all existing stooop objects is
+taken. Reporting can then be used at a later time to see which objects
+were created or deleted in the interval.
+
+[call [cmd ::stooop::report] [opt [arg pattern]]]
+
+Prints the created and deleted objects since the [cmd ::stooop::record]
+procedure was invoked last. If present, the pattern argument limits
+the output to matching class names.
+
+[list_end]
+
+[section EXAMPLES]
+
+Please see the full HTML documentation in [uri stooop_man.html].
+
+[vset CATEGORY stooop]
+[include ../doctools2base/include/feedback.inc]
+[manpage_end]
diff --git a/tcllib/modules/stooop/stooop.tcl b/tcllib/modules/stooop/stooop.tcl
new file mode 100644
index 0000000..1b47a8a
--- /dev/null
+++ b/tcllib/modules/stooop/stooop.tcl
@@ -0,0 +1,938 @@
+# stooop
+# Simple Tcl Only Object Oriented Programming
+# An object oriented extension to the Tcl programming language
+#
+# Copyright (c) 2002 by Jean-Luc Fontaine <jfontain@free.fr>.
+# This code may be distributed under the same terms as Tcl.
+#
+# $Id: stooop.tcl,v 1.9 2004/01/15 06:36:14 andreas_kupries Exp $
+
+
+# check whether empty named arrays and array unset are supported:
+package require Tcl 8.3
+
+package provide stooop 4.4.1
+
+# rename proc before it is overloaded, ignore error in case of multiple
+# inclusion of this file:
+catch {rename proc _proc}
+
+namespace eval ::stooop {
+    variable check
+    variable trace
+
+    # no checking by default: use an empty instruction to avoid any performance
+    # hit:
+    set check(code) {}
+    if {[info exists ::env(STOOOPCHECKALL)]&&$::env(STOOOPCHECKALL)} {
+        array set ::env\
+            {STOOOPCHECKPROCEDURES 1 STOOOPCHECKDATA 1 STOOOPCHECKOBJECTS 1}
+    }
+    set check(procedures) [expr {\
+        [info exists ::env(STOOOPCHECKPROCEDURES)]&&\
+        $::env(STOOOPCHECKPROCEDURES)\
+    }]
+    set check(data) [expr {\
+        [info exists ::env(STOOOPCHECKDATA)]&&$::env(STOOOPCHECKDATA)\
+    }]
+    set check(objects) [expr {\
+        [info exists ::env(STOOOPCHECKOBJECTS)]&&$::env(STOOOPCHECKOBJECTS)\
+    }]
+    if {$check(procedures)} {
+        append check(code) {::stooop::checkProcedure;}
+    }
+    if {[info exists ::env(STOOOPTRACEALL)]} {
+        # use same channel for both traces
+        set ::env(STOOOPTRACEPROCEDURES) $::env(STOOOPTRACEALL)
+        set ::env(STOOOPTRACEDATA) $::env(STOOOPTRACEALL)
+    }
+    if {[info exists ::env(STOOOPTRACEPROCEDURES)]} {
+        set trace(procedureChannel) $::env(STOOOPTRACEPROCEDURES)
+        switch $trace(procedureChannel) {
+            stdout - stderr {}
+            default {
+                # eventually truncate output file if it exists:
+                set trace(procedureChannel) [open $::env(STOOOPTRACEPROCEDURES) w+]
+            }
+        }
+        # default format:
+        set trace(procedureFormat)\
+            {class: %C, procedure: %p, object: %O, arguments: %a}
+        # eventually override with user defined format:
+        catch {set trace(procedureFormat) $::env(STOOOPTRACEPROCEDURESFORMAT)}
+        append check(code) {::stooop::traceProcedure;}
+    }
+    if {[info exists ::env(STOOOPTRACEDATA)]} {
+        set trace(dataChannel) $::env(STOOOPTRACEDATA)
+        switch $trace(dataChannel) {
+            stdout - stderr {}
+            default {
+                # eventually truncate output file if it exists
+                set trace(dataChannel) [open $::env(STOOOPTRACEDATA) w+]
+            }
+        }
+        # default format:
+        set trace(dataFormat) {class: %C, procedure: %p, array: %A, object: %O, member: %m, operation: %o, value: %v}
+        # eventually override with user defined format:
+        catch {set trace(dataFormat) $::env(STOOOPTRACEDATAFORMAT)}
+        # trace all operations by default:
+        set trace(dataOperations) rwu
+        # eventually override with user defined operations:
+        catch {set trace(dataOperations) $::env(STOOOPTRACEDATAOPERATIONS)}
+    }
+
+    namespace export class virtual new delete classof  ;# export public commands
+
+    if {![info exists newId]} {
+        # initialize object id counter only once even if this file is sourced
+        # several times:
+        variable newId 0
+    }
+
+    # create an object of specified class or copy an existing object:
+    _proc new {classOrId args} {
+        variable newId
+        variable fullClass
+
+        # use local variable for identifier because new can be invoked
+        # recursively:
+        if {[string is integer $classOrId]} {
+            # first argument is an object identifier (unsigned integer), copy
+            # source object to new object of identical class
+            if {[catch {\
+                set fullClass([set id [incr newId]]) $fullClass($classOrId)\
+            }]} {
+                error "invalid object identifier $classOrId"
+            }
+            # invoke the copy constructor for the class in caller's variable
+            # context so that object copy is transparent (see above):
+            uplevel 1 $fullClass($classOrId)::_copy $id $classOrId
+        } else {                                    ;# first argument is a class
+            # generate constructor name:
+            set constructor ${classOrId}::[namespace tail $classOrId]
+            # we could detect here whether class was ever declared but that
+            # would prevent stooop packages to load properly, because
+            # constructor would not be invoked and thus class source file never
+            # sourced
+            # invoke the constructor for the class with optional arguments in
+            # caller's variable context so that object creation is transparent
+            # and that array names as constructor parameters work with a simple
+            # upvar
+            # note: if class is in a package, the class namespace code is loaded
+            # here, as the first object of the class is created
+            uplevel 1 $constructor [set id [incr newId]] $args
+            # generate fully qualified class namespace name now that we are sure
+            # that class namespace code has been invoked:
+            set fullClass($id) [namespace qualifiers\
+                [uplevel 1 namespace which -command $constructor]\
+            ]
+        }
+        return $id                          ;# return a unique object identifier
+    }
+
+    _proc delete {args} {                          ;# delete one or more objects
+        variable fullClass
+
+        foreach id $args {
+            # destruct in caller's variable context so that object deletion is
+            # transparent:
+            uplevel 1 ::stooop::deleteObject $fullClass($id) $id
+            unset fullClass($id)
+        }
+    }
+
+    # delete object data starting at specified class layer and going up the base
+    # class hierarchy if any
+    # invoke the destructor for the object class and unset all the object data
+    # members for the class
+    # the destructor will in turn delete the base classes layers
+    _proc deleteObject {fullClass id} {
+        # invoke the destructor for the class in caller's variable context so
+        # that object deletion is transparent:
+        uplevel 1 ${fullClass}::~[namespace tail $fullClass] $id
+        # delete all this object data members if any (assume that they were
+        # stored as ${class}::($id,memberName)):
+        array unset ${fullClass}:: $id,*
+        # data member arrays deletion is left to the user
+    }
+
+    _proc classof {id} {
+        variable fullClass
+
+        return $fullClass($id)                         ;# return class of object
+    }
+
+    # copy object data members from one object to another:
+    _proc copy {fullClass from to} {
+        set index [string length $from]
+        # copy regular data members:
+        foreach {name value} [array get ${fullClass}:: $from,*] {
+            set ${fullClass}::($to[string range $name $index end]) $value
+        }
+        # if any, array data members copy is left to the class programmer
+        # through the then mandatory copy constructor
+    }
+}
+
+_proc ::stooop::class {args} {
+    variable declared
+
+    set class [lindex $args 0]
+    # register class using its fully qualified name:
+    set declared([uplevel 1 namespace eval $class {namespace current}]) {}
+    # create the empty name array used to hold all class objects so that static
+    # members can be directly initialized within the class declaration but
+    # outside member procedures
+    uplevel 1 namespace eval $class [list "::variable {}\n[lindex $args end]"]
+}
+
+# if procedure is a member of a known class, class and procedure names are set
+# and true is returned, otherwise false is returned:
+_proc ::stooop::parseProcedureName {\
+    namespace name fullClassVariable procedureVariable messageVariable\
+} {
+    # namespace argument is the current namespace (fully qualified) in which the
+    # procedure is defined
+    variable declared
+    upvar 1 $fullClassVariable fullClass $procedureVariable procedure\
+        $messageVariable message
+
+    if {\
+        [info exists declared($namespace)]&&\
+        ([string length [namespace qualifiers $name]]==0)\
+    } {
+        # a member procedure is being defined inside a class namespace
+        set fullClass $namespace
+        set procedure $name                ;# member procedure name is full name
+        return 1
+    } else {
+        # procedure is either a member of a known class or a regular procedure
+        if {![string match ::* $name]} {
+            # eventually fully qualify procedure name
+            if {[string equal $namespace ::]} { ;# global namespace special case
+                set name ::$name
+            } else {
+                set name ${namespace}::$name
+            }
+        }
+        # eventual class name is leading part:
+        set fullClass [namespace qualifiers $name]
+        if {[info exists declared($fullClass)]} {           ;# if class is known
+            set procedure [namespace tail $name] ;# procedure always is the tail
+            return 1
+        } else {                                       ;# not a member procedure
+            if {[string length $fullClass]==0} {
+                set message "procedure $name class name is empty"
+            } else {
+                set message "procedure $name class $fullClass is unknown"
+            }
+            return 0
+        }
+    }
+}
+
+# virtual operator, to be placed before proc
+# virtualize a member procedure, determine whether it is a pure virtual, check
+# for procedures that cannot be virtualized
+_proc ::stooop::virtual {keyword name arguments args} {
+    # set a flag so that proc knows it is acting upon a virtual procedure, also
+    # serves as a pure indicator:
+    variable pureVirtual
+
+    if {![string equal [uplevel 1 namespace which -command $keyword] ::proc]} {
+        error "virtual operator works only on proc, not $keyword"
+    }
+    if {![parseProcedureName\
+        [uplevel 1 namespace current] $name fullClass procedure message\
+    ]} {
+        error $message                   ;# not in a member procedure definition
+    }
+    set class [namespace tail $fullClass]
+    if {[string equal $class $procedure]} {
+        error "cannot make class $fullClass constructor virtual"
+    }
+    if {[string equal ~$class $procedure]} {
+        error "cannot make class $fullClass destructor virtual"
+    }
+    if {![string equal [lindex $arguments 0] this]} {
+        error "cannot make static procedure $procedure of class $fullClass virtual"
+    }
+    # no procedure body means pure virtual:
+    set pureVirtual [expr {[llength $args]==0}]
+    # process procedure declaration, body being empty for pure virtual procedure
+    # make virtual transparent by using uplevel:
+    uplevel 1 ::proc [list $name $arguments [lindex $args 0]]
+    unset pureVirtual
+}
+
+_proc proc {name arguments args} {
+    if {![::stooop::parseProcedureName\
+        [uplevel 1 namespace current] $name fullClass procedure message\
+    ]} {
+        # not in a member procedure definition, fall back to normal procedure
+        # declaration
+        # uplevel is required instead of eval here otherwise tcl seems to forget
+        # the procedure namespace if it exists
+        uplevel 1 _proc [list $name $arguments] $args
+        return
+    }
+    if {[llength $args]==0} {               ;# check for procedure body presence
+        error "missing body for ${fullClass}::$procedure"
+    }
+    set class [namespace tail $fullClass]
+    if {[string equal $class $procedure]} {      ;# class constructor definition
+        if {![string equal [lindex $arguments 0] this]} {
+            error "class $fullClass constructor first argument must be this"
+        }
+        if {[string equal [lindex $arguments 1] copy]} {
+            # user defined copy constructor definition
+            if {[llength $arguments]!=2} {
+                error "class $fullClass copy constructor must have 2 arguments exactly"
+            }
+            # make sure of proper declaration order:
+            if {[catch {info body ::${fullClass}::$class}]} {
+                error "class $fullClass copy constructor defined before constructor"
+            }
+            eval ::stooop::constructorDeclaration\
+                $fullClass $class 1 \{$arguments\} $args
+        } else {                                             ;# main constructor
+            eval ::stooop::constructorDeclaration\
+                $fullClass $class 0 \{$arguments\} $args
+            # always generate default copy constructor:
+            ::stooop::generateDefaultCopyConstructor $fullClass
+        }
+    } elseif {[string equal ~$class $procedure]} {
+        # class destructor declaration
+        if {[llength $arguments]!=1} {
+            error "class $fullClass destructor must have 1 argument exactly"
+        }
+        if {![string equal [lindex $arguments 0] this]} {
+            error "class $fullClass destructor argument must be this"
+        }
+        # make sure of proper declaration order
+        # (use fastest method for testing procedure existence):
+        if {[catch {info body ::${fullClass}::$class}]} {
+            error "class $fullClass destructor defined before constructor"
+        }
+        ::stooop::destructorDeclaration\
+            $fullClass $class $arguments [lindex $args 0]
+    } else {
+        # regular member procedure, may be static if there is no this first
+        # argument
+        # make sure of proper declaration order:
+        if {[catch {info body ::${fullClass}::$class}]} {
+            error "class $fullClass member procedure $procedure defined before constructor"
+        }
+        ::stooop::memberProcedureDeclaration\
+            $fullClass $class $procedure $arguments [lindex $args 0]
+    }
+}
+
+# copy flag is set for user defined copy constructor:
+_proc ::stooop::constructorDeclaration {fullClass class copy arguments args} {
+    variable check
+    variable fullBases
+    variable variable
+
+    set number [llength $args]
+    # check that each base class constructor has arguments:
+    if {($number%2)==0} {
+        error "bad class $fullClass constructor declaration, a base class, contructor arguments or body may be missing"
+    }
+    if {[string equal [lindex $arguments end] args]} {
+        # remember that there is a variable number of arguments in class
+        # constructor
+        set variable($fullClass) {}
+    }
+    if {!$copy} {
+        # do not initialize (or reinitialize in case of multiple class file
+        # source statements) base classes for copy constructor
+        set fullBases($fullClass) {}
+    }
+    # check base classes and their constructor arguments:
+    foreach {base baseArguments} [lrange $args 0 [expr {$number-2}]] {
+        # fully qualify base class namespace by looking up constructor, which
+        # must exist
+        set constructor ${base}::[namespace tail $base]
+        # in case base class is defined in a file that is part of a package,
+        # make sure that file is sourced through the tcl package auto-loading
+        # mechanism by directly invoking the base class constructor while
+        # ignoring the resulting error
+        catch {$constructor}
+        # determine fully qualified base class name in user invocation level
+        # (up 2 levels from here since this procedure is invoked exclusively by
+        # proc)
+        set fullBase [namespace qualifiers\
+            [uplevel 2 namespace which -command $constructor]\
+        ]
+        if {[string length $fullBase]==0} {   ;# base constructor is not defined
+            if {[string match *$base $fullClass]} {
+                # if the specified base class name is included last in the fully
+                # qualified class name, assume that it was meant to be the same
+                error "class $fullClass cannot be derived from itself"
+            } else {
+                error "class $fullClass constructor defined before base class $base constructor"
+            }
+        }
+        # check and save base classes only for main constructor that defines
+        # them:
+        if {!$copy} {
+            if {[lsearch -exact $fullBases($fullClass) $fullBase]>=0} {
+                error "class $fullClass directly inherits from class $fullBase more than once"
+            }
+            lappend fullBases($fullClass) $fullBase
+        }
+        # replace new lines with blanks in base arguments part in case user has
+        # formatted long declarations with new lines
+        regsub -all {\n} $baseArguments { } constructorArguments($fullBase)
+    }
+    # setup access to class data (an empty named array)
+    # fully qualify tcl variable command for it may have been redefined within
+    # the class namespace
+    # since constructor is directly invoked by new, the object identifier must
+    # be valid, so debugging the procedure is pointless
+    set constructorBody \
+"::variable {}
+$check(code)
+"
+    # base class(es) derivation specified:
+    if {[llength $fullBases($fullClass)]>0} {
+        # invoke base class constructors before evaluating constructor body
+        # then set base part hidden derived member so that virtual procedures
+        # are invoked at base class level as in C++
+        if {[info exists variable($fullClass)]} {
+            # variable number of arguments in derived class constructor
+            foreach fullBase $fullBases($fullClass) {
+                if {![info exists constructorArguments($fullBase)]} {
+                    error "missing base class $fullBase constructor arguments from class $fullClass constructor"
+                }
+                set baseConstructor ${fullBase}::[namespace tail $fullBase]
+                if {\
+                    [info exists variable($fullBase)]&&\
+                    ([string first {$args} $constructorArguments($fullBase)]>=0)\
+                } {
+                    # variable number of arguments in base class constructor and
+                    # in derived class base class constructor arguments
+                    # use eval so that base class constructor sees arguments
+                    # instead of a list
+                    # only the last argument of the base class constructor
+                    # arguments is considered as a variable list
+                    # (it usually is $args but could be a procedure invocation,
+                    # such as [filter $args])
+                    # fully qualify tcl commands such as set, for they may have
+                    #  been redefined within the class namespace
+                    append constructorBody \
+"::set _list \[::list $constructorArguments($fullBase)\]
+::eval $baseConstructor \$this \[::lrange \$_list 0 \[::expr {\[::llength \$_list\]-2}\]\] \[::lindex \$_list end\]
+::unset _list
+::set ${fullBase}::(\$this,_derived) $fullClass
+"
+                } else {
+                    # no special processing needed
+                    # variable number of arguments in base class constructor or
+                    # variable arguments list passed as is to base class
+                    #  constructor
+                    append constructorBody \
+"$baseConstructor \$this $constructorArguments($fullBase)
+::set ${fullBase}::(\$this,_derived) $fullClass
+"
+                }
+            }
+        } else {                                 ;# constant number of arguments
+            foreach fullBase $fullBases($fullClass) {
+                if {![info exists constructorArguments($fullBase)]} {
+                    error "missing base class $fullBase constructor arguments from class $fullClass constructor"
+                }
+                set baseConstructor ${fullBase}::[namespace tail $fullBase]
+                append constructorBody \
+"$baseConstructor \$this $constructorArguments($fullBase)
+::set ${fullBase}::(\$this,_derived) $fullClass
+"
+            }
+        }
+    }                                 ;# else no base class derivation specified
+    if {$copy} {
+        # for user defined copy constructor, copy derived class member if it
+        # exists
+        append constructorBody \
+"::catch {::set (\$this,_derived) \$(\$[::lindex $arguments 1],_derived)}
+"
+    }
+    # finally append user defined procedure body:
+    append constructorBody [lindex $args end]
+    if {$copy} {
+        _proc ${fullClass}::_copy $arguments $constructorBody
+    } else {
+        _proc ${fullClass}::$class $arguments $constructorBody
+    }
+}
+
+_proc ::stooop::destructorDeclaration {fullClass class arguments body} {
+    variable check
+    variable fullBases
+
+    # setup access to class data
+    # since the object identifier is always valid at this point, debugging the
+    # procedure is pointless
+    set body \
+"::variable {}
+$check(code)
+$body
+"
+    # if there are any, delete base classes parts in reverse order of
+    # construction
+    for {set index [expr {[llength $fullBases($fullClass)]-1}]} {$index>=0}\
+        {incr index -1}\
+    {
+        set fullBase [lindex $fullBases($fullClass) $index]
+        append body \
+"::stooop::deleteObject $fullBase \$this
+"
+    }
+    _proc ${fullClass}::~$class $arguments $body
+}
+
+_proc ::stooop::memberProcedureDeclaration {\
+    fullClass class procedure arguments body\
+} {
+    variable check
+    variable pureVirtual
+
+    if {[info exists pureVirtual]} {                      ;# virtual declaration
+        if {$pureVirtual} {                          ;# pure virtual declaration
+            # setup access to class data
+            # evaluate derived procedure which must exists. derived procedure
+            # return value is automatically returned
+            _proc ${fullClass}::$procedure $arguments \
+"::variable {}
+$check(code)
+::uplevel 1 \$(\$this,_derived)::$procedure \[::lrange \[::info level 0\] 1 end\]
+"
+        } else {                                  ;# regular virtual declaration
+            # setup access to class data
+            # evaluate derived procedure and return if it exists
+            # else evaluate the base class procedure which can be invoked from
+            # derived class procedure by prepending _
+            _proc ${fullClass}::_$procedure $arguments \
+"::variable {}
+$check(code)
+$body
+"
+            _proc ${fullClass}::$procedure $arguments \
+"::variable {}
+$check(code)
+if {!\[::catch {::info body \$(\$this,_derived)::$procedure}\]} {
+::return \[::uplevel 1 \$(\$this,_derived)::$procedure \[::lrange \[::info level 0\] 1 end\]\]
+}
+::uplevel 1 ${fullClass}::_$procedure \[::lrange \[::info level 0\] 1 end\]
+"
+        }
+    } else {                                          ;# non virtual declaration
+        # setup access to class data:
+        _proc ${fullClass}::$procedure $arguments \
+"::variable {}
+$check(code)
+$body
+"
+    }
+}
+
+# generate default copy procedure which may be overriden by the user for any
+# class layer:
+_proc ::stooop::generateDefaultCopyConstructor {fullClass} {
+    variable fullBases
+
+    # generate code for cloning base classes layers if there is at least one
+    # base class
+    foreach fullBase $fullBases($fullClass) {
+        append body \
+"${fullBase}::_copy \$this \$sibling
+"
+    }
+    append body \
+"::stooop::copy $fullClass \$sibling \$this
+"
+    _proc ${fullClass}::_copy {this sibling} $body
+}
+
+
+if {[llength [array names ::env STOOOP*]]>0} {
+    # if one or more environment variables are set, we are in debugging mode
+
+    # gracefully handle multiple sourcing of this file:
+    catch {rename ::stooop::class ::stooop::_class}
+    # use a new class procedure instead of adding debugging code to existing one
+    _proc ::stooop::class {args} {
+        variable trace
+        variable check
+
+        set class [lindex $args 0]
+        if {$check(data)} {
+            # check write and unset operations on empty named array holding
+            # class data
+            uplevel 1 namespace eval $class\
+                [list {::trace variable {} wu ::stooop::checkData}]
+        }
+        if {[info exists ::env(STOOOPTRACEDATA)]} {
+            # trace write and unset operations on empty named array holding
+            # class data
+            uplevel 1 namespace eval $class [list\
+                "::trace variable {} $trace(dataOperations) ::stooop::traceData"\
+            ]
+        }
+        uplevel 1 ::stooop::_class $args
+    }
+
+    if {$::stooop::check(procedures)} {
+        # prevent the creation of any object of a pure interface class
+        # use a new virtual procedure instead of adding debugging code to
+        # existing one
+        # gracefully handle multiple sourcing of this file:
+        catch {rename ::stooop::virtual ::stooop::_virtual}
+        # keep track of interface classes (which have at least 1 pure virtual
+        # procedure):
+        _proc ::stooop::virtual {keyword name arguments args} {
+            variable interface
+
+            uplevel 1 ::stooop::_virtual [list $keyword $name $arguments] $args
+            parseProcedureName [uplevel 1 namespace current] $name\
+                fullClass procedure message
+            if {[llength $args]==0} {    ;# no procedure body means pure virtual
+                set interface($fullClass) {}
+            }
+        }
+    }
+
+    if {$::stooop::check(objects)} {
+        _proc invokingProcedure {} {
+            if {[catch {set procedure [lindex [info level -2] 0]}]} {
+                # no invoking procedure
+                return {top level}
+            } elseif {\
+                ([string length $procedure]==0)||\
+                [string equal $procedure namespace]\
+            } {                                 ;# invoked from a namespace body
+                return "namespace [uplevel 2 namespace current]"
+            } else {
+                # store fully qualified name, visible from creator procedure
+                # invoking procedure
+                return [uplevel 3 namespace which -command $procedure]
+            }
+        }
+    }
+
+    if {$::stooop::check(procedures)||$::stooop::check(objects)} {
+        # gracefully handle multiple sourcing of this file:
+        catch {rename ::stooop::new ::stooop::_new}
+        # use a new new procedure instead of adding debugging code to existing
+        # one:
+        _proc ::stooop::new {classOrId args} {
+            variable newId
+            variable check
+
+            if {$check(procedures)} {
+                variable fullClass
+                variable interface
+            }
+            if {$check(objects)} {
+                variable creator
+            }
+            if {$check(procedures)} {
+                if {[string is integer $classOrId]} {
+                    # first argument is an object identifier
+                    # class code, if from a package, must already be loaded
+                    set fullName $fullClass($classOrId)
+                } else {                            ;# first argument is a class
+                    # generate constructor name:
+                    set constructor ${classOrId}::[namespace tail $classOrId]
+                    # force loading in case class is in a package so namespace
+                    # commands work properly:
+                    catch {$constructor}
+                    set fullName [namespace qualifiers\
+                        [uplevel 1 namespace which -command $constructor]\
+                    ]
+                    # anticipate full class name storage in original new{} in
+                    # order to avoid invalid object identifier error in
+                    # checkProcedure{} when member procedure is invoked from
+                    # within contructor, in which case full class name would
+                    # have yet to be stored.
+                    set fullClass([expr {$newId+1}]) $fullName
+                    # new identifier is really incremented in original new{}
+                }
+                if {[info exists interface($fullName)]} {
+                    error "class $fullName with pure virtual procedures should not be instanciated"
+                }
+            }
+            if {$check(objects)} {
+                # keep track of procedure in which creation occured (new
+                # identifier is really incremented in original new{})
+                set creator([expr {$newId+1}]) [invokingProcedure]
+            }
+            return [uplevel 1 ::stooop::_new $classOrId $args]
+        }
+    }
+
+    if {$::stooop::check(objects)} {
+        _proc ::stooop::delete {args} {
+            variable fullClass
+            variable deleter
+
+            # keep track of procedure in which deletion occured:
+            set procedure [invokingProcedure]
+            foreach id $args {
+                uplevel 1 ::stooop::deleteObject $fullClass($id) $id
+                unset fullClass($id)
+                set deleter($id) $procedure
+            }
+        }
+    }
+
+    # return the unsorted list of ancestors in class hierarchy:
+    _proc ::stooop::ancestors {fullClass} {
+        variable ancestors                         ;# use a cache for efficiency
+        variable fullBases
+
+        if {[info exists ancestors($fullClass)]} {
+            return $ancestors($fullClass)                  ;# found in the cache
+        }
+        set list {}
+        foreach class $fullBases($fullClass) {
+            set list [concat $list [list $class] [ancestors $class]]
+        }
+        set ancestors($fullClass) $list                         ;# save in cache
+        return $list
+    }
+
+    # since this procedure is always invoked from a debug procedure, take the
+    # extra level in the stack frame into account
+    # parameters (passed as references) that cannot be determined are not set
+    _proc ::stooop::debugInformation {\
+        className fullClassName procedureName fullProcedureName\
+        thisParameterName\
+    } {
+        upvar 1 $className class $fullClassName fullClass\
+            $procedureName procedure $fullProcedureName fullProcedure\
+            $thisParameterName thisParameter
+        variable declared
+
+        set namespace [uplevel 2 namespace current]
+        # not in a class namespace:
+        if {[lsearch -exact [array names declared] $namespace]<0} return
+        # remove redundant global qualifier:
+        set fullClass [string trimleft $namespace :]
+        set class [namespace tail $fullClass]                      ;# class name
+        set list [info level -2]
+        set first [lindex $list 0]
+        if {([llength $list]==0)||[string equal $first namespace]}\
+            return                     ;# not in a procedure, nothing else to do
+        set procedure $first
+        # procedure must be known at the invoker level:
+        set fullProcedure [uplevel 3 namespace which -command $procedure]
+        set procedure [namespace tail $procedure]        ;# strip procedure name
+        if {[string equal $class $procedure]} {                   ;# constructor
+            set procedure constructor
+        } elseif {[string equal ~$class $procedure]} {             ;# destructor
+            set procedure destructor
+        }
+        if {[string equal [lindex [info args $fullProcedure] 0] this]} {
+            # non static procedure
+            # object identifier is first argument:
+            set thisParameter [lindex $list 1]
+        }
+    }
+
+    # check that member procedure is valid for object passed as parameter:
+    _proc ::stooop::checkProcedure {} {
+        variable fullClass
+
+        debugInformation class qualifiedClass procedure qualifiedProcedure this
+        # static procedure, no checking possible:
+        if {![info exists this]} return
+        # in constructor, checking useless since object is not yet created:
+        if {[string equal $procedure constructor]} return
+        if {![info exists fullClass($this)]} {
+            error "$this is not a valid object identifier"
+        }
+        set fullName [string trimleft $fullClass($this) :]
+        # procedure and object classes match:
+        if {[string equal $fullName $qualifiedClass]} return
+        # restore global qualifiers to compare with internal full class array
+        # data
+        if {[lsearch -exact [ancestors ::$fullName] ::$qualifiedClass]<0} {
+            error "class $qualifiedClass of $qualifiedProcedure procedure not an ancestor of object $this class $fullName"
+        }
+    }
+
+    # gather current procedure data, perform substitutions and output to trace
+    # channel:
+    _proc ::stooop::traceProcedure {} {
+        variable trace
+
+        debugInformation class qualifiedClass procedure qualifiedProcedure this
+        # all debug data is available since we are for sure in a class procedure
+        set text $trace(procedureFormat)
+        regsub -all %C $text $qualifiedClass text  ;# fully qualified class name
+        regsub -all %c $text $class text
+        # fully qualified procedure name:
+        regsub -all %P $text $qualifiedProcedure text
+        regsub -all %p $text $procedure text
+        if {[info exists this]} {                        ;# non static procedure
+            regsub -all %O $text $this text
+            # remaining arguments:
+            regsub -all %a $text [lrange [info level -1] 2 end] text
+        } else {                                             ;# static procedure
+            regsub -all %O $text {} text
+            # remaining arguments:
+            regsub -all %a $text [lrange [info level -1] 1 end] text
+        }
+        puts $trace(procedureChannel) $text
+    }
+
+    # check that class data member is accessed within procedure of identical
+    # class
+    # then if procedure is not static, check that only data belonging to the
+    # object passed as parameter is accessed
+    _proc ::stooop::checkData {array name operation} {
+        scan $name %u,%s identifier member
+        # ignore internally defined members:
+        if {[info exists member]&&[string equal $member _derived]} return
+
+        debugInformation class qualifiedClass procedure qualifiedProcedure this
+        # no checking can be done outside of a class namespace:
+        if {![info exists class]} return
+        # determine array full name:
+        set array [uplevel 1 [list namespace which -variable $array]]
+        if {![info exists procedure]} {              ;# inside a class namespace
+            # compare with empty named array fully qualified name:
+            if {![string equal $array ::${qualifiedClass}::]} {
+                # trace command error message is automatically prepended and
+                # indicates operation
+                error\
+                    "class access violation in class $qualifiedClass namespace"
+            }
+            return                                                       ;# done
+        }
+        # ignore internal copy procedure:
+        if {[string equal $qualifiedProcedure ::stooop::copy]} return
+        if {![string equal $array ::${qualifiedClass}::]} {
+            # compare with empty named array fully qualified name
+            # trace command error message is automatically prepended and
+            # indicates operation
+            error "class access violation in procedure $qualifiedProcedure"
+        }
+        # static procedure, all objects can be accessed:
+        if {![info exists this]} return
+        # static data members can be accessed:
+        if {![info exists identifier]} return
+        # check that accessed data belongs to this object:
+        if {$this!=$identifier} {
+            error "object $identifier access violation in procedure $qualifiedProcedure acting on object $this"
+        }
+    }
+
+    # gather accessed data member information, perform substitutions and output
+    # to trace channel
+    _proc ::stooop::traceData {array name operation} {
+        variable trace
+
+        scan $name %u,%s identifier member
+        # ignore internally defined members:
+        if {[info exists member]&&[string equal $member _derived]} return
+
+        # ignore internal destruction:
+        if {\
+            ![catch {lindex [info level -1] 0} procedure]&&\
+            [string equal ::stooop::deleteObject $procedure]\
+        } return
+        set class {}                           ;# in case we are outside a class
+        set qualifiedClass {}
+        set procedure {}             ;# in case we are outside a class procedure
+        set qualifiedProcedure {}
+
+        debugInformation class qualifiedClass procedure qualifiedProcedure this
+        set text $trace(dataFormat)
+        regsub -all %C $text $qualifiedClass text  ;# fully qualified class name
+        regsub -all %c $text $class text
+        if {[info exists member]} {
+            regsub -all %m $text $member text
+        } else {
+            regsub -all %m $text $name text                     ;# static member
+        }
+        # fully qualified procedure name:
+        regsub -all %P $text $qualifiedProcedure text
+        regsub -all %p $text $procedure text
+        # fully qualified array name with global qualifiers stripped:
+        regsub -all %A $text [string trimleft\
+            [uplevel 1 [list namespace which -variable $array]] :\
+        ] text
+        if {[info exists this]} {                        ;# non static procedure
+            regsub -all %O $text $this text
+        } else {                                             ;# static procedure
+            regsub -all %O $text {} text
+        }
+        array set string {r read w write u unset}
+        regsub -all %o $text $string($operation) text
+        if {[string equal $operation u]} {
+            regsub -all %v $text {} text              ;# no value when unsetting
+        } else {
+            regsub -all %v $text [uplevel 1 set ${array}($name)] text
+        }
+        puts $trace(dataChannel) $text
+    }
+
+    if {$::stooop::check(objects)} {
+        # print existing objects along with creation procedure, with optional
+        # class pattern (see the string Tcl command manual)
+        _proc ::stooop::printObjects {{pattern *}} {
+            variable fullClass
+            variable creator
+
+            puts "stooop::printObjects invoked from [invokingProcedure]:"
+            foreach id [lsort -integer [array names fullClass]] {
+                if {[string match $pattern $fullClass($id)]} {
+                    puts "$fullClass($id)\($id\) + $creator($id)"
+                }
+            }
+        }
+
+        # record all existing objects for later report:
+        _proc ::stooop::record {} {
+            variable fullClass
+            variable checkpointFullClass
+
+            puts "stooop::record invoked from [invokingProcedure]"
+            catch {unset checkpointFullClass}
+            array set checkpointFullClass [array get fullClass]
+        }
+
+        # print all new or deleted object since last record, with optional class
+        # pattern:
+        _proc ::stooop::report {{pattern *}} {
+            variable fullClass
+            variable checkpointFullClass
+            variable creator
+            variable deleter
+
+            puts "stooop::report invoked from [invokingProcedure]:"
+            set checkpointIds [lsort -integer [array names checkpointFullClass]]
+            set currentIds [lsort -integer [array names fullClass]]
+            foreach id $currentIds {
+                if {\
+                    [string match $pattern $fullClass($id)]&&\
+                    ([lsearch -exact $checkpointIds $id]<0)\
+                } {
+                    puts "+ $fullClass($id)\($id\) + $creator($id)"
+                }
+            }
+            foreach id $checkpointIds {
+                if {\
+                    [string match $pattern $checkpointFullClass($id)]&&\
+                    ([lsearch -exact $currentIds $id]<0)\
+                } {
+                    puts "- $checkpointFullClass($id)\($id\) - $deleter($id) + $creator($id)"
+                }
+            }
+        }
+    }
+
+}
diff --git a/tcllib/modules/stooop/stooop.test b/tcllib/modules/stooop/stooop.test
new file mode 100644
index 0000000..0eca62b
--- /dev/null
+++ b/tcllib/modules/stooop/stooop.test
@@ -0,0 +1,9398 @@
+# -*- 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:
diff --git a/tcllib/modules/stooop/stooop_man.html b/tcllib/modules/stooop/stooop_man.html
new file mode 100644
index 0000000..31ed091
--- /dev/null
+++ b/tcllib/modules/stooop/stooop_man.html
@@ -0,0 +1,1194 @@
+<!-- Copyright (c) 2001 by Jean-Luc Fontaine <jfontain@free.fr> -->
+<!--$Id: stooop_man.html,v 1.3 2004/01/15 06:36:14 andreas_kupries Exp $-->
+<html lang="en">
+<head>
+   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+   <title>stooop (Simple Tcl Only Object Oriented Programming)</title>
+</head>
+<body>
+
+<center><h1>stooop</h1></center>
+
+<center><h2>(Simple Tcl Only Object Oriented Programming)</h2></center>
+
+Stooop is an extension to the great Tcl language written in Tcl itself. The object oriented features of stooop are modeled after the C++ programming language while following the Tcl language philosophy.
+
+<h3>Contents</h3>
+
+<ul>
+  <li><a href="#about">About this document</a>
+  <li><a href="#introduction">Introduction</a>
+  <li><a href="#simple">Simple example</a>
+  <li><a href="#conventions">Coding conventions</a><ul>
+    <li><a href="#definition">Class definition</a>
+    <li><a href="#procedures">Member procedures</a><ul>
+      <li><a href="#constructor">Constructor</a>
+      <li><a href="#destructor">Destructor</a>
+      <li><a href="#proceduresnonstatic">Non static</a>
+      <li><a href="#proceduresstatic">Static</a>
+      <li><a href="#copy">Copy constructor</a>
+    </ul>
+    <li><a href="#data">Member data</a><ul>
+      <li><a href="#datanonstatic">Non static</a>
+      <li><a href="#datastatic">Static</a>
+    </ul>
+  </ul>
+  <li><a href="#keywords">Commands</a><ul>
+    <li><a href="#class">class</a>
+    <li><a href="#new">new</a>
+    <li><a href="#delete">delete</a>
+    <li><a href="#virtual">virtual</a>
+    <li><a href="#classof">classof</a>
+  </ul>
+  <li><a href="#package">Package</a><ul>
+    <li><a href="#installation">Installation</a>
+    <li><a href="#creation">Creation</a>
+  </ul>
+  <li><a href="#examples">Examples</a><ul>
+    <li><a href="#parallel">Parallel with C++</a>
+    <li><a href="#graphical">Graphical demonstration</a>
+    <li><a href="#widget">Widget class</a>
+    <li><a href="#array">Member array</a>
+  </ul>
+  <li><a href="#utility">Utility classes</a><ul>
+    <li><a href="#switched">switched</a>
+  </ul>
+  <li><a href="#debugging">Debugging</a><ul>
+    <li><a href="#check">member check</a><ul>
+      <li><a href="#procedurecheck">procedure</a>
+      <li><a href="#datacheck">data</a>
+    </ul>
+    <li><a href="#trace">member trace</a><ul>
+      <li><a href="#proceduretrace">procedure</a>
+      <li><a href="#datatrace">data</a>
+    </ul>
+    <li><a href="#objects">objects</a><ul>
+      <li><a href="#objects.printing">printing</a>
+      <li><a href="#objects.recording">recording</a>
+      <li><a href="#objects.reporting">reporting</a>
+    </ul>
+  </ul>
+  <li><a href="#notes">Notes</a><ul>
+    <li><a href="#design">On design choices</a>
+    <li><a href="#implementation">On implementation</a>
+  </ul>
+  <li><a href="#misc">Miscellaneous information</a>
+</ul>
+
+<h3><a name="about"></a>About this document</h3>
+
+This document contains general information, reference information and many examples designed to help the programmer understand and use the stooop extension (version 4.1.1 and above).
+
+<p>A working knowledge of object oriented programming techniques and a related programming language (C++, Java, ...) significantly helps understand this document.
+
+<h3><a name="introduction"></a>Introduction</h3>
+
+After some time writing Tcl/Tk code, I felt that I needed a way to improve the structure of my code, and why not use an object oriented approach, since I knew (but does anybody really? :-) C++. As I have used Tcl quite extensively in several commercial applications running on different operating systems and hardware, I decided to use a strict Tcl implementation for my object oriented extension. Consequently, stooop is compatible with all the Tcl ports (UNIX, Windows, MacIntosh).
+
+<p>Great care was taken so that this extension would no adverse impact on performance. Furthermore, designing your code in an object oriented should improve its performance, by focusing on well written pieces of reusable code.
+
+<p>Stooop only introduces a few new commands: <a href="#class">class</a>, <a href="#new">new</a>, <a href="#delete">delete</a>, <a href="#virtual">virtual</a> and <a href="#classof">classof</a>. Along with a few coding conventions, that is basically all you need to know to use stooop. Stooop is meant to be as simple to use as possible.
+
+<p>Starting with stooop version 3.2, nested classes are supported (see <a href="#class">class</a>), whereas version 3.3 and above support procedure and data members checking as well as tracing (see <a href="#debugging">debugging</a>).
+
+<p>Tcl version 8.2 and above supports the empty name array syntax, as in:
+
+<pre>set (m) 0 ;# set member m of array {} to 0
+set n $(m) ;# which actually sets n to 0</pre>
+
+This feature greatly simplifies class member manipulation in stooop classes and significantly improves performance. Stooop version 4.0 and above also uses this feature internally for further improvements, without sacrificing backward compatibility: code written against stooop versions 3.7 and below still works with stooop version 4.0 and above, but can be gradually moved to the simpler syntax when convenient.<br>
+Stooop 4.1 and above will only work out of the box with Tcl 8.3 and above.
+
+<h3><a name="simple"></a>Simple example</h3>
+
+Let us start with a code sample that will give you some feeling on how stooop works:
+
+<pre>package require stooop 4                                  ;# load stooop package
+namespace import stooop::*                ;# and import class, new, ... commands</pre>
+
+<pre>class shape {                                           ;# base class definition
+    proc shape {this x y} {                            ;# base class constructor
+        set ($this,x) $x                           ;# data member initialization
+        set ($this,y) $y
+    }
+    proc ~shape {this} {}                               ;# base class destructor
+    # pure virtual draw: must be implemented in derived classes
+    virtual proc draw {this}
+    virtual proc rotate {this angle} {}                 ;# do nothing by default
+}
+proc shape::move {this x y} {            ;# external member procedure definition
+    set ($this,x) $x
+    set ($this,y) $y
+    draw $this               ;# shape::draw invokes derived class implementation
+}
+
+class triangle {                                             ;# class definition
+    proc triangle {this x y} shape {$x $y} {               ;# derived from shape
+        # triangle constructor implementation
+    }
+    proc ~triangle {this} {}
+    proc draw {this} {
+        # triangle specific implementation
+    }
+    proc rotate {this angle} {
+        # triangle specific implementation
+    }
+}
+
+class circle {}        ;# empty class definition, procedures are defined outside
+proc circle::circle {this x y} shape {$x $y} {             ;# derived from shape
+    # circle constructor implementation
+}
+proc circle::~circle {this} {}
+proc circle::draw {this} {
+    # circle specific implementation
+}
+# circle::rotate procedure is a noop, no need to overload
+
+lappend shapes [new circle 20 20] [new triangle 80 20]
+foreach object $shapes {
+    shape::draw $object
+    shape::rotate $object 45
+}
+eval delete $shapes</pre>
+
+<h3><a name="conventions"></a>Coding conventions</h3>
+
+I have tried to make stooop Tcl code look like C++ code. There are exceptions of course.
+
+<h4><a name="definition"></a>Class definition</h4>
+
+The syntax is very simple:
+
+<pre>class className { ...</pre>
+
+<p>The member procedures are then defined, inside or outside the class definition (see below). Note that the base classes if any are defined within the constructor declaration where they are required for eventually passing constructor parameters, not in the actual class declaration where they would then be redundant.
+
+<p>As a class is a namespace, it is just as easy to nest classes as it is namespaces.
+
+<h4><a name="procedures"></a>Member procedures</h4>
+
+They can be defined inside or outside their class definition. When defined inside the class definition, the class name qualifier (<i>shape::</i> for example) before the procedure name must be omitted (a class is a Tcl namespace). When defined outside the class definition, the class name qualifier must be present (same reason). You may notice that the class definition and the related member procedures look very much like the Tcl <i>namespace</i> feature: it is because classes are indeed namespaces with a few more features added to support object orientation.
+
+<p>Member procedures are named as in C++ (for example, the <i>rotate</i> procedure of the class <i>shape</i> is referred to as <i>shape::rotate</i> in the global namespace). They are defined using the Tcl <i>proc</i> command, which is redefined by stooop in order to do some specific additional processing. Of course, global level and other namespaces procedures are not affected by stooop.
+
+<h5><a name="constructor"></a>Constructor</h5>
+
+A constructor is used to initialize an object of its class. The constructor is invoked by the <a href="#new">new</a> operator when an object of the class is created (instanciated in OO terms). The constructor is named as in C++ (for example, the <i>shape</i> constructor fully qualified name is <i>shape::shape</i>).
+
+<p>The constructor always takes the object identifier (a unique value generated by the command new) as the first parameter, plus eventually additional parameters as in the normal Tcl proc command. Arguments with default values are allowed, and so are variable number of arguments (see below). In all cases, the first parameter must be named <b>this</b>.
+
+<p><i><b>Note</b>: the object identifier is a unique integer value which is internally incremented by stooop each time a new object is created. Consequently, the greater the object identifier, the younger the object.</i>
+
+<p>Sample code of a constructor of a simple class with no base class:
+
+<pre>class shape {
+    proc shape {this x y} {
+        # implementation here
+    }
+}</pre>
+
+If a class is derived from one or more base classes, the derived class constructor defines the base classes and their constructor arguments before the actual body of the constructor.
+
+<p><i><b>Note</b>: base classes are not defined at the class command level, because it would be redundant with the constructor definition, which is mandatory.</i>
+
+<p>The derived class constructor parameters are followed by "base class names / constructor arguments" pairs. For each base class, there must be a corresponding list of constructor arguments to be used when the object is constructed when the new operator is invoked with the derived class name as argument.
+
+<p>Sample code for a class constructor with a single base class:
+
+<pre>class circle {}
+proc circle::circle {this x y} shape {$x $y} {
+    # circle constructor implementation
+}</pre>
+
+Sample code for a class constructor with multiple base classes:
+
+<pre>class hydroplane {
+    proc hydroplane {this wingspan length} plane {
+        $wingspan $length
+    } boat {
+        $length
+    {
+        # constructor implementation
+    }
+}</pre>
+
+The base class constructor arguments must be prefixed with dollar signs since they will be evaluated at the time the object is constructed, right before the base class constructor is invoked. This technique allows, as in C++, some actual processing to be done on the base class arguments at construction time. The <b>this</b> argument to the base class constructor must not be specified for it is automatically generated by stooop.
+
+<p>Sample code for a derived class constructor with base class constructor arguments processing:
+
+<pre>class circle {
+    proc circle {this x y} shape {
+        [expr round($x)] [expr round($y)]
+    } {
+        # constructor implementation
+    }
+}</pre>
+
+The base class(es) constructor(s) is(are) automatically invoked before the derived class constructor body is evaluated. Thus layered object construction occurs in the same order as in C++.
+
+<p>Variable length arguments are a special case and depend on both the derived class constructor arguments and those of the base class.
+
+<p>If both derived and base class constructors take a variable number of arguments (through the <i>args</i> special argument (see Tcl proc manual page)), the base class constructor will also see the variable arguments part as separate arguments. In other words, the following works as expected:
+
+<pre>class base {}
+proc base::base {this parameter args} {
+    array set options $args
+}
+class derived {}
+proc derived::derived {this parameter args} base {
+    $parameter $args
+} {}
+new derived someData -option value -otherOption otherValue</pre>
+
+Actually, if you want to get fancy, to allow some processing on the derived class constructor variable arguments, the last element (and only the last) of the derived class constructor arguments is considered variable if it contains the string <i>$args</i>. For example:
+
+<pre>class base {
+    proc base {this parameter args} {
+        array set options $args
+    }
+}
+class derived {
+    proc derived {this parameter args} base {
+        $parameter [process $args]
+    } {}
+    proc process {arguments} {
+        # do some processing on arguments list
+        return $arguments
+    }
+}
+new derived someData -option value -otherOption otherValue</pre>
+
+<h5><a name="destructor"></a>Destructor</h5>
+
+The destructor is used to clean up an object before it is removed from memory. The destructor is invoked by the <a href="#delete">delete</a> operator when an object of the class is deleted. The destructor is named as in C++ (for example, the shape constructor fully qualified name is <i>shape::~shape</i>).
+
+<p>The destructor always takes the object identifier (a unique value previously generated and returned by the operator new) as the only parameter, which must be named <b>this</b>.
+
+<p>The base class(es) destructor(s) is(are) invoked at the end of the derived class destructor body. Thus layered object destruction occurs in the same order as in C++.
+
+<p>Sample code of a class destructor:
+
+<pre>class shape {
+    proc ~shape {this} {
+        # implementation here
+    }
+}</pre>
+
+Contrary to C++, a destructor cannot (nor does it need to) be <a href="#virtual">virtual</a>. Even if it does nothing, a destructor <b>must</b> always be defined.
+
+<h5><a name="proceduresnonstatic"></a>Non static</h5>
+
+A <i>non static</i> member procedure performs some action on an object of a class. The member procedure is named as a member function in C++ (for example, the shape class move member procedure is known as <i>shape::move</i> in the Tcl global namespace).
+
+<p>The member procedure always takes the object identifier (a unique value generated and returned by the operator new) as the first parameter, plus eventually additional parameters as in the normal Tcl proc command. Arguments with default values are allowed, and so are variable number of arguments. In all cases, the first parameter must be named <b>this</b>.
+
+<p>Sample code of a member procedure:
+
+<pre>proc shape::move {this x y} {
+    set ($this,x) $x
+    set ($this,y) $y
+    draw $this       ;# invoke another member procedure
+}</pre>
+
+A non static member procedure may be a <a href="#virtual">virtual</a> procedure.
+
+<h5><a name="proceduresstatic"></a>Static</h5>
+
+A <i>static</i> member procedure performs some action independently of the individual objects of a class. The member procedure is named as a member function in C++ (for example, the shape class add static member procedure is defined as <i>shape::add</i> outside its class definition, <i>add</i> inside).
+
+<p>However, with stooop, there is no static specifier: a member procedure is considered static if its first parameter is not named <b>this</b>. Arguments to the procedure are allowed as in the normal Tcl proc command. Arguments with default values are also allowed, and so are variable number of arguments.
+
+<p>Sample code of a static member procedure:
+
+<pre>proc shape::add {newShape} {
+    # append new shape to global list of shape
+    lappend ($shapes) $newShape
+}</pre>
+
+Often, static member procedures access static member data (see <a href="#datastatic">Static Member Data</a>).
+
+<p>A static member procedure may not be a virtual procedure.
+
+<h5><a name="copy"></a>Copy constructor</h5>
+
+<i><b>Note</b>: if you never create objects by copying (which is generally the case), you can skip this section.</i>
+
+<p>Let us start by making it clear that stooop generates a default copy constructor whenever a class main constructor is defined. This default copy constructor just performs a simple per data member copy, as does C++.
+
+<p>The user defined class copy constructor is optional as in C++. If it exists, it will be invoked (instead of the default copy constructor) when the operator <a href="#new">new</a> is invoked on an object of the class or a derived class.
+
+<p>The copy constructor takes 2 arguments: the <i>this</i> object identifier used to initialize the data members of the object to be copied to, and the <i>copy</i> identifier of the object to be copied from, as in:
+
+<pre>proc plane::plane {this copy} {
+    set ($this,wingspan) $($copy,wingspan)
+    set ($this,length) $($copy,length)
+    set ($this,engine) [new $($copy,engine)]
+}</pre>
+
+As in regular member procedures, the first parameter name must be <b>this</b>, whereas the second parameter must be named <b>copy</b> to differentiate from the class constructor. In other words, the copy constructor always takes 2 and only 2 arguments (named this and copy).
+
+<p>The copy constructor must be defined when the default behavior (straightforward data members copy) (see the <a href="#new">new operator</a>) is not sufficient, as in the example above. It is most often used when the class object contains sub objects. As in C++ when sub objects are referenced through pointers, only the sub object identifiers (see them as pointers) are copied when an object is copied, not the objects they point to. It is then necessary to define a copy procedure that will actually create new sub objects instead of just defaulting to copying identifiers.
+
+<p>If the class has one or more base classes, then the copy constructor must pass arguments to the base class(es) constructor(s), just as the main constructor does, as in the following example:
+
+<pre>class ship {
+    proc ship {this length} {}
+}
+class carrier {}
+proc carrier::carrier {this length} ship {$length} {}
+proc carrier::carrier {this copy} ship {
+    $ship::($copy,length)
+} {
+    set ship::($this,planes) {}
+    foreach plane $ship($copy,planes) {                   ;# copy all the planes
+        lappend ship($this,planes) [new $plane]
+    }
+}</pre>
+
+The stooop library checks that the copy constructor properly initializes the base class(es) through its(their) constructor(s) by using the regular constructor as reference. Obviously and consequently, stooop also checks that the regular constructor is defined prior to the copy constructor.
+
+<p>If you use <a href="#array">member arrays</a>, you must copy them within the copy constructor, as they are not automatically handled by stooop, which only knows <a href="#data">member data</a> in the automatically generated default copy constructor.
+
+<h4><a name="data"></a>Member data</h4>
+
+All class and object data is stored in an associative array local to the class namespace (remember, a class is actually a namespace). The array name is empty, and the corresponding Tcl variable declaration is automatically inserted within class namespace and procedures (but you do not need to worry about this transparent operation).
+
+<p>Sample code:
+
+<pre>class shape {}
+proc shape::shape {this x y} {
+    # set a few members of the class namespace empty named array
+    set ($this,x) $x
+    set ($this,y) $y
+    # now read them
+    puts "coordinates: $($this,x), $($this,y)"
+}</pre>
+In order to access other classes data, whether they are base classes or
+not, a fully qualified name is always required, whereas no special declaration
+(global, variable, ...) is required.
+<p>Sample code:
+<pre>proc circle::circle {this x y diameter} shape {$x $y} {
+    set ($this,diameter) $diameter
+    puts "coordinates: $shape::($this,x), $shape::($this,y)"
+}</pre>
+
+<h5><a name="datanonstatic"></a>Non static</h5>
+
+Non static data is indexed within the class array by prepending the object identifier (return value of the <i>new</i> operator) to the actual member name. A comma is used to separate the identifier and the member name.
+
+<p>Much as an object pointer in C++ is unique, the object identifier in <i>stooop</i> is also unique. Access to any base class data is thus possible by directly indexing the base class array.
+
+<p>Sample code:
+
+<pre>proc shape::shape {this x y} {
+    set ($this,x) $x
+    set ($this,y) $y
+}
+proc circle::circle {this x y diameter} shape {$x $y} {
+    set ($this,diameter) $diameter
+}
+proc circle::print {this} {
+    puts "circle $this data:"
+    puts "diameter: $($this,diameter)"
+    puts "coordinates: $shape::($this,x), $shape::($this,y)"
+}</pre>
+
+<h5><a name="datastatic"></a>Static</h5>
+
+<i>Static</i> (as in C++) data members are simply stored without prepending the object identifier to the member name, as in:
+
+<pre>proc shape::register {newShape} {
+    lappend (list) $newShape ;# append new shape to global list of shapes
+}</pre>
+
+<h3><a name="keywords"></a>Commands</h3>
+
+Only 4 new commands <a href="#class">class</a>, <a href="#new">new</a>, <a href="#delete">delete</a> and <a href="#virtual">virtual</a> need to be known in order to use <i>stooop</i>. Furthermore, their meaning should be obvious to C++ programmers. There is also a <a href="#classof">classof</a> command that you can use if you need RTTI (runtime type identification).
+
+<h4><a name="class"></a>class</h4>
+
+The <b>class</b> command introduces a new class declaration.
+
+<p>A class is also a namespace although you do not need to worry about it, but it does have some nice side effects. The following code works as expected:
+
+<pre>class shape {
+    set (list) {} ;# initialize list of shapes, a static data member
+    proc shape {this x y} {
+        lappend (list) $this             ;# keep track of new shapes
+    }
+    ...
+}</pre>
+
+This works because all data for the class (static and non static) is held in the empty named array, which the class command declares as a variable (see the corresponding Tcl command) for the class namespace and within every member procedure.
+
+<p>Starting with version 3.2, nested classes are allowed, which makes the following code possible:
+
+<pre>class car {
+    proc car {this manufacturer type} {
+        set ($this,wheels) [list\
+            [new wheel 18] [new wheel 18] [new wheel 18] [new wheel 18]\
+        ]
+        ...
+    }
+    ...
+    class part {
+        ...
+    }
+    class wheel {
+        proc wheel {this diameter} car::part {} {
+            set ($this,diameter) $diameter
+            ...
+        }
+        proc print {this} {
+            puts "wheel of $($this,diameter) diameter"
+        }
+        ...
+    }
+}</pre>
+
+There is quite a lot to say about the example above.
+
+<p>First, why would I use a nested class? Because it is cleaner that creating <i>carPart</i> and <i>carWheel</i> classes and saves on global namespace pollution.
+
+<p>Second, why does "<i>new wheel</i>" work from inside the car constructor? Because it invokes the <i>wheel::wheel</i> constructor, visible from the car namespace.
+
+<p>Third, why can't I simply derive wheel from <i>part</i> instead of <i>car::part</i>? Well, you must fully qualify the class that you derive from because the <i>part::part</i> constructor is not visible from within the wheel namespace.
+
+<p>Whenever you have a problem with nested classes, think in terms of namespaces, as classes are indeed namespaces (it should be clear to you by now :-).
+
+<h4><a name="new"></a>new</h4>
+
+The <i>new</i> operator is used to create an object of a class, either by explicit construction, or by copying an existing object.
+
+<p>When explicitly creating an object, the first argument is the class name and is followed by the arguments needed by the class constructor. New when invoked generates a unique identifier for the object to be created. This identifier is the value of the <b>this</b> parameter, first argument to the class constructor, which is invoked by new.
+
+<p>Sample code:
+
+<pre>proc shape::shape {this x y} {
+    set ($this,x) $x
+    set ($this,y) $y
+}
+set object [<b>new</b> shape 100 50]</pre>
+
+new generates a new object identifier, say 1234. shape constructor is then called, as in:
+
+<pre>shape::shape 1234 100 50</pre>
+
+If the class is derived from one or more base classes, the base class(es) constructor(s) will be automatically called in the proper order, as in:
+
+<pre>proc hydroplane::hydroplane {this wingspan length} plane {
+    $wingspan $length
+} boat {
+    $length
+} {}
+set object [<b>new</b> hydroplane 10 7]</pre>
+
+new generates a new object identifier, say 1234, plane constructor is called, as in:
+
+<pre>plane::plane 1234 10 7</pre>
+
+then boat constructor is called, as in:
+
+<p>boat::boat 1234 7
+
+<p>finally hydroplane constructor is called, as in:
+
+<p>hydroplane::hydroplane 1234 10 7
+
+<p>The new operator can also be used to copy objects when an object identifier is its only argument. A new object of the same class is then created, copy of the original object.
+
+<p>An object is copied by copying all its data members (but not including <a href="#array">member arrays</a>) starting from the base class layers. If the copy constructor procedure exists for any class layer, it is invoked by the <i>new</i> operator <b>instead</b> of the default data member copy procedure (see the <a href="#copy">copy constructor</a> section for examples).
+
+<p>Sample code:
+
+<pre>set plane [new plane 100 57 RollsRoyce]
+set planes [list $plane [new $plane] [new $plane]]</pre>
+
+<h4><a name="delete"></a>delete operator</h4>
+
+The <i>delete</i> operator is used to delete one or several objects. It takes one or more object identifiers as argument(s). Each object identifier is the value returned by <i>new</i> when the object was created. Delete invokes the class destructor for each object to be deleted.
+
+<p>Sample code:
+
+<pre>proc shape::shape {this x y} {}
+proc shape::~shape {this} {
+
+proc triangle::triangle {this x y} shape {$x $y} {}
+proc triangle::~triangle {this} {}
+
+proc circle::circle {this x y} shape {$x $y} {}
+proc circle::~circle {this} {}
+
+set circle [new circle 100 50]
+set triangle [new triangle 200 50]
+<b>delete</b> $circle $triangle</pre>
+
+circle identifier is set to, say 1234, triangle identifier is set to, say 1235. delete circle object first, circle destructor is invoked, as in:
+
+<pre>circle::~circle 1234</pre>
+
+then shape destructor is invoked, as in:
+
+<p>shape::~shape 1234
+
+<p>then delete triangle object...
+
+<p>For each object class, if it is derived from one or more base classes, the base class(es) destructor(s) are automatically called in reverse order of the construction order for base class(es) constructor(s), as in C++.
+
+<p>If an error occurs during the deletion process, an error is returned and the remaining delete argument objects are left undeleted.
+
+<h4><a name="virtual"></a>virtual specifier</h4>
+
+The <i>virtual</i> specifier may be used on member procedures to achieve dynamic binding. A procedure in a base class can then be redefined (overloaded) in the derived class(es).
+
+<p>If the base class procedure is invoked on an object, it is actually the derived class procedure which is invoked, if it exists<b>*</b>. If the base class procedure has no body, then it is considered to be a pure virtual and the derived class procedure is always invoked.
+
+<p><b>*</b> <i>as in C++, virtual procedures invoked from the base class constructor result in the base class procedure being invoked, not the derived class procedure. In stooop, an error always occurs when pure virtual procedures are invoked from the base class constructor (whereas in C++, behavior is undefined).</i><br>
+<i>* but there is a small difference with C++ behavior: for a virtual procedure to keep his nature down the derived classes hierarchy, it must be defined at each derivation level. That is, the virtual nature may be lost, for example in indirectly derived classes (see example below). Fixing this difference would have a non negligible impact on performance for a small gain in usefulness.</i>
+
+<p>Sample code:
+
+<pre>class shape {
+    proc shape {this x y} {}
+    # pure virtual draw: must be implemented in derived classes
+    <b>virtual</b> proc draw {this}
+    <b>virtual</b> proc transform {this x y} {
+        # base implementation
+    }
+}
+class circle {}
+proc circle::circle {this x y} shape {$x $y} {}
+proc circle::draw {this} {
+    # circle specific implementation
+}
+proc circle::transform {this} {
+    shape::_transform $this ;# use base class implementation
+    # add circle specific implementation here...
+}
+
+lappend shapes [new circle 100 50]
+foreach object $shapes {
+    # draw and move each shape
+    shape::draw $object
+    shape::move $object 20 10
+}</pre>
+
+It is possible to invoke a virtual procedure as a non virtual one, which is handy when the derived class procedure must use the base class procedure. In this case, directly invoking the virtual base class procedure would result in an infinite loop. The non virtual base class procedure name is simply the virtual procedure name with 1 underscore ( _ ) prepended to the member procedure name (see sample code above).
+
+<p>Constructors, destructors and static member procedures cannot be <i>virtual</i>.
+
+<p>Sample code highlighting small difference with C++:
+
+<pre>class A {
+    proc A {this} {}
+    proc ~A {this} {}
+    <b>virtual</b> proc p {this} {puts A}
+}
+class B {
+    proc B {this} A {} {}
+    proc ~B {this} {}
+}
+class C {
+    proc C {this} B {}{}
+    proc ~C {this} {}
+    <b>virtual</b> proc p {this} {puts C}
+}
+
+set object [new C]
+A::p $object ;# prints "A" instead of "C"
+
+<b>virtual</b> proc B::p {this} {puts B}
+
+A::p $object ;# now prints "C"</pre>
+
+<h4><a name="classof"></a>classof operator</h4>
+
+The <i>classof</i> command takes an object identifier as its only argument. It returns the class name of the object (name used with new when the object was created). Thus if needed, RTTI (runtime type identification) can be used as in C++, for example to create "virtual constructors".
+
+<pre>proc shape::shape {this x y} {}
+set id [new shape 100 50]
+puts "object $id class name is [<b>classof</b> $id]"</pre>
+
+<h3><a name="package"></a>Package</h3>
+
+For general information about the Tcl (version 7.5 and above) <i>package</i> facilities, refer to the corresponding manual pages.
+
+<h4><a name="installation"></a>Installation</h4>
+
+A <i>pkgIndex.tcl</i> file is provided so that stooop and the <a href="#switched">switched</a> class can be installed as a package. Refer to the <a href="INSTALL">INSTALL</a> file for complete instructions and examples.
+
+<h4><a name="creation"></a>Creation</h4>
+
+Before creating a package that uses stooop, stooop itself <b>must</b> be installed as a package (see above).
+
+<p>If you have created an object oriented library which uses stooop, you may want to make a package out of it. Unfortunately, using the default Tcl <i>pkg_mkIndex</i> procedure (see the corresponding manual page) will not work.
+
+<p>Stooop checks that a base class constructor is defined before any of its derived classes constructors. Thus, the first time a derived class object is created, the base class definition file must be sourced to avoid an error. The specific <i>mkpkgidx.tcl</i> utility handles such cases and must be used to create stooop compatible package index files.
+
+<p>Let us suppose that you created a library with different classes spread in different source files: <i>lib1.tcl</i>, <i>lib2.tcl</i>, ..., <i>libn.tcl</i>. Of course, some of these files may contain base classes for derived classes in other files. As recommended in the pkg_mkIndex Tcl manual page, each source file should contain a <b>package provide</b> command (although it seems to be needed only in the first source file). For example, if your package name is <i>foo</i> and the version <i>1.2</i>, the following line should appear around the beginning of each of the libn.tcl files:
+
+<pre>package provide foo 1.2</pre>
+
+It is now time to create the <i>pkgIndex.tcl</i> file, which is the missing piece for your foo package, with the <i>mkpkgidx.tcl</i> utility. The syntax is:
+
+<pre>interpreter mkpkgidx.tcl packageName file [file ...]</pre>
+
+where <i>interpreter</i> can be either tclsh or wish depending on whether your library uses Tk or not.
+
+<p>Enter the following command in the directory where the libn.tcl files reside:
+
+<pre>$ tclsh mkpkgidx.tcl foo lib1.tcl lib2.tcl ... libn.tcl</pre>
+
+or
+
+<pre>$ wish mkpkgidx.tcl foo lib1.tcl lib2.tcl ... libn.tcl</pre>
+
+For this to work, the source files must be ordered so that base classes are defined before any of their derived classes. If not the case, such errors are automatically caught by the stooop package index utility, which uses the stooop library itself.
+
+<p>If your package requires other packages and you do not wish to add the corresponding "package require" to your package source files, use the -p option, as in:
+
+<pre>$ wish mkpkgidx.tcl -p ppp.1 -p qqq -p rrr.3.2 foo lib1.tcl lib2.tcl ... libn.tcl</pre>
+
+Note that you may use as many -p option / value pairs as needed. Each package name is optionally followed by its version number after a . separator. If specified, the version number follows the same rules as the "package require" Tcl command. Of course, each specified package must be installed and working properly before attempting the mkpkgidx.tcl utility.
+
+<p>Once this is done, a pkgIndex.tcl file will have been created in the current directory. To install the package, enter for example:
+
+<pre>$ mkdir /usr/local/lib/foo
+$ cp pkgIndex.tcl lib1.tcl lib2.tcl ... libn.tcl /usr/local/lib/foo/</pre>
+
+You may of course install the foo package in another directory: refer to the pkg_mkIndex Tcl manual page for further instructions.
+
+<p>Now in order to use your newly created packaged library in your application, just insert the following 3 lines at the beginning of the application source file:
+
+<pre>package require stooop
+namespace import stooop::*
+package require foo 1.2</pre>
+
+<h3><a name="examples"></a>Examples</h3>
+
+<h4><a name="parallel"></a>Parallel with C++</h4>
+
+For C++ programmers, this simple parallel with C++ may make things easier to understand. First without virtual functions:
+
+<p><b>C++:</b>
+
+<pre>    class className {
+    public:
+        someType someMember;
+        className(someType parameter)
+        {
+            someMember = parameter;
+        }
+        className(className &amp;object)
+        {
+            ...
+        }
+        doSomething(someType parameter);
+        ~className(void) {
+            ...
+        }
+    };
+    someType className::doSomething(someType parameter)
+    {
+        ...
+    }
+    someType someValue;
+    className *someObject = new className(someValue);
+    someType a = someObject->doSomething(someValue);
+    someType b = someObject->someMember;
+    className *otherObject = new className(*someObject);
+    delete someObject;</pre>
+
+<b>(stooop'd up :) Tcl:</b>
+
+<pre>    class className {
+        proc className {this parameter} {
+            # new keeps track of object identifiers and passes a unique one
+            # to the constructor
+            set ($this,someMember) $parameter
+        }
+        proc className {this copy} {
+            # copy constructor
+            ...
+        }
+        proc ~className {this} {
+            # delete invokes this procedure then takes care of deallocating
+            # className array data members for this object identifier
+            ...
+        }
+    }
+    proc className::doSomething {this parameter} {
+        ...
+    }
+    set someObject [new className $someValue]
+    # invokes className::className
+    set a [className::doSomething $someObject $someValue]
+    set b $className::($someObject,someMember)
+    # copy object, className copy constructor is invoked
+    set otherObject [new $someObject]
+    delete $someObject
+    # invokes className::~className then frees members data</pre>
+
+Now, with virtual functions:
+
+<p><b>C++:</b>
+
+<pre>    class baseClassName {
+    public:
+        virtual void doSomething(someType) {}
+        baseClassName(void) {}
+        virtual ~baseClassName(void) {}
+    };
+    class derivedClassName: public baseClassName {
+    public:
+        void doSomething(someType);
+        derivedClassName(void) {}
+        ~derivedClassName(void) {}
+    };
+    void derivedClassName::doSomething(someType parameter)
+    {
+        ...
+    }
+    derivedClassName *someObject = new derivedClassName();
+    someObject->doSomething(someValue);      // derived function actually called
+    cout &lt;&lt; typeid(*someObject).name() &lt;&lt; endl;       // print object class name
+    delete someObject;                        // derived destructor called first</pre>
+
+<b>Tcl with stooop:</b>
+
+<pre>    class baseClassName {
+        proc baseClassName {this} {
+            # sub-class is remembered so that virtual procedures may be used
+            ...
+        }
+        proc ~baseClassName {this} {
+            # cleanup at base level here...
+        }
+        virtual proc doSomething {this parameter} {
+            # derived class procedure with the same name may be invoked
+            # any code that follows is not executed if this procedure is
+            # overloaded in derived class
+            ...
+        }
+    }
+    class derivedClassName {
+        proc derivedClassName {this} baseClassName {} {
+            # base class constructor is automatically invoked
+            ...
+        }
+        proc ~derivedClassName {this} {
+            # cleanup at derived level here...
+            # base class destructor is automatically invoked
+        }
+    }
+    proc derivedClassName::doSomething {this parameter} {
+        # code that follows is executed when base class procedure is called
+        ...
+    }
+    set someObject [new derivedClassName]
+    # access object as base object, derived class procedure is actually invoked
+    baseClassName::doSomething $someObject $someValue
+    puts [classof $someObject]                        ;# print object class name
+    delete $someObject                                          ;# delete object</pre>
+
+<h4><a name="graphical"></a>Graphical demonstration</h4>
+
+A demonstration using the Composite pattern from the great book Design Patterns, Elements of Reusable Object Oriented Software, which I heartily recommend.
+
+<p>The pattern is used to define a class hierarchy of the graphic base class, picture, oval and rectangle derived classes. A picture object can contain any number of other graphic objects, thus allowing graphical composition.
+
+<p>The following paragraphs drawn from the book best describe what the Composite pattern does:
+
+<blockquote><i>Compose objects into tree structures to represent part-whole hierarchies. Composite lets clients treat individual objects and compositions of objects uniformly.</i>
+
+<p><i>The key to the Composite pattern is an abstract class that represents both primitives and their containers. For the graphic system, this class is Graphic. Graphic declares operations like Draw that are specific to graphical objects. It also declares operations that all composite objects share, such as operations for accessing and managing its children.</i>
+
+<p><i>Gamma/Helm/Johnson/Vlissides, DESIGN PATTERNS, ELEMENTS OF REUSABLE OBJECT-ORIENTED SOFTWARE, (c) 1995 by Addison-Wesley Publishing Company, Reprinted by permission of Addison-Wesley Publishing Company, Inc.</i></blockquote>
+
+Instructions:
+
+<p>Run gdemo as in:
+
+<pre>$ wish gdemo</pre>
+
+Several buttons are placed below a canvas area. Picture, Rectangle and Oval are used to create Graphic objects. Clear is used to delete all the objects created so far, Exit is self explanatory.
+
+<p>A Picture object can contain any number of Graphic objects, such as other Picture objects, Rectangle objects, ...
+
+<p>For each Graphic object, the point used for moving and for the object coordinates is the upper left corner of the object.
+
+<p>First create a Picture object by clicking on the Picture button. Move the red rectangle that appears by drag clicking on any of its edges. Then create a Rectangle object by clicking on the Rectangle button. Drag the Rectangle object in the Picture object, it is then a child of the Picture object.
+
+<p>Move the Picture object to verify that its Rectangle child moves along.
+
+<p>Create another Picture object and place an Oval object within.
+
+<p>Move that Picture object to verify that its Oval child moves along.
+
+<p>Now move the upper left corner of that last Picture within the first Picture area.
+
+<p>Then move that Picture to verify that all the Graphic objects move along.
+
+<h4><a name="widget"></a>Widget class</h4>
+
+A widget usually can take a variable number of option / value pairs as arguments when created and any time later when configured. It is a good application for the variable number of arguments technique.
+
+<p>Sample code (without error checking):
+
+<pre>class widget {
+    proc widget {this parent args} {
+        # create Tk widget(s)
+        # set widget options default in an array
+        array set options {-background white -width 10}
+        array set options $args              ;# then overwrite with user options
+        eval configure $this [array get options]               ;# then configure
+    }
+    virtual proc configure {this args} {
+        foreach {option value} $args {
+            switch -- $option {
+                -background {             ;# filter widget specific options here
+                    set ($this,background) $value
+                    # configure Tk widget(s)
+                }
+                ...
+            }
+        }
+    }
+}
+
+class gizmo {}
+proc gizmo::gizmo {this parent args} widget {$parent $args} {
+    # create more Tk widget(s)
+    # set gizmo options default in an array
+    array set options {-spacetimecoordinates {0 0 0 now}}
+    array set options $args                  ;# then overwrite with user options
+    eval ownConfigure $this [array get options]                ;# then configure
+}
+proc gizmo::ownConfigure {this args} {
+    foreach {option value} $args {
+        switch -- $option {                ;# filter gizmo specific options here
+            -spacetimecoordinates {
+                set ($this,location) $value
+                # configure Tk widget(s)
+            }
+            ...
+        }
+    }
+}
+proc gizmo::configure {this args} {
+    eval ownConfigure $this $args                    ;# configure at gizmo level
+    eval widget::_configure $this $args             ;# configure at widget level
+}
+
+new gizmo . -width 20 -spacetimecoordinates {1p 10ly 2p 24.2y}</pre>
+
+In this example, invalid (unknown) options are simply ignored.
+
+<h4><a name="array"></a>Member array</h4>
+
+A true member array is not possible, as member data is already held in an array.
+<br>But there are 2 ways to get around the problem:<ul>
+  <li>embed the array and its index in member data
+  <li>use a namespace array for possibly better performance
+</ul>
+
+<p>For example, when embedding in member data:
+
+<pre>class container {
+    proc container {this} {}
+    proc ~container {this} {}
+    proc container::add {this index value} {
+        set ($this,array,$index) $value
+    }
+}</pre>
+
+<p>With a namespace array, use a name specific to the object, including the object identifier, and do not forget to delete the array in the destructor, as the following example shows:
+
+<pre>class container {
+    proc container {this} {}
+    proc ~container {this} {
+        variable ${this}array
+        unset ${this}array
+    }
+    proc container::add {this index value} {
+        variable ${this}array
+        set ${this}array($index) $value
+    }
+}</pre>
+
+Memory management of the array is the programmer's responsibility, as is its duplication when copying objects. For example, use the following code if you ever copy objects with member arrays:
+
+<pre>class container {
+    proc container {this} {                                  ;# main constructor
+        ...
+    }               ;# default copy constructor has been generated at this point
+    proc container {this copy} {      ;# copy constructor (replaces default one)
+        variable ${this}array
+        variable ${copy}array
+        array set ${this}array [array get ${copy}array]     ;# copy member array
+    }
+    ...
+}</pre>
+
+<h3><a name="utility"></a>Utility classes</h3>
+
+<h4><a name="switched"></a>switched</h4>
+
+<i><b>Note</b>: if you have been using scwoop (a stooop based mega widget extension to the Tk widget library), you must certainly know about the composite class. The switched class is a generic (not widget oriented) derivative of the composite class.</i>
+
+<p>Find the complete documentation <a href="switched.html">here</a>.
+
+<h3><a name="debugging"></a>Debugging</h3>
+
+As stooop is meant to be lean and fast, no checking is done during run-time, that is after all classes and their procedures have been defined.
+
+<p>Starting from version 3.3, debugging aids were added to the stooop library (still held in a single file). Member checking insures that basic object oriented concepts and rules are applied. Tracing provides means for member procedures and data access logging to a file or to the screen.
+
+<p>The above features are triggered and configured using environment variables. When not in use, they have absolutely no impact on stooop's performance (however, if you are really picky, you could say that since the stooop.tcl file has grown larger, load time got longer :).
+
+<p>Please note that any stooop debugging environment variable must be set <b>prior</b> to the stooop library being loaded:
+
+<pre>$ STOOOPTRACEDATA=stdout
+$ export STOOOPTRACEDATA
+$ tclsh myfile.tcl</pre>
+around the beginning of myfile.tcl:
+<pre>...
+set env(STOOOPCHECKPROCEDURES) 1
+source stooop.tcl
+namespace import stooop::*
+set env(STOOOPCHECKDATA) 1
+...</pre>
+
+In the example above, data tracing is enabled as well as procedure checking, but data checking is not turned on.
+
+<h4><a name="check"></a>Member check</h4>
+
+Both procedure and data member checking can be activated by setting the single environment variable STOOOPCHECKALL to a true value (<i>1</i>, <i>true</i> or <i>on</i>). Of course only one of those features can be activated as described below.
+
+<p><i>Note: if you have an idea about any other thing that could be checked in the following sections, please share it with <a href="mailto:jfontain@free.fr">me</a>.</i>
+
+<h5><a name="procedurecheck"></a>Procedure</h5>
+
+Procedure checking is activated by setting the environment variable STOOOPCHECKPROCEDURES to a true value. The stooop library will then generate an error while the application is running in the following cases:
+
+<ul>
+  <li>an invalid <i>this</i> parameter (a non existing object identifier) is passed as argument to a non static member procedure
+  <li>the object identified by the <i>this</i> parameter passed as argument to a class non static member procedure is neither an instance of the procedure class nor an instance of a derived class (at any level of derivation) of the procedure class.
+  <li>a pure interface class (a class with at least 1 pure virtual member procedure) is instanciated
+</ul>
+
+<h5><a name="datacheck"></a>Data</h5>
+
+Procedure checking is activated by setting the environment variable STOOOPCHECKDATA to a true value. The stooop library will then generate an error while the application is running in the following cases:
+
+<ul>
+  <li>in a class namespace but outside a member procedure, a data member of another class is written or unset
+  <li>in a class member procedure (static or not), a data member of another class is written or unset
+  <li>in a non static member procedure, a data member of an object different from the object identified by the <i>this</i> parameter passed as argument is written or unset
+</ul>
+
+<h4><a name="trace"></a>Member trace</h4>
+
+Tracing is activated by setting a specific environment variable to either <i>stdout</i>, <i>stderr</i> or any file name that can be created and written to by the user. Setting the STOOOPTRACEALL variable enables both procedure and data tracing. Of course only one of those features can be activated as described below.
+
+<h5><a name="proceduretrace"></a>Procedure</h5>
+
+Procedure tracing is activated by setting the environment variable STOOOPTRACEPROCEDURES to either <i>stdout</i>, <i>stderr</i> or a file name. The stooop library will then output to the specified channel 1 line of informational text for each member procedure invocation.
+
+<p>The user can define the output format by redefining the STOOOPTRACEPROCEDURESFORMAT (look at the beginning of the stooop.tcl file for the default format). The following substitutions will be performed prior to the output:
+
+<ul>
+  <li><b>%C</b> by the fully qualified class name
+  <li><b>%c</b> by the class name (tail of the fully qualified class name)
+  <li><b>%P</b> by the fully qualified procedure name
+  <li><b>%p</b> by the procedure name (tail of the fully qualified procedure name)
+  <li><b>%O</b> by the object identifier (<i>this</i> value)
+  <li><b>%a</b> by the remaining procedure arguments (not including <i>this</i>)
+</ul>
+
+At the time this document is being written, the default format is:
+
+<pre>class: %C, procedure: %p, object: %O, arguments: %a</pre>
+
+example output from the gdemo application:
+
+<pre>class: picture, procedure: constructor, object: 1, arguments: .canvas
+class: graphic, procedure: constructor, object: 1, arguments: .canvas 1
+class: rectangle, procedure: constructor, object: 2, arguments: .canvas
+class: graphic, procedure: constructor, object: 2, arguments: .canvas 2
+class: graphic, procedure: moveTo, object: 2, arguments: 13 4
+class: graphic, procedure: _moveTo, object: 2, arguments: 13 4
+class: graphic, procedure: moveTo, object: 2, arguments: 18 9
+class: graphic, procedure: add, object: 1, arguments: 2
+class: picture, procedure: add, object: 1, arguments: 2
+class: graphic, procedure: add, object: 2, arguments: 2
+class: rectangle, procedure: add, object: 2, arguments: 2
+class: picture, procedure: destructor, object: 1, arguments:
+class: graphic, procedure: destructor, object: 1, arguments:
+class: rectangle, procedure: destructor, object: 2, arguments:
+class: graphic, procedure: destructor, object: 2, arguments:</pre>
+
+<h5><a name="datatrace"></a>Data</h5>
+
+Data tracing is activated by setting the environment variable STOOOPTRACEDATA to either <i>stdout</i>, <i>stderr</i> or a file name. The stooop library will then output to the specified channel 1 line of informational text for each member data access. By default, all read, write and unsetting accesses are reported, but the user can set the STOOOPTRACEDATAOPERATIONS environment variable to any combination of the <i>r</i>, <i>w</i> and <i>u</i> letters for more specific tracing (please refer to the <i>trace</i> Tcl manual page for more information).
+
+<p>Note that operations internal to the stooop library, such as automatic unsetting of data members during objects destruction do not appear in the trace.
+
+<p>The user can define the output format by redefining the STOOOPTRACEDATAFORMAT (look at the beginning of the stooop.tcl file for the default format). The following substitutions will be performed prior to the output:
+
+<ul>
+  <li><b>%C</b> by the fully qualified class name
+  <li><b>%c</b> by the class name (tail of the fully qualified class name)
+  <li><b>%P</b> by the fully qualified procedure name
+  <li><b>%p</b> by the procedure name (tail of the fully qualified procedure name)
+  <li><b>%A</b> by the fully qualified array name
+  <li><b>%m</b> by the data member name (right after the <i>this,</i> array name part for a non static data member)
+  <li><b>%O</b> by the object identifier (<i>this</i> value or empty for a static procedure)
+  <li><b>%o</b> by the access operation (<i>read</i>, <i>write</i> or <i>unset</i>)
+  <li><b>%v</b> by the new or current value (empty for an <i>unset</i> operation)
+</ul>
+
+At the time this document is being written, the default format is:
+
+<pre>class: %C, procedure: %p, array: %A, object: %O, member: %m, operation: %o, value: %v</pre>
+
+example output from the gdemo application:
+
+<pre>class: graphic, procedure: constructor, array: graphic::, object: 1, member: canvas, operation: write, value: .canvas
+class: graphic, procedure: constructor, array: graphic::, object: 1, member: item, operation: write, value: 1
+class: picture, procedure: constructor, array: picture::, object: 1, member: graphics, operation: write, value: 
+class: picture, procedure: moveTo, array: graphic::, object: 1, member: canvas, operation: read, value: .canvas
+class: picture, procedure: moveTo, array: graphic::, object: 1, member: item, operation: read, value: 1
+class: picture, procedure: moveBy, array: picture::, object: 1, member: graphics, operation: read, value: 
+class: graphic, procedure: _moveBy, array: graphic::, object: 1, member: canvas, operation: read, value: .canvas
+class: graphic, procedure: _moveBy, array: graphic::, object: 1, member: item, operation: read, value: 1
+class: graphic, procedure: constructor, array: graphic::, object: 2, member: canvas, operation: write, value: .canvas
+class: graphic, procedure: constructor, array: graphic::, object: 2, member: item, operation: write, value: 2
+class: graphic, procedure: _moveTo, array: graphic::, object: 2, member: canvas, operation: read, value: .canvas
+class: graphic, procedure: _moveTo, array: graphic::, object: 2, member: item, operation: read, value: 2
+class: graphic, procedure: _moveTo, array: graphic::, object: 2, member: canvas, operation: read, value: .canvas
+class: graphic, procedure: _moveTo, array: graphic::, object: 2, member: item, operation: read, value: 2
+class: graphic, procedure: _moveTo, array: graphic::, object: 2, member: canvas, operation: read, value: .canvas
+class: graphic, procedure: _moveTo, array: graphic::, object: 2, member: item, operation: read, value: 2
+class: graphic, procedure: _moveTo, array: graphic::, object: 2, member: canvas, operation: read, value: .canvas
+class: graphic, procedure: _moveTo, array: graphic::, object: 2, member: item, operation: read, value: 2
+class: picture, procedure: add, array: graphic::, object: 1, member: canvas, operation: read, value: .canvas
+class: picture, procedure: add, array: graphic::, object: 1, member: item, operation: read, value: 2
+class: picture, procedure: add, array: graphic::, object: 1, member: canvas, operation: read, value: .canvas
+class: picture, procedure: add, array: graphic::, object: 1, member: item, operation: read, value: 1
+class: graphic, procedure: destructor, array: graphic::, object: 1, member: canvas, operation: read, value: .canvas
+class: graphic, procedure: destructor, array: graphic::, object: 1, member: item, operation: read, value: 1
+class: graphic, procedure: destructor, array: graphic::, object: 2, member: canvas, operation: read, value: .canvas
+class: graphic, procedure: destructor, array: graphic::, object: 2, member: item, operation: read, value: 2</pre>
+
+<h4><a name="objects"></a>Objects</h4>
+
+Objects checking can be activated by setting the single environment variable STOOOPCHECKOBJECTS to a true value. The following stooop namespace procedures then become available for debugging; <i>printObjects</i>, <i>record</i> and <i>report</i>.
+
+<p>Before outputting any data, all the object checking procedures print which procedure they were invoked from, or the namespace name if invoked from a namespace body or "<i>top level</i>" if invoked outside any procedure or namespace.
+
+<h5><a name="objects.printing"></a>Printing</h5>
+
+The <i>stooop::printObjects</i> procedure when invoked prints an ordered list of existing objects with their creation location (a fully qualified procedure name or "<i>top level</i>") after a <b>+</b> sign. The objects are printed in creation order, with the oldest (lowest identifier) first. The printObjects procedure takes an optional class pattern (as in the Tcl "<i>array names</i>" or "<i>string match</i>" commands) for limiting the output to objects of certain classes, as the following example shows (classes are assumed to exist and be valid):
+
+<pre>% new foo
+1
+% stooop::printObjects
+stooop::printObjects invoked from top level:
+::foo(1) + top level
+% new bar
+2
+% stooop::printObjects
+stooop::printObjects invoked from top level:
+::foo(1) + top level
+::bar(2) + top level
+% new Foo
+3
+% stooop::printObjects ::?oo
+stooop::printObjects invoked from top level:
+::foo(1) + top level
+::Foo(3) + top level
+% new barmaid
+4
+% stooop::printObjects ::bar*
+stooop::printObjects invoked from top level:
+::bar(2) + top level
+::barmaid(4) + top level</pre>
+
+Please note that all object classes are always fully qualified, so do not forget about the <b>::</b> header in the patterns.
+
+<h5><a name="objects.recording"></a>Recording</h5>
+
+By invoking the <i>stooop::record</i> procedure, you take a snapshot of all existing stooop objects at the time of invocation. Reporting can then be used at a later time to see which objects were created or deleted in the interval.
+
+<p>The record procedure does not take any arguments and it only prints its context of invocation.
+
+<h5><a name="objects.reporting"></a>Reporting</h5>
+
+The <i>stooop::report</i> procedure prints the created and deleted objects since the stooop::record procedure was invoked last. It optionally takes a pattern argument in order to limit the output to a specific set of classes, as for the printObjects procedure. A <b>+</b> sign is placed at the beginning of each created object description line in the output trace, followed by another <b>+</b> sign and the creation location (a fully qualified procedure name or "<i>top level</i>"). A <b>-</b> sign is placed at the beginning of each deleted object description line in the output trace, followed by another <b>-</b> sign, the deletion location (a fully qualified procedure name or "<i>top level</i>"), a <b>+</b> sign and the creation location (a fully qualified procedure name or "<i>top level</i>").
+
+<p>Reporting is typically used between 2 spots in the debugged application code: the first spot where a bunch of objects (which can include sub objects) are created, the second spot where all or most of these objects are supposed to be deleted. On the first spot, stooop::record is invoked whereas on the second spot, the stooop::report invocation will print the created and/or deleted objects, in other words the "object difference" between the 2 spots. In most cases, the programmer would expect a difference of 0 objects, sign of a well behaved application, memory wise.
+
+<p>Consider the following example:
+
+<pre>class foo {
+    proc foo {this} {}
+    proc ~foo {this} {}
+}
+class bar {
+    proc bar {this} {
+        new foo
+    }
+    proc ~bar {this} {}
+}
+stooop::record
+delete [new bar]
+stooop::report
+stooop::record
+delete 2
+stooop::report</pre>
+
+It gives the following result:
+
+<pre>stooop::record invoked from top level
+stooop::report invoked from top level:
++ ::foo(2) + ::bar::bar
+stooop::record invoked from top level
+stooop::report invoked from top level:
+- ::foo(2) - top level + ::bar::bar</pre>
+
+Examining the printout, one can see that the bar class does not properly clean things up as the foo sub object is left undeleted.
+
+<h3><a name="notes"></a>Notes</h3>
+
+<h4><a name="design"></a>On design choices</h4>
+
+Performance would have to as good as possible.
+
+<p>A familiar C++ syntax should serve as a model (not all, though, I didn't feel like writing 700 pages of documentation :-).
+
+<p>Tcl being a non declarative language (which I really enjoy), stooop would have to try to comply with that approach.
+
+<p>Error checking would have to be strong with little impact on performance.
+
+<h4><a name="implementation"></a>On implementation</h4>
+
+For a Tcl only extension, I think performance is the main issue. The performance / functionality compromise was handled by moving as much processing as possible to the preprocessing stage, handled by the proc and virtual commands. Furthermore, all the costly error checking could be done there as well, having no impact on runtime performance.
+
+<p>The delete operation was greatly simplified, especially for classes that would require a virtual destructor in C++, by storing in an array the class of each object. It then became trivial to delete any object from its identifier only. This approach has an impact on memory use, though, but I consider that one is not very likely to create a huge number of objects in a Tcl application. Furthermore, a classof RTTI operator was then added with no effort.
+
+<p>Stooop learns class hierarchies through the constructor definition whichserves as an implementation as well, thus (kind of) better fitting the non declarative nature of Tcl.
+
+<p>All member data is public but access control is somewhat enforced by having to explicitly name the class layer of external data being accessed.
+
+<p>Since, for performance reasons, the stooop library performs very little checking during run-time (after all classes and their procedures were defined), debugging aids are provided starting from version 3.3. They attempt to insure that your code is well written in an object oriented sense. They also provide means for tracing data access and procedures.
+
+<h3><a name="misc"></a>Miscellaneous information</h3>
+
+For downloading other Tcl software (such as scwoop, moodss, ...), visit my <a href="http://jfontain.free.fr/">web page</a>.
+
+<p>Send your comments, complaints, ... to <a href="mailto:jfontain@free.fr">Jean-Luc Fontaine</a>.
+
+</body>
+</html>
diff --git a/tcllib/modules/stooop/switched.html b/tcllib/modules/stooop/switched.html
new file mode 100644
index 0000000..71f6676
--- /dev/null
+++ b/tcllib/modules/stooop/switched.html
@@ -0,0 +1,242 @@
+<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
+<html>
+<head>
+   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+   <meta name="GENERATOR" content="Mozilla/4.61 [en] (X11; I; Linux 2.2.11 i686) [Netscape]">
+   <title>stooop switched class</title>
+</head>
+<body>
+
+<center>
+<dt>
+<b><font size=+4>the switched class</font></b></dt></center>
+
+<p>&nbsp;
+<br>&nbsp;
+<br>
+<p>The <b>switched</b> class serves as base class for user classes with
+switch / option configuration method. It provides facilities for managing
+options through a simple interface.
+<p>For example:
+<pre>set vehicle [new car -length 4.5 -width 2 -power 100 -fuel diesel]
+puts "my car was running on [switched::cget $vehicle -fuel]"
+switched::configure $vehicle -power 40 -fuel electricity
+puts "but is now running on clean [switched::cget $vehicle -fuel]"</pre>
+Of course, as you might have guessed, the <b>car</b> class is derived from
+the <b>switched</b> class. Let us see how it works:
+<pre>class car {
+&nbsp;&nbsp;&nbsp; proc car {this args} switched {$args} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; # car specific initialization code here
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; switched::complete $this
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; ...
+}</pre>
+The switched class constructor takes the optional configuration option
+/ value pairs as parameters. The switched class layer then completely manages
+the switched options: it checks their validity, stores their values and
+provides a clean interface to the user layer configuration setting procedures.
+<p>The switched class members available to the programmer are:
+<p><b>switched</b>
+<ul>
+<li>
+complete{}</li>
+
+<li>
+<i>options{}</i></li>
+
+<li>
+<i>set-option{}</i></li>
+
+<li>
+...</li>
+
+<li>
+complete</li>
+
+<li>
+-option</li>
+
+<li>
+...</li>
+</ul>
+The <b>complete</b> procedure is used to tell the switched layer that the
+derived class object (a car in the examples) is completely built. At that
+time, the initial configuration of the switched object occurs, using default
+option values (see <b>options</b> procedure) eventually overridden by construction
+time values, passed at the time of the <i>new</i> operator invocation.
+The complete procedure must be called once only, usually around or at the
+end of the derived class constructor. <i>(<b>Note</b>: also check the <b>complete</b>
+data member later in this chapter)</i>
+<p>The <b>options</b> procedure must return the configuration description
+for <b>all</b> options that the switched object will accept. It is a pure
+virtual member procedure and therefore its implementation is <b>mandatory</b>
+in the derived class layer. The procedure must return a list of lists.
+Each list pertains to a single option and is composed of the switch name,
+the default value for the option and an optional initial value. For example:
+<pre>class car {
+&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; proc options {this} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; return [list\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -fuel petrol petrol]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -length {} {}]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -power {} {}]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -width {} {}]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ]
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; proc set-fuel {this value} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; ...
+}</pre>
+In this case, 4 options are specified: <i>fuel</i>, <i>length</i>, <i>power</i>
+and <i>width</i>. The default and initial values for the <i>fuel</i> option
+are identical and set to <i>petrol</i>. For the other options, values are
+all empty.
+<p>For each option, there must be a corresponding set-<i>option</i> procedure
+defined in the derived class layer. For example, since we defined a <i>fuel</i>
+option, there is a set-<i>fuel</i> procedure in the car class. The parameters
+always are the object identifier (since this is not a static procedure,
+but rather a dynamically defined virtual one), followed by the new value
+for the option. The set-<i>option</i> procedure is only invoked if the
+new value differs from the current one (a cache scheme for improving performance),
+or if there is no initial value set in the options procedure for that option.
+<p>In the options procedure, if the initial value differs from&nbsp; the
+default value or is omitted, then initial configuration is forced and the
+corresponding set-<i>option</i> procedure is invoked by the switched <i>complete</i>
+procedure located at the end of the derived class constructor. For example:
+<pre>class car {
+&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; proc options {this} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; return [list\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -fuel petrol]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -length {} {}]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -power 100 50]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -width {} {}]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ]
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; ...
+}</pre>
+In this case, configuration is forced on the <i>fuel</i> and <i>power</i>
+options, that is the corresponding set-<i>option</i> procedures will be
+invoked when the switched object is constructed (see set-<i>option</i>
+procedures documentation below).
+<p>For the <i>fuel</i> option, since there is no initial value, the set-<i>fuel</i>
+procedure is called with the default value (<i>petrol</i>) as argument.
+For the <i>power</i> option, since the initial value differs from the default
+value, the set-<i>power</i> procedure is called with the initial value
+as argument (<i>50</i>).
+<p>For the other options, since the initial values (last elements of the
+option lists) are identical to their default values, the corresponding
+set-<i>option</i> procedures will not be invoked. It is the programmer's
+responsibility to insure that the initial option values are correct.
+<p>The <b>set-<i>option</i></b> procedures may be viewed as dynamic virtual
+functions. There must be one implementation per supported option, as returned
+by the <i>options</i> procedure. For example:
+<pre>class car {
+&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; proc options {this} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; return [list\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -width {} {}]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ]
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; proc set-width {this value} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; ...
+}</pre>
+Since the <i>-width</i> option was listed in the options procedure, a <i>set-width</i>
+procedure implementation is provided, which of course would proceed to
+set the width of the car (and would modify the looks of a graphical representation,
+for example).
+<p>As you add a supported <i>option</i> in the list returned by the options
+procedure, the corresponding set-<i>option</i> procedure may be called
+as soon as the switched object is complete, which occurs when the switched
+level <i>complete</i> procedure is invoked. For example:
+<br>&nbsp;
+<pre>class car {
+&nbsp;&nbsp;&nbsp; proc car {this args} switched {args} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; switched::complete $this
+&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; proc options {this} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; return [list\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -fuel petrol]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -length 4.5]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -power 350]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [list -width 1.8]\
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ]
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; proc set-fuel {this value} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; proc set-length {this value} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; proc set-power {this value} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; proc set-width {this value} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; }
+}</pre>
+
+<pre>new car</pre>
+In this case, a new car is created with no options, which causes the car
+constructor to be called, which in turns calls the switched level <i>complete</i>
+procedure after the car object layer is completely initialized. At this
+point, since there are no initial values in any option list in the options
+procedure, the set-fuel procedure is called with its default value of <i>petrol</i>
+as parameter, followed by the set-length call with <i>4.5</i> value, set-power
+with <i>350</i> value and finally with set-width with <i>1.8</i> as parameter.
+This is a good way to test the set-option procedures when debugging, and
+when done, just fill-in the initial option values.
+<p>The switched layer checks that an option is valid (that is, listed in
+the options procedure) but obviously does not check the validity of the
+value passed to the set-<i>option</i> procedure, which should throw an
+error (for example by using the Tcl error command) if the value is invalid.
+<p>The switched layer also keeps track of the options current values, so
+that a set-<i>option</i> procedure is called only when the corresponding
+option value passed as parameter is different from the current value (see
+<i>-option</i>
+data members description).
+<p>The <b><i>-option</i></b> data member is the option current value. There
+is one for each option listed in the options procedure. It is a read-only
+value which the switched layer checks against when an option is changed.
+It is rarely used at the layer derived from switched, except in the few
+cases, such as in the following example:
+<pre>...</pre>
+
+<pre>proc car::options {this} {
+&nbsp;&nbsp;&nbsp; return {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; {-manufacturer {} {}}
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
+&nbsp;&nbsp;&nbsp; }
+}</pre>
+
+<pre>proc car::set-manufacturer {this value} {}</pre>
+
+<pre>proc car::printData {this} {
+&nbsp;&nbsp;&nbsp; puts "manufacturer: $switched::($this,-manufacturer)"
+&nbsp;&nbsp;&nbsp; ...
+}</pre>
+In this case, the manufacturer's name is stored at the switched layer level
+(this is why the set-manufacturer procedure has nothing to do) and later
+retrieved in the printData procedure.
+<p>The <b>complete</b> data member (not to be confused with the complete
+procedure) is a boolean. Its initial value is <i>false</i> and it is set
+to <i>true</i> at the very end of the switched complete procedure. It becomes
+useful when some options should be set at construction time only and not
+dynamically, as the following example shows:
+<pre>proc car::set-width {this value} {
+&nbsp;&nbsp;&nbsp; if {$switched::($this,complete)} {
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; error {option -width cannot be set dynamically}
+&nbsp;&nbsp;&nbsp; }
+&nbsp;&nbsp;&nbsp; ...
+}</pre>
+
+</body>
+</html>
diff --git a/tcllib/modules/stooop/switched.man b/tcllib/modules/stooop/switched.man
new file mode 100644
index 0000000..58d53f0
--- /dev/null
+++ b/tcllib/modules/stooop/switched.man
@@ -0,0 +1,328 @@
+[comment {-*- tcl -*- doctools manpage}]
+[manpage_begin switched n 2.2.1]
+[keywords C++]
+[keywords class]
+[keywords object]
+[keywords {object oriented}]
+[moddesc   {Simple Tcl Only Object Oriented Programming}]
+[titledesc {switch/option management.}]
+[category  {Programming tools}]
+[require Tcl 8.3]
+[require switched [opt 2.2.1]]
+[description]
+[para]
+
+The [class switched] class serves as base class for user classes with
+switch / option configuration procedures. It provides facilities for
+managing options through a simple interface.
+
+[para] For example:
+
+[example {
+set vehicle [new car -length 4.5 -width 2 -power 100 -fuel diesel]
+puts "my car was running on [switched::cget $vehicle -fuel]"
+switched::configure $vehicle -power 40 -fuel electricity
+puts "but is now running on clean [switched::cget $vehicle -fuel]"
+}]
+
+[para] Of course, as you might have guessed, the [class car] class is
+derived from the [class switched] class. Let us see how it works:
+
+[example {
+class car {
+    proc car {this args} switched {$args} {
+        # car specific initialization code here
+        switched::complete $this
+    }
+    ...
+}
+}]
+
+[para] The switched class constructor takes the optional configuration
+option / value pairs as parameters.
+
+The switched class layer then completely manages the switched options:
+it checks their validity, stores their values and provides a clean
+interface to the user layer configuration setting procedures.
+
+[para] The switched class members available to the programmer are:
+
+[list_begin definitions]
+
+[comment ---------------------------------------------------------------------]
+[call [cmd <switched>] [method complete] [arg this]]
+
+This procedure is used to tell the switched layer that the derived
+class object (a car in the examples) is completely built.
+
+At that time, the initial configuration of the switched object occurs,
+using default option values (see procedure [method options])
+eventually overridden by construction time values, passed at the time
+of the [method new] operator invocation.
+
+This procedure must be called only once, usually around or at the end
+of the derived class constructor.
+
+([emph Note]: Also check the [var complete] data member later in this
+chapter).
+
+[comment ---------------------------------------------------------------------]
+[call [cmd <switched>] [method options] [arg this]]
+
+This procedure must return the configuration description for
+[emph all] options that the switched object will accept.
+
+It is a pure virtual member procedure and therefore its implementation
+is [emph mandatory] in the derived class layer.
+
+The procedure must return a list of lists.
+
+Each list pertains to a single option and is composed of the switch
+name, the default value for the option and an optional initial value.
+
+For example:
+
+[para][example {
+class car {
+    ...
+    proc options {this} {
+        return [list\
+            [list -fuel petrol petrol]\
+            [list -length {} {}]\
+            [list -power {} {}]\
+            [list -width {} {}]\
+        ]
+    }
+    proc set-fuel {this value} {
+        ...
+    }
+    ...
+}
+}]
+
+[para] In this case, 4 options are specified:
+[option fuel], [option length], [option power] and [option width].
+
+The default and initial values for the [option fuel] option are
+identical and set to [option petrol].
+
+For the other options, values are all empty.
+
+[para] For each option, there must be a corresponding
+[method set-[option option]] procedure defined in the derived class
+layer.
+
+For example, since we defined a [option fuel] option, there is a
+[method set-fuel] procedure in the car class.
+
+The parameters always are the object identifier (since this is not a
+static procedure, but rather a dynamically defined virtual one),
+followed by the new value for the option.
+
+A [method set-[option option]] procedure is only invoked if the new
+value differs from the current one (a caching scheme for improving
+performance), or if there is no initial value set in the
+[method options] procedure for that option.
+
+[para] In this procedure, if the initial value differs from the
+default value or is omitted, then initial configuration is forced and
+the corresponding [method set-[option option]] procedure is invoked by
+the switched [method complete] procedure located at the end of the
+derived class constructor.
+
+For example:
+
+[example {
+class car {
+    ...
+    proc options {this} {
+        return [list\
+            [list -fuel petrol]\
+            [list -length {} {}]\
+            [list -power 100 50]\
+            [list -width {} {}]\
+        ]
+    }
+    ...
+}
+}]
+
+In this case, configuration is forced on the [option fuel] and
+[option power] options, that is the corresponding
+
+[method set-[option option]] procedures will be invoked when the
+switched object is constructed (see [method set-[option option]]
+procedures documentation below).
+
+[para] For the [option fuel] option, since there is no initial value,
+the [method set-[option fuel]] procedure is called with the default
+value ([const petrol]) as argument.
+
+For the [option power] option, since the initial value differs from
+the default value, the [method set-[option power]] procedure is called
+with the initial value as argument ([const 50]).
+
+[para] For the other options, since the initial values (last elements
+of the option lists) are identical to their default values, the
+corresponding [method set-[option option]] procedures will not be
+invoked. It is the programmer's responsibility to insure that the
+initial option values are correct.
+
+[comment ---------------------------------------------------------------------]
+[call [cmd <switched>] [method set-[option option]] [arg this] [arg value]]
+
+These procedures may be viewed as dynamic virtual functions.
+
+There must be one implementation per supported option, as returned by
+the [method options] procedure.
+
+For example:
+
+[example {
+class car {
+    ...
+    proc options {this} {
+        return [list\
+            ...
+            [list -width {} {}]\
+        ]
+    }
+    ...
+    proc set-width {this value} {
+        ...
+    }
+    ...
+}
+}]
+
+Since the [option -width] option was listed in the [method options]
+procedure, a [method set-width] procedure implementation is provided, which
+of course would proceed to set the width of the car (and would modify
+the looks of a graphical representation, for example).
+
+[para] As you add a supported [option option] in the list returned by
+the [method options] procedure, the corresponding
+
+[method set-[option option]] procedure may be called as soon as the
+switched object is complete, which occurs when the switched level
+[method complete] procedure is invoked.
+
+For example:
+
+[para][example {
+class car {
+    proc car {this args} switched {args} {
+        ...
+        switched::complete $this
+   }
+    ...
+    proc options {this} {
+        return [list\
+            [list -fuel petrol]\
+            [list -length 4.5]\
+            [list -power 350]\
+            [list -width 1.8]\
+        ]
+    }
+    proc set-fuel {this value} {
+        ...
+    }
+    proc set-length {this value} {
+        ...
+    }
+    proc set-power {this value} {
+        ...
+    }
+    proc set-width {this value} {
+        ...
+    }
+}
+
+new car
+}]
+
+[para] In this case, a new car is created with no options, which
+causes the car constructor to be called, which in turns calls the
+switched level [method complete] procedure after the car object layer
+is completely initialized.
+
+At this point, since there are no initial values in any option list in
+the options procedure, the [method set-fuel] procedure is called with
+its default value of [const petrol] as parameter, followed by the
+[method set-length] call with [const 4.5] value, [method set-power]
+with [const 350] value and finally with [method set-width] with
+[const 1.8] as parameter.
+
+This is a good way to test the [method set-[option option]] procedures
+when debugging, and when done, just fill-in the initial option values.
+
+[para] The switched layer checks that an option is valid (that is,
+listed in the [method options] procedure) but obviously does not check
+the validity of the value passed to the [method set-[option option]]
+procedure, which should throw an error (for example by using the Tcl
+error command) if the value is invalid.
+
+[para] The switched layer also keeps track of the options current
+values, so that a [method set-[option option]] procedure is called
+only when the corresponding option value passed as parameter is
+different from the current value (see [variable -option] data members
+description).
+
+[def [variable -option]]
+
+[para] The [variable -option] data member is an options current value.
+
+There is one for each option listed in the options procedure. It is a
+read-only value which the switched layer checks against when an option
+is changed.
+
+It is rarely used at the layer derived from switched, except in the
+few cases, such as in the following example:
+
+[para][example {
+...
+proc car::options {this} {
+    return {
+        ...
+        {-manufacturer {} {}}
+        ...
+    }
+}
+
+proc car::set-manufacturer {this value} {}
+
+proc car::printData {this} {
+    puts "manufacturer: $switched::($this,-manufacturer)"
+    ...
+}
+}]
+
+[para] In this case, the manufacturer's name is stored at the switched
+layer level (this is why the set-manufacturer procedure has nothing to
+do) and later retrieved in the printData procedure.
+
+[def [variable complete]]
+
+[para] The [variable complete] data member (not to be confused with
+the [method complete] procedure) is a boolean.
+
+Its initial value is [const false] and it is set to [const true] at
+the very end of the switched [method complete] procedure.
+
+It becomes useful when some options should be set at construction time
+only and not dynamically, as the following example shows:
+
+[para][example {
+proc car::set-width {this value} {
+    if {$switched::($this,complete)} {
+        error {option -width cannot be set dynamically}
+    }
+    ...
+}
+}]
+
+[list_end]
+
+[vset CATEGORY stooop]
+[include ../doctools2base/include/feedback.inc]
+[manpage_end]
diff --git a/tcllib/modules/stooop/switched.tcl b/tcllib/modules/stooop/switched.tcl
new file mode 100644
index 0000000..b05c773
--- /dev/null
+++ b/tcllib/modules/stooop/switched.tcl
@@ -0,0 +1,133 @@
+# The switched class (for the stooop object oriented extension)
+#
+# Copyright (c) 2001 by Jean-Luc Fontaine <jfontain@free.fr>.
+# This code may be distributed under the same terms as Tcl.
+#
+# $Id: switched.tcl,v 1.5 2006/09/19 23:36:18 andreas_kupries Exp $
+
+package require stooop
+package provide switched 2.2.1
+
+
+::stooop::class switched {
+
+    proc switched {this args} {            ;# arguments are option / value pairs
+        if {([llength $args]%2)!=0} {
+            error "value for \"[lindex $args end]\" missing"
+        }
+        set ($this,complete) 0
+        # delay arguments processing till completion as pure virtual procedure
+        # invocations do not work from base class constructor
+        set ($this,arguments) $args
+    }
+
+    proc ~switched {this} {}
+
+    # derived class implementation must return a list of
+    # {name "default value" "initial value"} lists
+    ::stooop::virtual proc options {this}
+
+    # must be invoked once only at the end of derived class constructor so that
+    # configuration occurs once derived object is completely built:
+    proc complete {this} {
+        foreach description [options $this] {
+            set option [lindex $description 0]
+            # by default always set option to default value:
+            set ($this,$option) [set default [lindex $description 1]]
+            if {[llength $description]<3} {
+                # no initial value so force initialization with default value
+                set initialize($option) {}
+            } elseif {![string equal $default [lindex $description 2]]} {
+                set ($this,$option) [lindex $description 2]
+                # initial value different from default value so force
+                # initialization
+                set initialize($option) {}
+            }
+        }
+        # check validity of constructor options, which always take precedence
+        # for initialization
+        foreach {option value} $($this,arguments) {
+            if {[catch {string compare $($this,$option) $value} different]} {
+                error "$($this,_derived): unknown option \"$option\""
+            }
+            if {$different} {
+                set ($this,$option) $value
+                set initialize($option) {}
+            }
+        }
+        unset ($this,arguments)
+        # all option values are initialized before any of the set procedures are
+        # called
+        foreach option [array names initialize] {
+            $($this,_derived)::set$option $this $($this,$option)
+        }
+        set ($this,complete) 1
+    }
+
+    proc configure {this args} {      ;# should not be invoked before completion
+        if {[llength $args]==0} {
+            return [descriptions $this]
+        }
+        foreach {option value} $args {
+            # check all options validity before doing anything else
+            if {![info exists ($this,$option)]} {
+                error "$($this,_derived): unknown option \"$option\""
+            }
+        }
+        if {[llength $args]==1} {
+            return [description $this [lindex $args 0]]
+        }
+        if {([llength $args]%2)!=0} {
+            error "value for \"[lindex $args end]\" missing"
+        }
+        # derived (dynamic virtual) procedure must either accept (or eventually
+        # adjust) the value or throw an error
+        # option data member is set prior to invoking the procedure in case
+        # other procedures are invoked and expect the new value
+        foreach {option value} $args {
+            if {![string equal $($this,$option) $value]} {
+                $($this,_derived)::set$option $this [set ($this,$option) $value]
+            }
+        }
+    }
+
+    proc cget {this option} {
+        if {[catch {set value $($this,$option)}]} {
+            error "$($this,_derived): unknown option \"$option\""
+        }
+        return $value                   ;# return specified option current value
+    }
+
+    proc description {this option} {  ;# build specified option description list
+        foreach description [options $this] {
+            if {[string equal [lindex $description 0] $option]} {
+                if {[llength $description]<3} {              ;# no initial value
+                    lappend description $($this,$option) ;# append current value
+                    return $description
+                } else {
+                    # set current value:
+                    return [lreplace $description 2 2 $($this,$option)]
+                }
+            }
+        }
+    }
+
+    # build option descriptions list for all supported options:
+    proc descriptions {this} {
+        set descriptions {}
+        foreach description [options $this] {
+            if {[llength $description]<3} {                  ;# no initial value
+                # append current value:
+                lappend description $($this,[lindex $description 0])
+                lappend descriptions $description
+            } else {
+                # set current value:
+                lappend descriptions [lreplace\
+                    $description 2 2 $($this,[lindex $description 0])\
+                ]
+            }
+        }
+        return $descriptions
+    }
+
+}
diff --git a/tcllib/modules/stooop/xifo.tcl b/tcllib/modules/stooop/xifo.tcl
new file mode 100644
index 0000000..96b81ae
--- /dev/null
+++ b/tcllib/modules/stooop/xifo.tcl
@@ -0,0 +1,142 @@
+# The lifo and fifo classes (for the stooop object oriented extension)
+#
+# Copyright (c) 2002 by Jean-Luc Fontaine <jfontain@free.fr>.
+# This code may be distributed under the same terms as Tcl.
+#
+# $Id: xifo.tcl,v 1.4 2004/07/19 19:12:45 jfontain Exp $
+
+
+# Here is a sample FIFO/LIFO implementation with stooop.
+# Sample test code is at the bottom of this file.
+
+
+# Uncomment the following lines for the bottom sample code to work:
+# package require stooop
+# namespace import stooop::*
+
+
+::stooop::class xifo {
+
+    proc xifo {this size} {
+        set ($this,size) $size
+        empty $this
+    }
+
+    proc ~xifo {this} {
+        variable ${this}data
+        catch {unset ${this}data}
+    }
+
+    proc in {this data} {
+        variable ${this}data
+        tidyUp $this
+        if {[array size ${this}data] >= $($this,size)} {
+            unset ${this}data($($this,first))
+            incr ($this,first)
+        }
+        set ${this}data([incr ($this,last)]) $data
+    }
+
+    proc tidyUp {this} {                       ;# warning: for internal use only
+        variable ${this}data
+        catch {
+            unset ${this}data($($this,unset))
+            unset ($this,unset)
+        }
+    }
+
+    proc empty {this} {
+        variable ${this}data
+        catch {unset ${this}data}
+        catch {unset ($this,unset)}
+        set ($this,first) 0
+        set ($this,last) -1
+    }
+
+    proc isEmpty {this} {
+        return [expr {$($this,last) < $($this,first)}]
+    }
+
+    ::stooop::virtual proc out {this}
+
+    ::stooop::virtual proc data {this}
+}
+
+
+::stooop::class lifo {
+
+    proc lifo {this {size 2147483647}} xifo {$size} {}
+
+    proc ~lifo {this} {}
+
+    proc out {this} {
+        xifo::tidyUp $this
+        if {[array size xifo::${this}data] == 0} {
+            error "lifo $this out error, empty"
+        }
+        # delay unsetting popped data to improve performance by avoiding a data
+        # copy:
+        set xifo::($this,unset) $xifo::($this,last)
+        incr xifo::($this,last) -1
+        return [set xifo::${this}data($xifo::($this,unset))]
+    }
+
+    proc data {this} {
+        set list {}
+        set first $xifo::($this,first)
+        for {set index $xifo::($this,last)} {$index >= $first} {incr index -1} {
+            lappend list [set xifo::${this}data($index)]
+        }
+        return $list
+    }
+
+}
+
+
+::stooop::class fifo {
+
+    proc fifo {this {size 2147483647}} xifo {$size} {}
+
+    proc ~fifo {this} {}
+
+    proc out {this} {
+        xifo::tidyUp $this
+        if {[array size xifo::${this}data] == 0} {
+            error "fifo $this out error, empty"
+        }
+        # delay unsetting popped data to improve performance by avoiding a data
+        # copy:
+        set xifo::($this,unset) $xifo::($this,first)
+        incr xifo::($this,first)
+        return [set xifo::${this}data($xifo::($this,unset))]
+    }
+
+    proc data {this} {
+        set list {}
+        set last $xifo::($this,last)
+        for {set index $xifo::($this,first)} {$index <= $last} {incr index} {
+            lappend list [set xifo::${this}data($index)]
+        }
+        return $list
+    }
+
+}
+
+
+# Here are a few lines of sample code:
+#    proc exercise {id} {
+#        for {set u 0} {$u < 10} {incr u} {
+#            xifo::in $id $u
+#        }
+#        puts [xifo::out $id]
+#        puts [xifo::data $id]
+#        xifo::in $id $u
+#        xifo::in $id [incr u]
+#        puts [xifo::data $id]
+#    }
+#    set id [stooop::new lifo 10]
+#    exercise $id
+#    stooop::delete $id
+#    set id [stooop::new fifo 10]
+#    exercise $id
+#    stooop::delete $id