1# -*- tcl -*-
2# Copyright (c) 2001 by Jean-Luc Fontaine <jfontain@free.fr>.
3# This code may be distributed under the same terms as Tcl.
4#
5# $Id: stooop.test,v 1.12 2006/10/09 15:23:06 andreas_kupries Exp $
6
7# -------------------------------------------------------------------------
8
9source [file join \
10	[file dirname [file dirname [file join [pwd] [info script]]]] \
11	devtools testutilities.tcl]
12
13testsNeedTcl     8.3
14testsNeedTcltest 1.0
15
16testing {
17    useLocal stooop.tcl stooop
18}
19
20# -------------------------------------------------------------------------
21
22set source [localPath stooop.tcl]
23
24# -------------------------------------------------------------------------
25
26set dumpArraysCode {
27    proc dumpArrays {args} {
28        set list {}
29        foreach array $args {
30            upvar $array data
31            foreach name [lsort [array names data]] {
32                lappend list "$array\($name\) = $data($name)"
33            }
34        }
35        return $list
36    }
37}
38
39# -------------------------------------------------------------------------
40
41test stooop-0 {
42    check that the empty named array feature works
43} {
44    set interpreter [interp create]
45    $interpreter eval "source $source; namespace import stooop::*"
46    set result [$interpreter eval {
47        set (0) 0
48        lappend ::result $(0)
49        namespace eval n {
50            variable {}
51            set (1) 1
52            lappend ::result $(1)
53        }
54
55        set ::result
56    }]
57    interp delete $interpreter
58    set result
59} [list\
60    0\
61    1\
62]
63
64test stooop-1 {
65    undocumented
66} {
67    set interpreter [interp create]
68    $interpreter eval "source $source; namespace import stooop::*"
69    set result [$interpreter eval {
70        catch {new a} ::result
71        set ::result
72    }]
73    interp delete $interpreter
74    set result
75} {invalid command name "a::a"}
76
77test stooop-2 {
78    undocumented
79} {
80    set interpreter [interp create]
81    $interpreter eval "source $source; namespace import stooop::*"
82    set result [$interpreter eval {
83        class a {}
84        proc a::a {this} {
85            lappend ::result "a::a $this"
86        }
87        catch {delete [new a]} message
88        lappend ::result $message
89
90        class A {
91            proc A {this} {
92                lappend ::result "A::A $this"
93            }
94        }
95        catch {delete [new A]} message
96        lappend ::result $message
97
98        class b::c {}
99        proc b::c::c {this} {
100            lappend ::result "c::c $this"
101        }
102        catch {delete [new b::c]} message
103        lappend ::result $message
104
105        class B {
106            class C {
107                proc C {this} {
108                    lappend ::result "C::C $this"
109                }
110            }
111            catch {delete [new C]} message
112            lappend ::result $message
113        }
114        catch {delete [new B::C]} message
115        lappend ::result $message
116
117        set ::result
118    }]
119    interp delete $interpreter
120    set result
121} [list\
122    {a::a 1}\
123    {invalid command name "::a::~a"}\
124    {A::A 2}\
125    {invalid command name "::A::~A"}\
126    {c::c 3}\
127    {invalid command name "::b::c::~c"}\
128    {C::C 4}\
129    {invalid command name "::B::C::~C"}\
130    {C::C 5}\
131    {invalid command name "::B::C::~C"}\
132]
133
134test stooop-3 {
135    undocumented
136} {
137    set interpreter [interp create]
138    $interpreter eval "source $source; namespace import stooop::*"
139    set result [$interpreter eval {
140        class a {}
141        catch {new a} message
142        lappend ::result $message
143
144        class b::c {}
145        catch {new b::c} message
146        lappend ::result $message
147
148        class A {}
149        catch {new A} message
150        lappend ::result $message
151
152        class B {
153            class C {}
154            catch {new C} message
155            lappend ::result $message
156        }
157        catch {new B::C} message
158        lappend ::result $message
159
160        set ::result
161    }]
162    interp delete $interpreter
163    set result
164} [list\
165    {invalid command name "a::a"}\
166    {invalid command name "b::c::c"}\
167    {invalid command name "A::A"}\
168    {invalid command name "C::C"}\
169    {invalid command name "B::C::C"}\
170]
171
172test stooop-4 {
173    undocumented
174} {
175    set interpreter [interp create]
176    $interpreter eval "source $source; namespace import stooop::*"
177    $interpreter eval $dumpArraysCode
178    set result [$interpreter eval {
179        class a {}
180        proc a::a {this p q} {
181            lappend ::result "a::a $this"
182            set ($this,m) $p
183            set ($this,n) $q
184        }
185        proc a::~a {this} {
186            lappend ::result "a::~a $this"
187        }
188        set o [new a x {y z}]
189        eval lappend ::result [dumpArrays a::]
190        delete $o
191        eval lappend ::result [dumpArrays a::]
192
193        class A {
194            proc A {this p q} {
195                lappend ::result "A::A $this"
196                set ($this,m) $p
197                set ($this,n) $q
198            }
199            proc ~A {this} {
200                lappend ::result "A::~A $this"
201            }
202        }
203        set o [new A x {y z}]
204        eval lappend ::result [dumpArrays A::]
205        delete $o
206        eval lappend ::result [dumpArrays A::]
207
208        class c::d {}
209        proc c::d::d {this p q} {
210            lappend ::result "d::d $this"
211            set ($this,m) $p
212            set ($this,n) $q
213        }
214        proc c::d::~d {this} {
215            lappend ::result "d::~d $this"
216        }
217        set o [new c::d x {y z}]
218        eval lappend ::result [dumpArrays c::d::]
219        delete $o
220        eval lappend ::result [dumpArrays c::d::]
221
222        class C {
223            class D {
224                proc D {this p q} {
225                    lappend ::result "D::D $this"
226                    set ($this,m) $p
227                    set ($this,n) $q
228                }
229                proc ~D {this} {
230                    lappend ::result "D::~D $this"
231                }
232            }
233            set o [new D x {y z}]
234            eval lappend ::result [dumpArrays D::]
235            delete $o
236            eval lappend ::result [dumpArrays D::]
237        }
238        set o [new C::D x {y z}]
239        eval lappend ::result [dumpArrays C::D::]
240        delete $o
241        eval lappend ::result [dumpArrays C::D::]
242
243        set ::result
244    }]
245    interp delete $interpreter
246    set result
247} [list\
248    {a::a 1}\
249    {a::(1,m) = x}\
250    {a::(1,n) = y z}\
251    {a::~a 1}\
252    {A::A 2}\
253    {A::(2,m) = x}\
254    {A::(2,n) = y z}\
255    {A::~A 2}\
256    {d::d 3}\
257    {c::d::(3,m) = x}\
258    {c::d::(3,n) = y z}\
259    {d::~d 3}\
260    {D::D 4}\
261    {D::(4,m) = x}\
262    {D::(4,n) = y z}\
263    {D::~D 4}\
264    {D::D 5}\
265    {C::D::(5,m) = x}\
266    {C::D::(5,n) = y z}\
267    {D::~D 5}\
268]
269
270test stooop-5 {
271    undocumented
272} {
273    set interpreter [interp create]
274    $interpreter eval "source $source; namespace import stooop::*"
275    set result [$interpreter eval {
276        class ::a {}
277        class b::b {}
278        set ::result {}
279    }]
280    interp delete $interpreter
281    set result
282} {}
283
284test stooop-6 {
285    undocumented
286} {
287    set interpreter [interp create]
288    $interpreter eval "source $source; namespace import stooop::*"
289    $interpreter eval $dumpArraysCode
290    set result [$interpreter eval {
291        class a {}
292        proc a::a {this p} {
293            lappend ::result "a::a $this"
294            set ($this,m) $p
295        }
296        proc a::~a {this} {
297            lappend ::result "a::~a $this"
298        }
299        class b {}
300        proc b::b {this p q} a {$p} {
301            lappend ::result "b::b $this"
302            set ($this,n) $q
303        }
304        proc b::~b {this} {
305            lappend ::result "b::~b $this"
306        }
307        set o [new b {x y} z]
308        eval lappend ::result [dumpArrays a:: b::]
309        delete $o
310        eval lappend ::result [dumpArrays a:: b::]
311
312        class A {
313            proc A {this p} {
314                lappend ::result "A::A $this"
315                set ($this,m) $p
316            }
317            proc ~A {this} {
318                lappend ::result "A::~A $this"
319            }
320        }
321        class B {
322            proc B {this p q} A {$p} {
323                lappend ::result "B::B $this"
324                set ($this,n) $q
325            }
326            proc ~B {this} {
327                lappend ::result "B::~B $this"
328            }
329        }
330        set o [new B {x y} z]
331        eval lappend ::result [dumpArrays A:: B::]
332        delete $o
333        eval lappend ::result [dumpArrays A:: B::]
334
335        class c::d {}
336        proc c::d::d {this p} {
337            lappend ::result "d::d $this"
338            set ($this,m) $p
339        }
340        proc c::d::~d {this} {
341            lappend ::result "d::~d $this"
342        }
343        class c::e {}
344        proc c::e::e {this p q} c::d {$p} {
345            lappend ::result "e::e $this"
346            set ($this,n) $q
347        }
348        proc c::e::~e {this} {
349            lappend ::result "e::~e $this"
350        }
351        set o [new c::e {x y} z]
352        eval lappend ::result [dumpArrays c::d:: c::e::]
353        delete $o
354        eval lappend ::result [dumpArrays c::d:: c::e::]
355
356        class C {
357            class D {
358                proc D {this p} {
359                    lappend ::result "D::D $this"
360                    set ($this,m) $p
361                }
362                proc ~D {this} {
363                    lappend ::result "D::~D $this"
364                }
365            }
366            class E {
367                proc E {this p q} C::D {$p} {
368                    lappend ::result "E::E $this"
369                    set ($this,n) $q
370                }
371                proc ~E {this} {
372                    lappend ::result "E::~E $this"
373                }
374            }
375        }
376        set o [new C::E {x y} z]
377        eval lappend ::result [dumpArrays C::D:: C::E::]
378        delete $o
379        eval lappend ::result [dumpArrays C::D:: C::E::]
380
381        set ::result
382    }]
383    interp delete $interpreter
384    set result
385} [list\
386    {a::a 1}\
387    {b::b 1}\
388    {a::(1,_derived) = ::b}\
389    {a::(1,m) = x y}\
390    {b::(1,n) = z}\
391    {b::~b 1}\
392    {a::~a 1}\
393    {A::A 2}\
394    {B::B 2}\
395    {A::(2,_derived) = ::B}\
396    {A::(2,m) = x y}\
397    {B::(2,n) = z}\
398    {B::~B 2}\
399    {A::~A 2}\
400    {d::d 3}\
401    {e::e 3}\
402    {c::d::(3,_derived) = ::c::e}\
403    {c::d::(3,m) = x y}\
404    {c::e::(3,n) = z}\
405    {e::~e 3}\
406    {d::~d 3}\
407    {D::D 4}\
408    {E::E 4}\
409    {C::D::(4,_derived) = ::C::E}\
410    {C::D::(4,m) = x y}\
411    {C::E::(4,n) = z}\
412    {E::~E 4}\
413    {D::~D 4}\
414]
415
416test stooop-7 {
417    undocumented
418} {
419    set interpreter [interp create]
420    $interpreter eval "source $source; namespace import stooop::*"
421    set result [$interpreter eval {
422        class a {}
423        proc a::a {this} {}
424        class b {}
425        proc b::b {this} a {} {}
426        class c {}
427        proc c::c {this} b {} a {} {}
428        lappend ::result [classof [new a]]
429        lappend ::result [classof [new b]]
430        lappend ::result [classof [new c]]
431
432        class A {
433            proc A {this} {}
434        }
435        class B {
436            proc B {this} A {} {}
437        }
438        class C {
439            proc C {this} B {} A {} {}
440        }
441        lappend ::result [classof [new A]]
442        lappend ::result [classof [new B]]
443        lappend ::result [classof [new C]]
444
445        class d::e {}
446        proc d::e::e {this} {}
447        class d::f {}
448        proc d::f::f {this} d::e {} {}
449        class d::g {}
450        proc d::g::g {this} d::f {} d::e {} {}
451        lappend ::result [classof [new d::e]]
452        lappend ::result [classof [new d::f]]
453        lappend ::result [classof [new d::g]]
454
455        class D {
456            class E {
457                proc E {this} {}
458            }
459            class F {
460                proc F {this} D::E {} {}
461            }
462            class G {
463                proc G {this} D::F {} D::E {} {}
464            }
465            lappend ::result [classof [new E]]
466            lappend ::result [classof [new F]]
467            lappend ::result [classof [new G]]
468        }
469        lappend ::result [classof [new D::E]]
470        lappend ::result [classof [new D::F]]
471        lappend ::result [classof [new D::G]]
472
473        set ::result
474    }]
475    interp delete $interpreter
476    set result
477} [list\
478    ::a\
479    ::b\
480    ::c\
481    ::A\
482    ::B\
483    ::C\
484    ::d::e\
485    ::d::f\
486    ::d::g\
487    ::D::E\
488    ::D::F\
489    ::D::G\
490    ::D::E\
491    ::D::F\
492    ::D::G\
493]
494
495test stooop-8 {
496    undocumented
497} {
498    set interpreter [interp create]
499    $interpreter eval "source $source; namespace import stooop::*"
500    set result [$interpreter eval {
501        class a {}
502        proc a::a {this} {
503            lappend ::result "a::a $this"
504        }
505        proc a::~a {this} {
506            lappend ::result "a::~a $this"
507        }
508        class b {}
509        proc b::b {this} a {} {
510            lappend ::result "b::b $this"
511        }
512        proc b::~b {this} {
513            lappend ::result "b::~b $this"
514        }
515        class c {}
516        proc c::c {this} b {} {
517            lappend ::result "c::c $this"
518        }
519        proc c::~c {this} {
520            lappend ::result "c::~c $this"
521        }
522        delete [new a]
523        delete [new b]
524        delete [new c]
525
526        class A {
527            proc A {this} {
528                lappend ::result "A::A $this"
529            }
530            proc ~A {this} {
531                lappend ::result "A::~A $this"
532            }
533        }
534        class B {
535            proc B {this} A {} {
536                lappend ::result "B::B $this"
537            }
538            proc ~B {this} {
539                lappend ::result "B::~B $this"
540            }
541        }
542        class C {
543            proc C {this} B {} {
544                lappend ::result "C::C $this"
545            }
546            proc ~C {this} {
547                lappend ::result "C::~C $this"
548            }
549        }
550        delete [new A]
551        delete [new B]
552        delete [new C]
553
554        class d::e {}
555        proc d::e::e {this} {
556            lappend ::result "e::e $this"
557        }
558        proc d::e::~e {this} {
559            lappend ::result "e::~e $this"
560        }
561        class d::f {}
562        proc d::f::f {this} d::e {} {
563            lappend ::result "f::f $this"
564        }
565        proc d::f::~f {this} {
566            lappend ::result "f::~f $this"
567        }
568        class d::g {}
569        proc d::g::g {this} d::f {} {
570            lappend ::result "g::g $this"
571        }
572        proc d::g::~g {this} {
573            lappend ::result "g::~g $this"
574        }
575        delete [new d::e]
576        delete [new d::f]
577        delete [new d::g]
578
579        class D {
580            class E {
581                proc E {this} {
582                    lappend ::result "E::E $this"
583                }
584                proc ~E {this} {
585                    lappend ::result "E::~E $this"
586                }
587            }
588            class F {
589                proc F {this} D::E {} {
590                    lappend ::result "F::F $this"
591                }
592                proc ~F {this} {
593                    lappend ::result "F::~F $this"
594                }
595            }
596            class G {
597                proc G {this} D::F {} {
598                    lappend ::result "G::G $this"
599                }
600                proc ~G {this} {
601                    lappend ::result "G::~G $this"
602                }
603            }
604            delete [new E]
605            delete [new F]
606            delete [new G]
607        }
608        delete [new D::E]
609        delete [new D::F]
610        delete [new D::G]
611
612        set ::result
613    }]
614    interp delete $interpreter
615    set result
616} [list\
617    {a::a 1}\
618    {a::~a 1}\
619    {a::a 2}\
620    {b::b 2}\
621    {b::~b 2}\
622    {a::~a 2}\
623    {a::a 3}\
624    {b::b 3}\
625    {c::c 3}\
626    {c::~c 3}\
627    {b::~b 3}\
628    {a::~a 3}\
629    {A::A 4}\
630    {A::~A 4}\
631    {A::A 5}\
632    {B::B 5}\
633    {B::~B 5}\
634    {A::~A 5}\
635    {A::A 6}\
636    {B::B 6}\
637    {C::C 6}\
638    {C::~C 6}\
639    {B::~B 6}\
640    {A::~A 6}\
641    {e::e 7}\
642    {e::~e 7}\
643    {e::e 8}\
644    {f::f 8}\
645    {f::~f 8}\
646    {e::~e 8}\
647    {e::e 9}\
648    {f::f 9}\
649    {g::g 9}\
650    {g::~g 9}\
651    {f::~f 9}\
652    {e::~e 9}\
653    {E::E 10}\
654    {E::~E 10}\
655    {E::E 11}\
656    {F::F 11}\
657    {F::~F 11}\
658    {E::~E 11}\
659    {E::E 12}\
660    {F::F 12}\
661    {G::G 12}\
662    {G::~G 12}\
663    {F::~F 12}\
664    {E::~E 12}\
665    {E::E 13}\
666    {E::~E 13}\
667    {E::E 14}\
668    {F::F 14}\
669    {F::~F 14}\
670    {E::~E 14}\
671    {E::E 15}\
672    {F::F 15}\
673    {G::G 15}\
674    {G::~G 15}\
675    {F::~F 15}\
676    {E::~E 15}\
677]
678
679test stooop-9 {
680    undocumented
681} {
682    set interpreter [interp create]
683    $interpreter eval "source $source; namespace import stooop::*"
684    set result [$interpreter eval {
685        catch {
686            class a {}
687            proc a::a {this} {}
688            proc a::~a {this p} {}
689        } message
690        lappend ::result $message
691
692        catch {
693            class A {
694                proc A {this} {}
695                proc ~A {this p} {}
696            }
697        } message
698        lappend ::result $message
699
700        catch {
701            class b::c {}
702            proc b::c::c {this} {}
703            proc b::c::~c {this p} {}
704        } message
705        lappend ::result $message
706
707        catch {
708            class B {
709                class C {
710                    proc C {this} {}
711                    proc ~C {this p} {}
712                }
713            }
714        } message
715        lappend ::result $message
716
717        set ::result
718    }]
719    interp delete $interpreter
720    set result
721} [list\
722    {class ::a destructor must have 1 argument exactly}\
723    {class ::A destructor must have 1 argument exactly}\
724    {class ::b::c destructor must have 1 argument exactly}\
725    {class ::B::C destructor must have 1 argument exactly}\
726]
727
728test stooop-10 {
729    undocumented
730} {
731    set interpreter [interp create]
732    $interpreter eval "source $source; namespace import stooop::*"
733    set result [$interpreter eval {
734        catch {
735            class a {}
736            proc a::a {this} {}
737            virtual proc a::~a {this} {}
738        } message
739        lappend ::result $message
740
741        catch {
742            class A {
743                proc A {this} {}
744                virtual proc ~A {this} {}
745            }
746        } message
747        lappend ::result $message
748
749        catch {
750            class b::c {}
751            proc b::c::c {this} {}
752            virtual proc b::c::~c {this} {}
753        } message
754        lappend ::result $message
755
756        catch {
757            class B {
758                class C {
759                    proc C {this} {}
760                    virtual proc ~C {this} {}
761                }
762            }
763        } message
764        lappend ::result $message
765
766        set ::result
767    }]
768    interp delete $interpreter
769    set result
770} [list\
771    {cannot make class ::a destructor virtual}\
772    {cannot make class ::A destructor virtual}\
773    {cannot make class ::b::c destructor virtual}\
774    {cannot make class ::B::C destructor virtual}\
775]
776
777test stooop-11 {
778    undocumented
779} {
780    set interpreter [interp create]
781    $interpreter eval "source $source; namespace import stooop::*"
782    set result [$interpreter eval {
783        class a {}
784        proc a::a {this} {
785            lappend ::result "a::a $this"
786        }
787        proc a::~a {this} {
788            lappend ::result "a::~a $this"
789        }
790        virtual proc a::f {this p q} {}
791        virtual proc a::g {this p q}
792        virtual proc a::h {this p q} {
793            lappend ::result "a::h $this $p $q"
794        }
795        virtual proc a::i {this p q}
796        class b {}
797        proc b::b {this} a {} {
798            lappend ::result "b::b $this"
799        }
800        proc b::~b {this} {
801            lappend ::result "b::~b $this"
802        }
803        virtual proc b::f {this p q} {
804            lappend ::result "b::f $this $p $q"
805        }
806        virtual proc b::g {this p q} {
807            lappend ::result "b::g $this $p $q"
808        }
809        set o [new b]
810        a::f $o x {y z}
811        a::g $o x {y z}
812        a::h $o x {y z}
813        catch {a::i $o x {y z}} message
814        lappend ::result $message
815
816        class A {
817            proc A {this} {
818                lappend ::result "A::A $this"
819            }
820            proc ~A {this} {
821                lappend ::result "A::~A $this"
822            }
823            virtual proc f {this p q} {}
824            virtual proc g {this p q}
825            virtual proc h {this p q} {
826                lappend ::result "A::h $this $p $q"
827            }
828            virtual proc i {this p q}
829        }
830        class B {
831            proc B {this} A {} {
832                lappend ::result "B::B $this"
833            }
834            proc ~B {this} {
835                lappend ::result "B::~B $this"
836            }
837            virtual proc f {this p q} {
838                lappend ::result "B::f $this $p $q"
839            }
840            virtual proc g {this p q} {
841                lappend ::result "B::g $this $p $q"
842            }
843        }
844        set o [new B]
845        A::f $o x {y z}
846        A::g $o x {y z}
847        A::h $o x {y z}
848        catch {A::i $o x {y z}} message
849        lappend ::result $message
850
851        class c::d {}
852        proc c::d::d {this} {
853            lappend ::result "d::d $this"
854        }
855        proc c::d::~d {this} {
856            lappend ::result "d::~d $this"
857        }
858        virtual proc c::d::f {this p q} {}
859        virtual proc c::d::g {this p q}
860        virtual proc c::d::h {this p q} {
861            lappend ::result "d::h $this $p $q"
862        }
863        virtual proc c::d::i {this p q}
864        class c::e {}
865        proc c::e::e {this} c::d {} {
866            lappend ::result "e::e $this"
867        }
868        proc c::e::~e {this} {
869            lappend ::result "e::~e $this"
870        }
871        virtual proc c::e::f {this p q} {
872            lappend ::result "e::f $this $p $q"
873        }
874        virtual proc c::e::g {this p q} {
875            lappend ::result "e::g $this $p $q"
876        }
877        set o [new c::e]
878        c::d::f $o x {y z}
879        c::d::g $o x {y z}
880        c::d::h $o x {y z}
881        catch {c::d::i $o x {y z}} message
882        lappend ::result $message
883
884        class C {
885            class D {
886                proc D {this} {
887                    lappend ::result "D::D $this"
888                }
889                proc ~D {this} {
890                    lappend ::result "D::~D $this"
891                }
892                virtual proc f {this p q} {}
893                virtual proc g {this p q}
894                virtual proc h {this p q} {
895                    lappend ::result "D::h $this $p $q"
896                }
897                virtual proc i {this p q}
898            }
899            class E {
900                proc E {this} C::D {} {
901                    lappend ::result "E::E $this"
902                }
903                proc ~E {this} {
904                    lappend ::result "E::~E $this"
905                }
906                virtual proc f {this p q} {
907                    lappend ::result "E::f $this $p $q"
908                }
909                virtual proc g {this p q} {
910                    lappend ::result "E::g $this $p $q"
911                }
912            }
913            set o [new E]
914            D::f $o x {y z}
915            D::g $o x {y z}
916            D::h $o x {y z}
917            catch {D::i $o x {y z}} message
918            lappend ::result $message
919        }
920        set o [new C::E]
921        C::D::f $o x {y z}
922        C::D::g $o x {y z}
923        C::D::h $o x {y z}
924        catch {C::D::i $o x {y z}} message
925        lappend ::result $message
926
927        set ::result
928    }]
929    interp delete $interpreter
930    set result
931} [list\
932    {a::a 1}\
933    {b::b 1}\
934    {b::f 1 x y z}\
935    {b::g 1 x y z}\
936    {a::h 1 x y z}\
937    {invalid command name "::b::i"}\
938    {A::A 2}\
939    {B::B 2}\
940    {B::f 2 x y z}\
941    {B::g 2 x y z}\
942    {A::h 2 x y z}\
943    {invalid command name "::B::i"}\
944    {d::d 3}\
945    {e::e 3}\
946    {e::f 3 x y z}\
947    {e::g 3 x y z}\
948    {d::h 3 x y z}\
949    {invalid command name "::c::e::i"}\
950    {D::D 4}\
951    {E::E 4}\
952    {E::f 4 x y z}\
953    {E::g 4 x y z}\
954    {D::h 4 x y z}\
955    {invalid command name "::C::E::i"}\
956    {D::D 5}\
957    {E::E 5}\
958    {E::f 5 x y z}\
959    {E::g 5 x y z}\
960    {D::h 5 x y z}\
961    {invalid command name "::C::E::i"}\
962]
963
964test stooop-12 {
965    undocumented
966} {
967    set interpreter [interp create]
968    $interpreter eval "source $source; namespace import stooop::*"
969    set result [$interpreter eval {
970        catch {
971            class a {}
972            virtual proc a::a {this} {}
973        } message
974        lappend ::result $message
975
976        catch {
977            class A {
978                virtual proc A {this} {}
979            }
980        } message
981        lappend ::result $message
982
983        catch {
984            class b::c {}
985            virtual proc b::c::c {this} {}
986        } message
987        lappend ::result $message
988
989        catch {
990            class B {
991                class C {
992                    virtual proc C {this} {}
993                }
994            }
995        } message
996        lappend ::result $message
997
998        set ::result
999    }]
1000    interp delete $interpreter
1001    set result
1002} [list\
1003    {cannot make class ::a constructor virtual}\
1004    {cannot make class ::A constructor virtual}\
1005    {cannot make class ::b::c constructor virtual}\
1006    {cannot make class ::B::C constructor virtual}\
1007]
1008
1009test stooop-13 {
1010    undocumented
1011} {
1012    set interpreter [interp create]
1013    $interpreter eval "source $source; namespace import stooop::*"
1014    set result [$interpreter eval {
1015        catch {
1016            class a {}
1017            proc a::~a {this} {}
1018        } message
1019        lappend ::result $message
1020
1021        catch {
1022            class A {
1023                proc ~A {this} {}
1024            }
1025        } message
1026        lappend ::result $message
1027
1028        catch {
1029            class b::c {}
1030            proc b::c::~c {this} {}
1031        } message
1032        lappend ::result $message
1033
1034        catch {
1035            class B {
1036                class C {
1037                    proc ~C {this} {}
1038                }
1039            }
1040        } message
1041        lappend ::result $message
1042
1043        set ::result
1044    }]
1045    interp delete $interpreter
1046    set result
1047} [list\
1048    {class ::a destructor defined before constructor}\
1049    {class ::A destructor defined before constructor}\
1050    {class ::b::c destructor defined before constructor}\
1051    {class ::B::C destructor defined before constructor}\
1052]
1053
1054test stooop-14 {
1055    undocumented
1056} {
1057    set interpreter [interp create]
1058    $interpreter eval "source $source; namespace import stooop::*"
1059    set result [$interpreter eval {
1060        class a {}
1061        catch {
1062            class b {}
1063            proc b::b {this} a {} {}
1064        } message
1065        lappend ::result $message
1066
1067        class A {}
1068        catch {
1069            class B {
1070                proc B {this} A {} {}
1071            }
1072        } message
1073        lappend ::result $message
1074
1075        class b::c {}
1076        catch {
1077            class b::d {}
1078            proc b::d::d {this} b::c {} {}
1079        } message
1080        lappend ::result $message
1081
1082        catch {
1083            class B {
1084                class C {}
1085                class D {
1086                    proc D {this} C {} {}
1087                }
1088            }
1089        } message
1090        lappend ::result $message
1091
1092        set ::result
1093    }]
1094    interp delete $interpreter
1095    set result
1096} [list\
1097    {class ::b constructor defined before base class a constructor}\
1098    {class ::B constructor defined before base class A constructor}\
1099    {class ::b::d constructor defined before base class b::c constructor}\
1100    {class ::B::D constructor defined before base class C constructor}\
1101]
1102
1103test stooop-15 {
1104    undocumented
1105} {
1106    set interpreter [interp create]
1107    $interpreter eval "source $source; namespace import stooop::*"
1108    set result [$interpreter eval {
1109        catch {
1110            class a {}
1111            virtual a::f {this} {}
1112        } message
1113        lappend ::result $message
1114
1115        catch {
1116            class A {
1117                virtual f {this} {}
1118            }
1119        } message
1120        lappend ::result $message
1121
1122        catch {
1123            class b::c {}
1124            virtual b::c::f {this} {}
1125        } message
1126        lappend ::result $message
1127
1128        catch {
1129            class B {
1130                class C {
1131                    virtual f {this} {}
1132                }
1133            }
1134        } message
1135        lappend ::result $message
1136
1137        set ::result
1138    }]
1139    interp delete $interpreter
1140    set result
1141} [list\
1142    {virtual operator works only on proc, not a::f}\
1143    {virtual operator works only on proc, not f}\
1144    {virtual operator works only on proc, not b::c::f}\
1145    {virtual operator works only on proc, not f}\
1146]
1147
1148test stooop-16 {
1149    undocumented
1150} {
1151    set interpreter [interp create]
1152    $interpreter eval "source $source; namespace import stooop::*"
1153    set result [$interpreter eval {
1154        catch {
1155            virtual proc f {} {}
1156        } message
1157        lappend ::result $message
1158
1159        catch {
1160            virtual proc a::f {} {}
1161        } message
1162        lappend ::result $message
1163
1164        set ::result
1165    }]
1166    interp delete $interpreter
1167    set result
1168} [list\
1169    {procedure ::f class name is empty}\
1170    {procedure ::a::f class ::a is unknown}\
1171]
1172
1173test stooop-17 {
1174    undocumented
1175} {
1176    set interpreter [interp create]
1177    $interpreter eval "source $source; namespace import stooop::*"
1178    set result [$interpreter eval {
1179        catch {
1180            class a {}
1181            proc a::f {this}
1182        } message
1183        lappend ::result $message
1184
1185        catch {
1186            class A {
1187                proc f {this}
1188            }
1189        } message
1190        lappend ::result $message
1191
1192        catch {
1193            class b::c {}
1194            proc b::c::f {this}
1195        } message
1196        lappend ::result $message
1197
1198        catch {
1199            class B {
1200                class C {
1201                    proc f {this}
1202                }
1203            }
1204        } message
1205        lappend ::result $message
1206
1207        set ::result
1208    }]
1209    interp delete $interpreter
1210    set result
1211} [list\
1212    {missing body for ::a::f}\
1213    {missing body for ::A::f}\
1214    {missing body for ::b::c::f}\
1215    {missing body for ::B::C::f}\
1216]
1217
1218test stooop-18 {
1219    undocumented
1220} {
1221    set interpreter [interp create]
1222    $interpreter eval "source $source; namespace import stooop::*"
1223    set result [$interpreter eval {
1224        catch {
1225            class b {}
1226            proc b::b {this} a {}
1227        } message
1228        lappend ::result $message
1229
1230        catch {
1231            class B {
1232                proc B {this} A {}
1233            }
1234        } message
1235        lappend ::result $message
1236
1237        catch {
1238            class c::e {}
1239            proc c::e::e {this} d {}
1240        } message
1241        lappend ::result $message
1242
1243        catch {
1244            class C {
1245                class E {
1246                    proc E {this} D {}
1247                }
1248            }
1249        } message
1250        lappend ::result $message
1251
1252        set ::result
1253    }]
1254    interp delete $interpreter
1255    set result
1256} [list\
1257    {bad class ::b constructor declaration, a base class, contructor arguments or body may be missing}\
1258    {bad class ::B constructor declaration, a base class, contructor arguments or body may be missing}\
1259    {bad class ::c::e constructor declaration, a base class, contructor arguments or body may be missing}\
1260    {bad class ::C::E constructor declaration, a base class, contructor arguments or body may be missing}\
1261]
1262
1263test stooop-19 {
1264    undocumented
1265} {
1266    set interpreter [interp create]
1267    $interpreter eval "source $source; namespace import stooop::*"
1268    set result [$interpreter eval {
1269        catch {
1270            class b {}
1271            proc b::b {this} b {} {}
1272        } message
1273        lappend ::result $message
1274
1275        catch {
1276            class B {
1277                proc B {this} B {} {}
1278            }
1279        } message
1280        lappend ::result $message
1281
1282        catch {
1283            class c::d {}
1284            proc c::d::d {this} c::d {} {}
1285        } message
1286        lappend ::result $message
1287
1288        catch {
1289            class C {
1290                class D {
1291                    proc D {this} D {} {}
1292                }
1293            }
1294        } message
1295        lappend ::result $message
1296
1297        set ::result
1298    }]
1299    interp delete $interpreter
1300    set result
1301} [list\
1302    {class ::b cannot be derived from itself}\
1303    {class ::B cannot be derived from itself}\
1304    {class ::c::d cannot be derived from itself}\
1305    {class ::C::D cannot be derived from itself}\
1306]
1307
1308test stooop-20 {
1309    undocumented
1310} {
1311    set interpreter [interp create]
1312    $interpreter eval "source $source; namespace import stooop::*"
1313    set result [$interpreter eval {
1314        catch {
1315            class a {}
1316            proc a::~a {this} {}
1317        } message
1318        lappend ::result $message
1319
1320        catch {
1321            class A {
1322                proc ~A {this} {}
1323            }
1324        } message
1325        lappend ::result $message
1326
1327        catch {
1328            class a {}
1329            proc a::a {this} {}
1330            class a::b {}
1331            proc a::b::~b {this} {}
1332        } message
1333        lappend ::result $message
1334
1335        catch {
1336            class A {
1337                proc A {this} {}
1338                class B {
1339                    proc ~B {this} {}
1340                }
1341            }
1342        } message
1343        lappend ::result $message
1344
1345        set ::result
1346    }]
1347    interp delete $interpreter
1348    set result
1349} [list\
1350    {class ::a destructor defined before constructor}\
1351    {class ::A destructor defined before constructor}\
1352    {class ::a::b destructor defined before constructor}\
1353    {class ::A::B destructor defined before constructor}\
1354]
1355
1356test stooop-21 {
1357    undocumented
1358} {
1359    set interpreter [interp create]
1360    $interpreter eval "source $source; namespace import stooop::*"
1361    set result [$interpreter eval {
1362        catch {
1363            class a {}
1364            proc a::a {p} {}
1365        } message
1366        lappend ::result $message
1367
1368        catch {
1369            class A {
1370                proc A {p} {}
1371            }
1372        } message
1373        lappend ::result $message
1374
1375        catch {
1376            class a {}
1377            proc a::a {this} {}
1378            class a::b {}
1379            proc a::b::b {p} {}
1380        } message
1381        lappend ::result $message
1382
1383        catch {
1384            class A {
1385                proc A {this} {}
1386                class B {
1387                    proc B {p} {}
1388                }
1389            }
1390        } message
1391        lappend ::result $message
1392
1393        set ::result
1394    }]
1395    interp delete $interpreter
1396    set result
1397} [list\
1398    {class ::a constructor first argument must be this}\
1399    {class ::A constructor first argument must be this}\
1400    {class ::a::b constructor first argument must be this}\
1401    {class ::A::B constructor first argument must be this}\
1402]
1403
1404test stooop-22 {
1405    undocumented
1406} {
1407    set interpreter [interp create]
1408    $interpreter eval "source $source; namespace import stooop::*"
1409    set result [$interpreter eval {
1410        catch {
1411            class a {}
1412            proc a::~a {p} {}
1413        } message
1414        lappend ::result $message
1415
1416        catch {
1417            class A {
1418                proc ~A {p} {}
1419            }
1420        } message
1421        lappend ::result $message
1422
1423        catch {
1424            class a {}
1425            proc a::a {this} {}
1426            class a::b {}
1427            proc a::b::~b {p} {}
1428        } message
1429        lappend ::result $message
1430
1431        catch {
1432            class A {
1433                proc A {this} {}
1434                class B {
1435                    proc ~B {p} {}
1436                }
1437            }
1438        } message
1439        lappend ::result $message
1440
1441        set ::result
1442    }]
1443    interp delete $interpreter
1444    set result
1445} [list\
1446    {class ::a destructor argument must be this}\
1447    {class ::A destructor argument must be this}\
1448    {class ::a::b destructor argument must be this}\
1449    {class ::A::B destructor argument must be this}\
1450]
1451
1452test stooop-23 {
1453    undocumented
1454} {
1455    set interpreter [interp create]
1456    $interpreter eval "source $source; namespace import stooop::*"
1457    set result [$interpreter eval {
1458        catch {
1459            class a {}
1460            virtual proc a::f {p} {}
1461        } message
1462        lappend ::result $message
1463
1464        catch {
1465            class A {
1466                virtual proc f {p} {}
1467            }
1468        } message
1469        lappend ::result $message
1470
1471        catch {
1472            class a {}
1473            proc a::a {this} {}
1474            class a::b {}
1475            virtual proc a::b::f {p} {}
1476        } message
1477        lappend ::result $message
1478
1479        catch {
1480            class A {
1481                proc A {this} {}
1482                class B {
1483                    virtual proc f {p} {}
1484                }
1485            }
1486        } message
1487        lappend ::result $message
1488
1489        set ::result
1490    }]
1491    interp delete $interpreter
1492    set result
1493} [list\
1494    {cannot make static procedure f of class ::a virtual}\
1495    {cannot make static procedure f of class ::A virtual}\
1496    {cannot make static procedure f of class ::a::b virtual}\
1497    {cannot make static procedure f of class ::A::B virtual}\
1498]
1499
1500test stooop-24 {
1501    undocumented
1502} {
1503    set interpreter [interp create]
1504    $interpreter eval "source $source; namespace import stooop::*"
1505    $interpreter eval $dumpArraysCode
1506    set result [$interpreter eval {
1507        class a {}
1508        proc a::a {this p args} {
1509            lappend ::result "a::a $this $p $args"
1510            set ($this,m) [lindex $args 0]
1511        }
1512        proc a::~a {this} {
1513            lappend ::result "a::~a $this"
1514        }
1515        class b {}
1516        proc b::b {this p args} a {$p $args} {
1517            lappend ::result "b::b $this $p $args"
1518            set ($this,n) [lindex $args 0]
1519        }
1520        proc b::~b {this} {
1521            lappend ::result "b::~b $this"
1522        }
1523        new b {x y} {1 2} 3
1524        eval lappend ::result [dumpArrays a:: b::]
1525
1526        class A {
1527            proc A {this p args} {
1528                lappend ::result "A::A $this $p $args"
1529                set ($this,m) [lindex $args 0]
1530            }
1531            proc ~A {this} {
1532                lappend ::result "A::~A $this"
1533            }
1534        }
1535        class B {
1536            proc B {this p args} A {$p $args} {
1537                lappend ::result "B::B $this $p $args"
1538                set ($this,n) [lindex $args 0]
1539            }
1540            proc ~B {this} {
1541                lappend ::result "B::~B $this"
1542            }
1543        }
1544        new B {x y} {1 2} 3
1545        eval lappend ::result [dumpArrays A:: B::]
1546
1547        class c {}
1548        class c::d {}
1549        proc c::d::d {this p args} {
1550            lappend ::result "d::d $this $p $args"
1551            set ($this,m) [lindex $args 0]
1552        }
1553        proc c::d::~d {this} {
1554            lappend ::result "d::~d $this"
1555        }
1556        class c::e {}
1557        proc c::e::e {this p args} c::d {$p $args} {
1558            lappend ::result "e::e $this $p $args"
1559            set ($this,n) [lindex $args 0]
1560        }
1561        proc c::e::~e {this} {
1562            lappend ::result "e::~e $this"
1563        }
1564        new c::e {x y} {1 2} 3
1565        eval lappend ::result [dumpArrays c::d:: c::e::]
1566
1567        class C {
1568            class D {
1569                proc D {this p args} {
1570                    lappend ::result "D::D $this $p $args"
1571                    set ($this,m) [lindex $args 0]
1572                }
1573                proc ~D {this} {
1574                    lappend ::result "D::~D $this"
1575                }
1576            }
1577            class E {
1578                proc E {this p args} C::D {$p $args} {
1579                    lappend ::result "E::E $this $p $args"
1580                    set ($this,n) [lindex $args 0]
1581                }
1582                proc ~E {this} {
1583                    lappend ::result "E::~E $this"
1584                }
1585            }
1586            new E {x y} {1 2} 3
1587            eval lappend ::result [dumpArrays D:: E::]
1588        }
1589        new C::E {x y} {1 2} 3
1590        eval lappend ::result [dumpArrays C::D:: C::E::]
1591
1592        set ::result
1593    }]
1594    interp delete $interpreter
1595    set result
1596} [list\
1597    {a::a 1 x y {1 2} 3}\
1598    {b::b 1 x y {1 2} 3}\
1599    {a::(1,_derived) = ::b}\
1600    {a::(1,m) = 1 2}\
1601    {b::(1,n) = 1 2}\
1602    {A::A 2 x y {1 2} 3}\
1603    {B::B 2 x y {1 2} 3}\
1604    {A::(2,_derived) = ::B}\
1605    {A::(2,m) = 1 2}\
1606    {B::(2,n) = 1 2}\
1607    {d::d 3 x y {1 2} 3}\
1608    {e::e 3 x y {1 2} 3}\
1609    {c::d::(3,_derived) = ::c::e}\
1610    {c::d::(3,m) = 1 2}\
1611    {c::e::(3,n) = 1 2}\
1612    {D::D 4 x y {1 2} 3}\
1613    {E::E 4 x y {1 2} 3}\
1614    {D::(4,_derived) = ::C::E}\
1615    {D::(4,m) = 1 2}\
1616    {E::(4,n) = 1 2}\
1617    {D::D 5 x y {1 2} 3}\
1618    {E::E 5 x y {1 2} 3}\
1619    {C::D::(4,_derived) = ::C::E}\
1620    {C::D::(4,m) = 1 2}\
1621    {C::D::(5,_derived) = ::C::E}\
1622    {C::D::(5,m) = 1 2}\
1623    {C::E::(4,n) = 1 2}\
1624    {C::E::(5,n) = 1 2}\
1625]
1626
1627test stooop-25 {
1628    undocumented
1629} {
1630    set interpreter [interp create]
1631    $interpreter eval "source $source; namespace import stooop::*"
1632    set result [$interpreter eval {
1633        class a {}
1634        proc a::a {this} {
1635            lappend ::result "a::a $this"
1636        }
1637        proc a::~a {this} {
1638            lappend ::result "a::~a $this"
1639        }
1640        virtual proc a::f {this p args} {}
1641        proc a::g {this p args} {
1642            lappend ::result "a::g $this $p $args"
1643        }
1644        class b {}
1645        proc b::b {this} a {} {
1646            lappend ::result "b::b $this"
1647        }
1648        proc b::~b {this} {
1649            lappend ::result "b::~b $this"
1650        }
1651        virtual proc b::f {this p args} {
1652            lappend ::result "b::f $this $p $args"
1653        }
1654        set o [new b]
1655        a::f $o {x y} {1 2} 3
1656        a::g $o {x y} {1 2} 3
1657
1658        class A {
1659            proc A {this} {
1660                lappend ::result "A::A $this"
1661            }
1662            proc ~A {this} {
1663                lappend ::result "A::~A $this"
1664            }
1665            virtual proc f {this p args} {}
1666            proc g {this p args} {
1667                lappend ::result "A::g $this $p $args"
1668            }
1669        }
1670        class B {
1671            proc B {this} A {} {
1672                lappend ::result "B::B $this"
1673            }
1674            proc ~B {this} {
1675                lappend ::result "B::~B $this"
1676            }
1677            virtual proc f {this p args} {
1678                lappend ::result "B::f $this $p $args"
1679            }
1680        }
1681        set o [new B]
1682        A::f $o {x y} {1 2} 3
1683        A::g $o {x y} {1 2} 3
1684
1685        class c {}
1686        class c::d {}
1687        proc c::d::d {this} {
1688            lappend ::result "d::d $this"
1689        }
1690        proc c::d::~d {this} {
1691            lappend ::result "d::~d $this"
1692        }
1693        virtual proc c::d::f {this p args} {}
1694        proc c::d::g {this p args} {
1695            lappend ::result "d::g $this $p $args"
1696        }
1697        class c::e {}
1698        proc c::e::e {this} c::d {} {
1699            lappend ::result "e::e $this"
1700        }
1701        proc c::e::~e {this} {
1702            lappend ::result "e::~e $this"
1703        }
1704        virtual proc c::e::f {this p args} {
1705            lappend ::result "e::f $this $p $args"
1706        }
1707        set o [new c::e]
1708        c::d::f $o {x y} {1 2} 3
1709        c::d::g $o {x y} {1 2} 3
1710
1711        class C {
1712            class D {
1713                proc D {this} {
1714                    lappend ::result "D::D $this"
1715                }
1716                proc ~D {this} {
1717                    lappend ::result "D::~D $this"
1718                }
1719                virtual proc f {this p args} {}
1720                proc g {this p args} {
1721                    lappend ::result "D::g $this $p $args"
1722                }
1723            }
1724            class B {
1725                proc B {this} C::D {} {
1726                    lappend ::result "B::B $this"
1727                }
1728                proc ~B {this} {
1729                    lappend ::result "B::~B $this"
1730                }
1731                virtual proc f {this p args} {
1732                    lappend ::result "B::f $this $p $args"
1733                }
1734            }
1735            set o [new B]
1736            D::f $o {x y} {1 2} 3
1737            D::g $o {x y} {1 2} 3
1738        }
1739        set o [new C::B]
1740        C::D::f $o {x y} {1 2} 3
1741        C::D::g $o {x y} {1 2} 3
1742
1743        set ::result
1744    }]
1745    interp delete $interpreter
1746    set result
1747} [list\
1748    {a::a 1}\
1749    {b::b 1}\
1750    {b::f 1 x y {1 2} 3}\
1751    {a::g 1 x y {1 2} 3}\
1752    {A::A 2}\
1753    {B::B 2}\
1754    {B::f 2 x y {1 2} 3}\
1755    {A::g 2 x y {1 2} 3}\
1756    {d::d 3}\
1757    {e::e 3}\
1758    {e::f 3 x y {1 2} 3}\
1759    {d::g 3 x y {1 2} 3}\
1760    {D::D 4}\
1761    {B::B 4}\
1762    {B::f 4 x y {1 2} 3}\
1763    {D::g 4 x y {1 2} 3}\
1764    {D::D 5}\
1765    {B::B 5}\
1766    {B::f 5 x y {1 2} 3}\
1767    {D::g 5 x y {1 2} 3}\
1768]
1769
1770test stooop-26 {
1771    undocumented
1772} {
1773    set interpreter [interp create]
1774    $interpreter eval "source $source; namespace import stooop::*"
1775    $interpreter eval $dumpArraysCode
1776    set result [$interpreter eval {
1777        class a {}
1778        proc a::a {this p q args} {
1779            lappend ::result "a::a $this $p $q $args"
1780            set ($this,m) [lindex $args 0]
1781            set ($this,p) $p
1782            set ($this,q) $q
1783        }
1784        proc a::~a {this} {
1785            lappend ::result "a::~a $this"
1786        }
1787        class b {}
1788        proc b::b {this p q args} a {$p $q $args} {
1789            lappend ::result "b::b $this $p $q $args"
1790            set ($this,n) [lindex $args 0]
1791        }
1792        proc b::~b {this} {
1793            lappend ::result "b::~b $this"
1794        }
1795        new b {x y} {X Y} {1 2} 3
1796        eval lappend ::result [dumpArrays a:: b::]
1797
1798        class A {
1799            proc A {this p q args} {
1800                lappend ::result "A::A $this $p $q $args"
1801                set ($this,m) [lindex $args 0]
1802                set ($this,p) $p
1803                set ($this,q) $q
1804            }
1805            proc ~A {this} {
1806                lappend ::result "A::~A $this"
1807            }
1808        }
1809        class B {
1810            proc B {this p q args} A {$p $q $args} {
1811                lappend ::result "B::B $this $p $q $args"
1812                set ($this,n) [lindex $args 0]
1813            }
1814            proc ~B {this} {
1815                lappend ::result "B::~B $this"
1816            }
1817        }
1818        new B {x y} {X Y} {1 2} 3
1819        eval lappend ::result [dumpArrays A:: B::]
1820
1821        class c {}
1822        class c::d {}
1823        proc c::d::d {this p q args} {
1824            lappend ::result "d::d $this $p $q $args"
1825            set ($this,m) [lindex $args 0]
1826            set ($this,p) $p
1827            set ($this,q) $q
1828        }
1829        proc c::d::~d {this} {
1830            lappend ::result "d::~d $this"
1831        }
1832        class c::e {}
1833        proc c::e::e {this p q args} c::d {$p $q $args} {
1834            lappend ::result "e::e $this $p $q $args"
1835            set ($this,n) [lindex $args 0]
1836        }
1837        proc c::e::~e {this} {
1838            lappend ::result "e::~e $this"
1839        }
1840        new c::e {x y} {X Y} {1 2} 3
1841        eval lappend ::result [dumpArrays c::d:: c::e::]
1842
1843        class C {
1844            class D {
1845                proc D {this p q args} {
1846                    lappend ::result "D::D $this $p $q $args"
1847                    set ($this,m) [lindex $args 0]
1848                    set ($this,p) $p
1849                    set ($this,q) $q
1850                }
1851                proc ~D {this} {
1852                    lappend ::result "D::~D $this"
1853                }
1854            }
1855            class E {
1856                proc E {this p q args} C::D {$p $q $args} {
1857                    lappend ::result "E::E $this $p $q $args"
1858                    set ($this,n) [lindex $args 0]
1859                }
1860                proc ~E {this} {
1861                    lappend ::result "E::~E $this"
1862                }
1863            }
1864            new E {x y} {X Y} {1 2} 3
1865            eval lappend ::result [dumpArrays D:: E::]
1866        }
1867        new C::E {x y} {X Y} {1 2} 3
1868        eval lappend ::result [dumpArrays C::D:: C::E::]
1869
1870        set ::result
1871    }]
1872    interp delete $interpreter
1873    set result
1874} [list\
1875    {a::a 1 x y X Y {1 2} 3}\
1876    {b::b 1 x y X Y {1 2} 3}\
1877    {a::(1,_derived) = ::b}\
1878    {a::(1,m) = 1 2}\
1879    {a::(1,p) = x y}\
1880    {a::(1,q) = X Y}\
1881    {b::(1,n) = 1 2}\
1882    {A::A 2 x y X Y {1 2} 3}\
1883    {B::B 2 x y X Y {1 2} 3}\
1884    {A::(2,_derived) = ::B}\
1885    {A::(2,m) = 1 2}\
1886    {A::(2,p) = x y}\
1887    {A::(2,q) = X Y}\
1888    {B::(2,n) = 1 2}\
1889    {d::d 3 x y X Y {1 2} 3}\
1890    {e::e 3 x y X Y {1 2} 3}\
1891    {c::d::(3,_derived) = ::c::e}\
1892    {c::d::(3,m) = 1 2}\
1893    {c::d::(3,p) = x y}\
1894    {c::d::(3,q) = X Y}\
1895    {c::e::(3,n) = 1 2}\
1896    {D::D 4 x y X Y {1 2} 3}\
1897    {E::E 4 x y X Y {1 2} 3}\
1898    {D::(4,_derived) = ::C::E}\
1899    {D::(4,m) = 1 2}\
1900    {D::(4,p) = x y}\
1901    {D::(4,q) = X Y}\
1902    {E::(4,n) = 1 2}\
1903    {D::D 5 x y X Y {1 2} 3}\
1904    {E::E 5 x y X Y {1 2} 3}\
1905    {C::D::(4,_derived) = ::C::E}\
1906    {C::D::(4,m) = 1 2}\
1907    {C::D::(4,p) = x y}\
1908    {C::D::(4,q) = X Y}\
1909    {C::D::(5,_derived) = ::C::E}\
1910    {C::D::(5,m) = 1 2}\
1911    {C::D::(5,p) = x y}\
1912    {C::D::(5,q) = X Y}\
1913    {C::E::(4,n) = 1 2}\
1914    {C::E::(5,n) = 1 2}\
1915]
1916
1917test stooop-27 {
1918    undocumented
1919} {
1920    set interpreter [interp create]
1921    $interpreter eval "source $source; namespace import stooop::*"
1922    $interpreter eval $dumpArraysCode
1923    set result [$interpreter eval {
1924        class a {}
1925        proc a::a {this args} {
1926            lappend ::result "a::a $this $args"
1927            set ($this,m) [lindex $args 0]
1928        }
1929        proc a::~a {this} {
1930            lappend ::result "a::~a $this"
1931        }
1932        class b {}
1933        proc b::b {this p args} a {$args} {
1934            lappend ::result "b::b $this $p $args"
1935            set ($this,n) [lindex $args 0]
1936        }
1937        proc b::~b {this} {
1938            lappend ::result "b::~b $this"
1939        }
1940        new b {x y} {1 2} 3
1941        eval lappend ::result [dumpArrays a:: b::]
1942
1943        class A {
1944            proc A {this args} {
1945                lappend ::result "A::A $this $args"
1946                set ($this,m) [lindex $args 0]
1947            }
1948            proc ~A {this} {
1949                lappend ::result "A::~A $this"
1950            }
1951        }
1952        class B {
1953            proc B {this p args} A {$args} {
1954                lappend ::result "B::B $this $p $args"
1955                set ($this,n) [lindex $args 0]
1956            }
1957            proc ~B {this} {
1958                lappend ::result "B::~B $this"
1959            }
1960        }
1961        new B {x y} {1 2} 3
1962        eval lappend ::result [dumpArrays A:: B::]
1963
1964        class c {}
1965        class c::d {}
1966        proc c::d::d {this args} {
1967            lappend ::result "d::d $this $args"
1968            set ($this,m) [lindex $args 0]
1969        }
1970        proc c::d::~d {this} {
1971            lappend ::result "d::~d $this"
1972        }
1973        class c::e {}
1974        proc c::e::e {this p args} c::d {$args} {
1975            lappend ::result "e::e $this $p $args"
1976            set ($this,n) [lindex $args 0]
1977        }
1978        proc c::e::~e {this} {
1979            lappend ::result "e::~e $this"
1980        }
1981        new c::e {x y} {1 2} 3
1982        eval lappend ::result [dumpArrays c::d:: c::e::]
1983
1984        class C {
1985            class D {
1986                proc D {this args} {
1987                    lappend ::result "D::D $this $args"
1988                    set ($this,m) [lindex $args 0]
1989                }
1990                proc ~D {this} {
1991                    lappend ::result "D::~D $this"
1992                }
1993            }
1994            class E {
1995                proc E {this p args} C::D {$args} {
1996                    lappend ::result "E::E $this $p $args"
1997                    set ($this,n) [lindex $args 0]
1998                }
1999                proc ~E {this} {
2000                    lappend ::result "E::~E $this"
2001                }
2002            }
2003            new E {x y} {1 2} 3
2004            eval lappend ::result [dumpArrays D:: E::]
2005        }
2006        new C::E {x y} {1 2} 3
2007        eval lappend ::result [dumpArrays C::D:: C::E::]
2008
2009        set ::result
2010    }]
2011    interp delete $interpreter
2012    set result
2013} [list\
2014    {a::a 1 {1 2} 3}\
2015    {b::b 1 x y {1 2} 3}\
2016    {a::(1,_derived) = ::b}\
2017    {a::(1,m) = 1 2}\
2018    {b::(1,n) = 1 2}\
2019    {A::A 2 {1 2} 3}\
2020    {B::B 2 x y {1 2} 3}\
2021    {A::(2,_derived) = ::B}\
2022    {A::(2,m) = 1 2}\
2023    {B::(2,n) = 1 2}\
2024    {d::d 3 {1 2} 3}\
2025    {e::e 3 x y {1 2} 3}\
2026    {c::d::(3,_derived) = ::c::e}\
2027    {c::d::(3,m) = 1 2}\
2028    {c::e::(3,n) = 1 2}\
2029    {D::D 4 {1 2} 3}\
2030    {E::E 4 x y {1 2} 3}\
2031    {D::(4,_derived) = ::C::E}\
2032    {D::(4,m) = 1 2}\
2033    {E::(4,n) = 1 2}\
2034    {D::D 5 {1 2} 3}\
2035    {E::E 5 x y {1 2} 3}\
2036    {C::D::(4,_derived) = ::C::E}\
2037    {C::D::(4,m) = 1 2}\
2038    {C::D::(5,_derived) = ::C::E}\
2039    {C::D::(5,m) = 1 2}\
2040    {C::E::(4,n) = 1 2}\
2041    {C::E::(5,n) = 1 2}\
2042]
2043
2044test stooop-28 {
2045    undocumented
2046} {
2047    set interpreter [interp create]
2048    $interpreter eval "source $source; namespace import stooop::*"
2049    $interpreter eval $dumpArraysCode
2050    set result [$interpreter eval {
2051        class a {}
2052        proc a::a {this args} {
2053            lappend ::result "a::a $this $args"
2054            set ($this,m) [lindex $args 0]
2055        }
2056        proc a::~a {this} {
2057            lappend ::result "a::~a $this"
2058        }
2059        class b {}
2060        proc b::b {this args} a {$args} {
2061            lappend ::result "b::b $this $args"
2062            set ($this,n) [lindex $args 0]
2063        }
2064        proc b::~b {this} {
2065            lappend ::result "b::~b $this"
2066        }
2067        new b {1 2} 3
2068        eval lappend ::result [dumpArrays a:: b::]
2069
2070        class A {
2071            proc A {this args} {
2072                lappend ::result "A::A $this $args"
2073                set ($this,m) [lindex $args 0]
2074            }
2075            proc ~A {this} {
2076                lappend ::result "A::~A $this"
2077            }
2078        }
2079        class B {
2080            proc B {this args} A {$args} {
2081                lappend ::result "B::B $this $args"
2082                set ($this,n) [lindex $args 0]
2083            }
2084            proc ~B {this} {
2085                lappend ::result "B::~B $this"
2086            }
2087        }
2088        new B {1 2} 3
2089        eval lappend ::result [dumpArrays A:: B::]
2090
2091        class c {}
2092        class c::d {}
2093        proc c::d::d {this args} {
2094            lappend ::result "d::d $this $args"
2095            set ($this,m) [lindex $args 0]
2096        }
2097        proc c::d::~d {this} {
2098            lappend ::result "d::~d $this"
2099        }
2100        class c::e {}
2101        proc c::e::e {this args} c::d {$args} {
2102            lappend ::result "e::e $this $args"
2103            set ($this,n) [lindex $args 0]
2104        }
2105        proc c::e::~e {this} {
2106            lappend ::result "e::~e $this"
2107        }
2108        new c::e {1 2} 3
2109        eval lappend ::result [dumpArrays c::d:: c::e::]
2110
2111        class C {
2112            class D {
2113                proc D {this args} {
2114                    lappend ::result "D::D $this $args"
2115                    set ($this,m) [lindex $args 0]
2116                }
2117                proc ~D {this} {
2118                    lappend ::result "D::~D $this"
2119                }
2120            }
2121            class E {
2122                proc E {this args} C::D {$args} {
2123                    lappend ::result "E::E $this $args"
2124                    set ($this,n) [lindex $args 0]
2125                }
2126                proc ~E {this} {
2127                    lappend ::result "E::~E $this"
2128                }
2129            }
2130            new E {1 2} 3
2131            eval lappend ::result [dumpArrays D:: E::]
2132        }
2133        new C::E {1 2} 3
2134        eval lappend ::result [dumpArrays C::D:: C::E::]
2135
2136        set ::result
2137    }]
2138    interp delete $interpreter
2139    set result
2140} [list\
2141    {a::a 1 {1 2} 3}\
2142    {b::b 1 {1 2} 3}\
2143    {a::(1,_derived) = ::b}\
2144    {a::(1,m) = 1 2}\
2145    {b::(1,n) = 1 2}\
2146    {A::A 2 {1 2} 3}\
2147    {B::B 2 {1 2} 3}\
2148    {A::(2,_derived) = ::B}\
2149    {A::(2,m) = 1 2}\
2150    {B::(2,n) = 1 2}\
2151    {d::d 3 {1 2} 3}\
2152    {e::e 3 {1 2} 3}\
2153    {c::d::(3,_derived) = ::c::e}\
2154    {c::d::(3,m) = 1 2}\
2155    {c::e::(3,n) = 1 2}\
2156    {D::D 4 {1 2} 3}\
2157    {E::E 4 {1 2} 3}\
2158    {D::(4,_derived) = ::C::E}\
2159    {D::(4,m) = 1 2}\
2160    {E::(4,n) = 1 2}\
2161    {D::D 5 {1 2} 3}\
2162    {E::E 5 {1 2} 3}\
2163    {C::D::(4,_derived) = ::C::E}\
2164    {C::D::(4,m) = 1 2}\
2165    {C::D::(5,_derived) = ::C::E}\
2166    {C::D::(5,m) = 1 2}\
2167    {C::E::(4,n) = 1 2}\
2168    {C::E::(5,n) = 1 2}\
2169]
2170
2171test stooop-29 {
2172    undocumented
2173} {
2174    set interpreter [interp create]
2175    $interpreter eval "source $source; namespace import stooop::*"
2176    set result [$interpreter eval {
2177        class a {}
2178        proc a::a {this p q} {
2179            lappend ::result "a::a $this $p $q"
2180        }
2181        proc a::~a {this} {}
2182        class b {}
2183        proc b::b {this p q} a {
2184            $p $q
2185        } {
2186            lappend ::result "b::b $this $p $q"
2187        }
2188        proc b::~b {this} {}
2189        new b {x y} z
2190
2191        class A {
2192            proc A {this p q} {
2193                lappend ::result "A::A $this $p $q"
2194            }
2195            proc ~A {this} {}
2196        }
2197        class B {
2198            proc B {this p q} A {
2199                $p $q
2200            } {
2201                lappend ::result "B::B $this $p $q"
2202            }
2203            proc ~B {this} {}
2204        }
2205        new B {x y} z
2206
2207        class c {}
2208        class c::d {}
2209        proc c::d::d {this p q} {
2210            lappend ::result "d::d $this $p $q"
2211        }
2212        proc c::d::~d {this} {}
2213        class c::e {}
2214        proc c::e::e {this p q} c::d {
2215            $p $q
2216        } {
2217            lappend ::result "e::e $this $p $q"
2218        }
2219        proc c::e::~e {this} {}
2220        new c::e {x y} z
2221
2222        class C {
2223            class D {
2224                proc D {this p q} {
2225                    lappend ::result "D::D $this $p $q"
2226                }
2227                proc ~D {this} {}
2228            }
2229            class E {
2230                proc E {this p q} C::D {
2231                    $p $q
2232                } {
2233                    lappend ::result "E::E $this $p $q"
2234                }
2235                proc ~E {this} {}
2236            }
2237            new E {x y} z
2238        }
2239        new C::E {x y} z
2240
2241        set ::result
2242    }]
2243    interp delete $interpreter
2244    set result
2245} [list\
2246    {a::a 1 x y z}\
2247    {b::b 1 x y z}\
2248    {A::A 2 x y z}\
2249    {B::B 2 x y z}\
2250    {d::d 3 x y z}\
2251    {e::e 3 x y z}\
2252    {D::D 4 x y z}\
2253    {E::E 4 x y z}\
2254    {D::D 5 x y z}\
2255    {E::E 5 x y z}\
2256]
2257
2258test stooop-30 {
2259    undocumented
2260} {
2261    set interpreter [interp create]
2262    $interpreter eval "source $source; namespace import stooop::*"
2263    set result [$interpreter eval {
2264        class a {}
2265        proc a::a {this} {
2266            lappend ::result "a::a $this"
2267        }
2268        proc a::~a {this} {
2269            lappend ::result "a::~a $this"
2270        }
2271        virtual proc a::f {this p q} {
2272            lappend ::result "a::h $this $p $q"
2273        }
2274        virtual proc a::g {this p args} {
2275            lappend ::result "a::g $this $p $args"
2276        }
2277        class b {}
2278        proc b::b {this} a {} {
2279            lappend ::result "b::b $this"
2280        }
2281        proc b::~b {this} {
2282            lappend ::result "b::~b $this"
2283        }
2284        proc b::f {this p q} {
2285            lappend ::result "b::f $this $p $q"
2286            a::_f $this $p $q
2287        }
2288        proc b::g {this p args} {
2289            lappend ::result "b::g $this $p $args"
2290            eval a::_g $this $p $args
2291        }
2292        set o [new b]
2293        a::f $o x {y z}
2294        a::g $o {x y} {1 2} 3 {4 5}
2295
2296        class A {
2297            proc A {this} {
2298                lappend ::result "A::A $this"
2299            }
2300            proc ~A {this} {
2301                lappend ::result "A::~A $this"
2302            }
2303            virtual proc f {this p q} {
2304                lappend ::result "A::h $this $p $q"
2305            }
2306            virtual proc g {this p args} {
2307                lappend ::result "A::g $this $p $args"
2308            }
2309        }
2310        class B {
2311            proc B {this} A {} {
2312                lappend ::result "B::B $this"
2313            }
2314            proc ~B {this} {
2315                lappend ::result "B::~B $this"
2316            }
2317            proc f {this p q} {
2318                lappend ::result "B::f $this $p $q"
2319                A::_f $this $p $q
2320            }
2321            proc g {this p args} {
2322                lappend ::result "B::g $this $p $args"
2323                eval A::_g $this $p $args
2324            }
2325        }
2326        set o [new B]
2327        A::f $o x {y z}
2328        A::g $o {x y} {1 2} 3 {4 5}
2329
2330        class c {}
2331        class c::d {}
2332        proc c::d::d {this} {
2333            lappend ::result "d::d $this"
2334        }
2335        proc c::d::~d {this} {
2336            lappend ::result "d::~d $this"
2337        }
2338        virtual proc c::d::f {this p q} {
2339            lappend ::result "d::h $this $p $q"
2340        }
2341        virtual proc c::d::g {this p args} {
2342            lappend ::result "d::g $this $p $args"
2343        }
2344        class c::e {}
2345        proc c::e::e {this} c::d {} {
2346            lappend ::result "e::e $this"
2347        }
2348        proc c::e::~e {this} {
2349            lappend ::result "e::~e $this"
2350        }
2351        proc c::e::f {this p q} {
2352            lappend ::result "e::f $this $p $q"
2353            c::d::_f $this $p $q
2354        }
2355        proc c::e::g {this p args} {
2356            lappend ::result "e::g $this $p $args"
2357            eval c::d::_g $this $p $args
2358        }
2359        set o [new c::e]
2360        c::d::f $o x {y z}
2361        c::d::g $o {x y} {1 2} 3 {4 5}
2362
2363        class C {
2364            class D {
2365                proc D {this} {
2366                    lappend ::result "D::D $this"
2367                }
2368                proc ~D {this} {
2369                    lappend ::result "D::~D $this"
2370                }
2371                virtual proc f {this p q} {
2372                    lappend ::result "D::h $this $p $q"
2373                }
2374                virtual proc g {this p args} {
2375                    lappend ::result "D::g $this $p $args"
2376                }
2377            }
2378            class E {
2379                proc E {this} C::D {} {
2380                    lappend ::result "E::E $this"
2381                }
2382                proc ~E {this} {
2383                    lappend ::result "E::~E $this"
2384                }
2385                proc f {this p q} {
2386                    lappend ::result "E::f $this $p $q"
2387                    C::D::_f $this $p $q
2388                }
2389                proc g {this p args} {
2390                    lappend ::result "E::g $this $p $args"
2391                    eval C::D::_g $this $p $args
2392                }
2393            }
2394            set o [new E]
2395            D::f $o x {y z}
2396            D::g $o {x y} {1 2} 3 {4 5}
2397        }
2398        set o [new C::E]
2399        C::D::f $o x {y z}
2400        C::D::g $o {x y} {1 2} 3 {4 5}
2401
2402        set ::result
2403    }]
2404    interp delete $interpreter
2405    set result
2406} [list\
2407    {a::a 1}\
2408    {b::b 1}\
2409    {b::f 1 x y z}\
2410    {a::h 1 x y z}\
2411    {b::g 1 x y {1 2} 3 {4 5}}\
2412    {a::g 1 x y {1 2} 3 {4 5}}\
2413    {A::A 2}\
2414    {B::B 2}\
2415    {B::f 2 x y z}\
2416    {A::h 2 x y z}\
2417    {B::g 2 x y {1 2} 3 {4 5}}\
2418    {A::g 2 x y {1 2} 3 {4 5}}\
2419    {d::d 3}\
2420    {e::e 3}\
2421    {e::f 3 x y z}\
2422    {d::h 3 x y z}\
2423    {e::g 3 x y {1 2} 3 {4 5}}\
2424    {d::g 3 x y {1 2} 3 {4 5}}\
2425    {D::D 4}\
2426    {E::E 4}\
2427    {E::f 4 x y z}\
2428    {D::h 4 x y z}\
2429    {E::g 4 x y {1 2} 3 {4 5}}\
2430    {D::g 4 x y {1 2} 3 {4 5}}\
2431    {D::D 5}\
2432    {E::E 5}\
2433    {E::f 5 x y z}\
2434    {D::h 5 x y z}\
2435    {E::g 5 x y {1 2} 3 {4 5}}\
2436    {D::g 5 x y {1 2} 3 {4 5}}\
2437]
2438
2439test stooop-31 {
2440    check multiple inheritance construction order, destruction order and data
2441    deallocation
2442} {
2443    set interpreter [interp create]
2444    $interpreter eval "source $source; namespace import stooop::*"
2445    $interpreter eval $dumpArraysCode
2446    set result [$interpreter eval {
2447        class a {}
2448        proc a::a {this p} {
2449            lappend ::result "a::a $this"
2450            set ($this,m) $p
2451        }
2452        proc a::~a {this} {
2453            lappend ::result "a::~a $this"
2454        }
2455        class b {}
2456        proc b::b {this p} {
2457            lappend ::result "b::b $this"
2458            set ($this,n) $p
2459        }
2460        proc b::~b {this} {
2461            lappend ::result "b::~b $this"
2462        }
2463        class c {}
2464        proc c::c {this p q r} a {$p} b {$q} {
2465            lappend ::result "c::c $this"
2466            set ($this,o) $r
2467        }
2468        proc c::~c {this} {
2469            lappend ::result "c::~c $this"
2470        }
2471        set o [new c {x y} z {1 2}]
2472        eval lappend ::result [dumpArrays a:: b:: c::]
2473        delete $o
2474        eval lappend ::result [dumpArrays a:: b:: c::]
2475
2476        class A {
2477            proc A {this p} {
2478                lappend ::result "A::A $this"
2479                set ($this,m) $p
2480            }
2481            proc ~A {this} {
2482                lappend ::result "A::~A $this"
2483            }
2484        }
2485        class B {
2486            proc B {this p} {
2487                lappend ::result "B::B $this"
2488                set ($this,n) $p
2489            }
2490            proc ~B {this} {
2491                lappend ::result "B::~B $this"
2492            }
2493        }
2494        class C {
2495            proc C {this p q r} A {$p} B {$q} {
2496                lappend ::result "C::C $this"
2497                set ($this,o) $r
2498            }
2499            proc ~C {this} {
2500                lappend ::result "C::~C $this"
2501            }
2502        }
2503        set o [new C {x y} z {1 2}]
2504        eval lappend ::result [dumpArrays A:: B:: C::]
2505        delete $o
2506        eval lappend ::result [dumpArrays A:: B:: C::]
2507
2508        class d {}
2509        class d::e {}
2510        proc d::e::e {this p} {
2511            lappend ::result "e::e $this"
2512            set ($this,m) $p
2513        }
2514        proc d::e::~e {this} {
2515            lappend ::result "e::~e $this"
2516        }
2517        class d::f {}
2518        proc d::f::f {this p} {
2519            lappend ::result "f::f $this"
2520            set ($this,n) $p
2521        }
2522        proc d::f::~f {this} {
2523            lappend ::result "f::~f $this"
2524        }
2525        class d::g {}
2526        proc d::g::g {this p q r} d::e {$p} d::f {$q} {
2527            lappend ::result "g::g $this"
2528            set ($this,o) $r
2529        }
2530        proc d::g::~g {this} {
2531            lappend ::result "g::~g $this"
2532        }
2533        set o [new d::g {x y} z {1 2}]
2534        eval lappend ::result [dumpArrays d::e:: d::f:: d::g::]
2535        delete $o
2536        eval lappend ::result [dumpArrays d::e:: d::f:: d::g::]
2537
2538        class C {
2539            class E {
2540                proc E {this p} {
2541                    lappend ::result "E::E $this"
2542                    set ($this,m) $p
2543                }
2544                proc ~E {this} {
2545                    lappend ::result "E::~E $this"
2546                }
2547            }
2548            class F {
2549                proc F {this p} {
2550                    lappend ::result "F::F $this"
2551                    set ($this,n) $p
2552                }
2553                proc ~F {this} {
2554                    lappend ::result "F::~F $this"
2555                }
2556            }
2557            class G {
2558                proc G {this p q r} C::E {$p} C::F {$q} {
2559                    lappend ::result "G::G $this"
2560                    set ($this,o) $r
2561                }
2562                proc ~G {this} {
2563                    lappend ::result "G::~G $this"
2564                }
2565            }
2566            set o [new G {x y} z {1 2}]
2567            eval lappend ::result [dumpArrays E:: F:: G::]
2568            delete $o
2569            eval lappend ::result [dumpArrays E:: F:: G::]
2570        }
2571        set o [new C::G {x y} z {1 2}]
2572        eval lappend ::result [dumpArrays C::E:: C::F:: C::G::]
2573        delete $o
2574        eval lappend ::result [dumpArrays C::E:: C::F:: C::G::]
2575
2576        set ::result
2577    }]
2578    interp delete $interpreter
2579    set result
2580} [list\
2581    {a::a 1}\
2582    {b::b 1}\
2583    {c::c 1}\
2584    {a::(1,_derived) = ::c}\
2585    {a::(1,m) = x y}\
2586    {b::(1,_derived) = ::c}\
2587    {b::(1,n) = z}\
2588    {c::(1,o) = 1 2}\
2589    {c::~c 1}\
2590    {b::~b 1}\
2591    {a::~a 1}\
2592    {A::A 2}\
2593    {B::B 2}\
2594    {C::C 2}\
2595    {A::(2,_derived) = ::C}\
2596    {A::(2,m) = x y}\
2597    {B::(2,_derived) = ::C}\
2598    {B::(2,n) = z}\
2599    {C::(2,o) = 1 2}\
2600    {C::~C 2}\
2601    {B::~B 2}\
2602    {A::~A 2}\
2603    {e::e 3}\
2604    {f::f 3}\
2605    {g::g 3}\
2606    {d::e::(3,_derived) = ::d::g}\
2607    {d::e::(3,m) = x y}\
2608    {d::f::(3,_derived) = ::d::g}\
2609    {d::f::(3,n) = z}\
2610    {d::g::(3,o) = 1 2}\
2611    {g::~g 3}\
2612    {f::~f 3}\
2613    {e::~e 3}\
2614    {E::E 4}\
2615    {F::F 4}\
2616    {G::G 4}\
2617    {E::(4,_derived) = ::C::G}\
2618    {E::(4,m) = x y}\
2619    {F::(4,_derived) = ::C::G}\
2620    {F::(4,n) = z}\
2621    {G::(4,o) = 1 2}\
2622    {G::~G 4}\
2623    {F::~F 4}\
2624    {E::~E 4}\
2625    {E::E 5}\
2626    {F::F 5}\
2627    {G::G 5}\
2628    {C::E::(5,_derived) = ::C::G}\
2629    {C::E::(5,m) = x y}\
2630    {C::F::(5,_derived) = ::C::G}\
2631    {C::F::(5,n) = z}\
2632    {C::G::(5,o) = 1 2}\
2633    {G::~G 5}\
2634    {F::~F 5}\
2635    {E::~E 5}\
2636]
2637
2638test stooop-32 {
2639    check that class constructor with multiple base classes has correct number
2640    of base class / argument pairs
2641} {
2642    set interpreter [interp create]
2643    $interpreter eval "source $source; namespace import stooop::*"
2644    set result [$interpreter eval {
2645        catch {
2646            class c {}
2647            proc c::c {this} a {} b {}
2648        } message
2649        lappend ::result $message
2650
2651        catch {
2652            class C {
2653                proc C {this} A {} B {}
2654            }
2655        } message
2656        lappend ::result $message
2657
2658        catch {
2659            class d {}
2660            class d::g {}
2661            proc d::g::g {this} d::e {} d::f {}
2662        } message
2663        lappend ::result $message
2664
2665        catch {
2666            class C {
2667                class G {
2668                    proc G {this} C::E {} C::F {}
2669                }
2670            }
2671        } message
2672        lappend ::result $message
2673
2674        set ::result
2675    }]
2676    interp delete $interpreter
2677    set result
2678} [list\
2679    {bad class ::c constructor declaration, a base class, contructor arguments or body may be missing}\
2680    {bad class ::C constructor declaration, a base class, contructor arguments or body may be missing}\
2681    {bad class ::d::g constructor declaration, a base class, contructor arguments or body may be missing}\
2682    {bad class ::C::G constructor declaration, a base class, contructor arguments or body may be missing}\
2683]
2684
2685test stooop-33 {
2686    check that base class of class with multiple base classes is defined
2687} {
2688    set interpreter [interp create]
2689    $interpreter eval "source $source; namespace import stooop::*"
2690    set result [$interpreter eval {
2691        catch {
2692            class a {}
2693            proc a::a {this} {}
2694            class b {}
2695            class c {}
2696            proc c::c {this} a {} b {} {}
2697        } message
2698        lappend ::result $message
2699
2700        catch {
2701            class A {
2702                proc A {this} {}
2703            }
2704            class B {}
2705            class C {
2706                proc C {this} A {} B {} {}
2707            }
2708        } message
2709        lappend ::result $message
2710
2711        catch {
2712            class d {}
2713            class d::e {}
2714            proc d::e::e {this} {}
2715            class d::f {}
2716            class d::g {}
2717            proc d::g::g {this} d::e {} d::f {} {}
2718        } message
2719        lappend ::result $message
2720
2721        catch {
2722            class C {
2723                class E {
2724                    proc E {this} {}
2725                }
2726                class F {}
2727                class G {
2728                    proc G {this} C::E {} C::F {} {}
2729                }
2730            }
2731        } message
2732        lappend ::result $message
2733
2734        set ::result
2735    }]
2736    interp delete $interpreter
2737    set result
2738} [list\
2739    {class ::c constructor defined before base class b constructor}\
2740    {class ::C constructor defined before base class B constructor}\
2741    {class ::d::g constructor defined before base class d::f constructor}\
2742    {class ::C::G constructor defined before base class C::F constructor}\
2743]
2744
2745test stooop-34 {
2746    check that a direct base class is not specified more than once in a class
2747    constructor declaration
2748} {
2749    set interpreter [interp create]
2750    $interpreter eval "source $source; namespace import stooop::*"
2751    set result [$interpreter eval {
2752        catch {
2753            class a {}
2754            proc a::a {this} {}
2755            class c {}
2756            proc c::c {this} a {} a {} {}
2757        } message
2758        lappend ::result $message
2759
2760        catch {
2761            class A {
2762                proc A {this} {}
2763            }
2764            class C {
2765                proc C {this} A {} A {} {}
2766            }
2767        } message
2768        lappend ::result $message
2769
2770        catch {
2771            class d {}
2772            class d::e {}
2773            proc d::e::e {this} {}
2774            class d::g {}
2775            proc d::g::g {this} d::e {} d::e {} {}
2776        } message
2777        lappend ::result $message
2778
2779        catch {
2780            class D {
2781                class E {
2782                    proc E {this} {}
2783                }
2784                class G {
2785                    proc G {this} D::E {} D::E {} {}
2786                }
2787            }
2788        } message
2789        lappend ::result $message
2790
2791        set ::result
2792    }]
2793    interp delete $interpreter
2794    set result
2795} [list\
2796    {class ::c directly inherits from class ::a more than once}\
2797    {class ::C directly inherits from class ::A more than once}\
2798    {class ::d::g directly inherits from class ::d::e more than once}\
2799    {class ::D::G directly inherits from class ::D::E more than once}\
2800]
2801
2802test stooop-35 {
2803    check that class constructor with multiple base classes allows new lines
2804    within base class constructors arguments
2805} {
2806    set interpreter [interp create]
2807    $interpreter eval "source $source; namespace import stooop::*"
2808    $interpreter eval $dumpArraysCode
2809    set result [$interpreter eval {
2810        class a {}
2811        proc a::a {this p} {
2812            lappend ::result "a::a $this"
2813            set ($this,m) $p
2814        }
2815        proc a::~a {this} {
2816            lappend ::result "a::~a $this"
2817        }
2818        class b {}
2819        proc b::b {this p} {
2820            lappend ::result "b::b $this"
2821            set ($this,n) $p
2822        }
2823        proc b::~b {this} {
2824            lappend ::result "b::~b $this"
2825        }
2826        class c {}
2827        proc c::c {this p q r} a {
2828            $p
2829        } b {
2830            $q
2831        } {
2832            lappend ::result "c::c $this"
2833            set ($this,o) $r
2834        }
2835        proc c::~c {this} {
2836            lappend ::result "c::~c $this"
2837        }
2838        new c {x y} z {1 2}
2839        eval lappend ::result [dumpArrays a:: b:: c::]
2840
2841        class A {
2842            proc A {this p} {
2843                lappend ::result "A::A $this"
2844                set ($this,m) $p
2845            }
2846            proc ~A {this} {
2847                lappend ::result "A::~A $this"
2848            }
2849        }
2850        class B {
2851            proc B {this p} {
2852                lappend ::result "B::B $this"
2853                set ($this,n) $p
2854            }
2855            proc ~B {this} {
2856                lappend ::result "B::~B $this"
2857            }
2858        }
2859        class C {
2860            proc C {this p q r} A {
2861                $p
2862            } B {
2863                $q
2864            } {
2865                lappend ::result "C::C $this"
2866                set ($this,o) $r
2867            }
2868            proc ~C {this} {
2869                lappend ::result "C::~C $this"
2870            }
2871        }
2872        new C {x y} z {1 2}
2873        eval lappend ::result [dumpArrays A:: B:: C::]
2874
2875        class d {}
2876        class d::e {}
2877        proc d::e::e {this p} {
2878            lappend ::result "e::e $this"
2879            set ($this,m) $p
2880        }
2881        proc d::e::~e {this} {
2882            lappend ::result "e::~e $this"
2883        }
2884        class d::f {}
2885        proc d::f::f {this p} {
2886            lappend ::result "f::f $this"
2887            set ($this,n) $p
2888        }
2889        proc d::f::~f {this} {
2890            lappend ::result "f::~f $this"
2891        }
2892        class d::g {}
2893        proc d::g::g {this p q r} d::e {
2894            $p
2895        } d::f {
2896            $q
2897        } {
2898            lappend ::result "g::g $this"
2899            set ($this,o) $r
2900        }
2901        proc d::g::~g {this} {
2902            lappend ::result "g::~g $this"
2903        }
2904        new d::g {x y} z {1 2}
2905        eval lappend ::result [dumpArrays d::e:: d::f:: d::g::]
2906
2907        class D {
2908            class E {
2909                proc E {this p} {
2910                    lappend ::result "E::E $this"
2911                    set ($this,m) $p
2912                }
2913                proc ~E {this} {
2914                    lappend ::result "E::~E $this"
2915                }
2916            }
2917            class F {
2918                proc F {this p} {
2919                    lappend ::result "F::F $this"
2920                    set ($this,n) $p
2921                }
2922                proc ~F {this} {
2923                    lappend ::result "F::~F $this"
2924                }
2925            }
2926            class G {
2927                proc G {this p q r} D::E {
2928                    $p
2929                } D::F {
2930                    $q
2931                } {
2932                    lappend ::result "G::G $this"
2933                    set ($this,o) $r
2934                }
2935                proc ~G {this} {
2936                    lappend ::result "G::~G $this"
2937                }
2938            }
2939            new G {x y} z {1 2}
2940            eval lappend ::result [dumpArrays E:: F:: G::]
2941        }
2942        new D::G {x y} z {1 2}
2943        eval lappend ::result [dumpArrays D::E:: D::F:: D::G::]
2944
2945        set ::result
2946    }]
2947    interp delete $interpreter
2948    set result
2949} [list\
2950    {a::a 1}\
2951    {b::b 1}\
2952    {c::c 1}\
2953    {a::(1,_derived) = ::c}\
2954    {a::(1,m) = x y}\
2955    {b::(1,_derived) = ::c}\
2956    {b::(1,n) = z}\
2957    {c::(1,o) = 1 2}\
2958    {A::A 2}\
2959    {B::B 2}\
2960    {C::C 2}\
2961    {A::(2,_derived) = ::C}\
2962    {A::(2,m) = x y}\
2963    {B::(2,_derived) = ::C}\
2964    {B::(2,n) = z}\
2965    {C::(2,o) = 1 2}\
2966    {e::e 3}\
2967    {f::f 3}\
2968    {g::g 3}\
2969    {d::e::(3,_derived) = ::d::g}\
2970    {d::e::(3,m) = x y}\
2971    {d::f::(3,_derived) = ::d::g}\
2972    {d::f::(3,n) = z}\
2973    {d::g::(3,o) = 1 2}\
2974    {E::E 4}\
2975    {F::F 4}\
2976    {G::G 4}\
2977    {E::(4,_derived) = ::D::G}\
2978    {E::(4,m) = x y}\
2979    {F::(4,_derived) = ::D::G}\
2980    {F::(4,n) = z}\
2981    {G::(4,o) = 1 2}\
2982    {E::E 5}\
2983    {F::F 5}\
2984    {G::G 5}\
2985    {D::E::(4,_derived) = ::D::G}\
2986    {D::E::(4,m) = x y}\
2987    {D::E::(5,_derived) = ::D::G}\
2988    {D::E::(5,m) = x y}\
2989    {D::F::(4,_derived) = ::D::G}\
2990    {D::F::(4,n) = z}\
2991    {D::F::(5,_derived) = ::D::G}\
2992    {D::F::(5,n) = z}\
2993    {D::G::(4,o) = 1 2}\
2994    {D::G::(5,o) = 1 2}\
2995]
2996
2997test stooop-36 {
2998    check multiple inheritance construction order, destruction order and data
2999    deallocation with a common indirect base class
3000    (see test 71 for nested class version)
3001} {
3002    set interpreter [interp create]
3003    $interpreter eval "source $source; namespace import stooop::*"
3004    $interpreter eval $dumpArraysCode
3005    set result [$interpreter eval {
3006        class a {}
3007        proc a::a {this p} {
3008            lappend ::result "a::a $this"
3009            set ($this,m) $p
3010        }
3011        proc a::~a {this} {
3012            lappend ::result "a::~a $this"
3013        }
3014        class b {}
3015        proc b::b {this p} {
3016            lappend ::result "b::b $this"
3017            set ($this,n) $p
3018        }
3019        proc b::~b {this} {
3020            lappend ::result "b::~b $this"
3021        }
3022        class c {}
3023        proc c::c {this p q r} a {$p} b {$q} {
3024            lappend ::result "c::c $this"
3025            set ($this,o) $r
3026        }
3027        proc c::~c {this} {
3028            lappend ::result "c::~c $this"
3029        }
3030        class d {}
3031        proc d::d {this p q r} a {$p} b {$q} {
3032            lappend ::result "d::d $this"
3033            set ($this,p) $p
3034        }
3035        proc d::~d {this} {
3036            lappend ::result "d::~d $this"
3037        }
3038        class e {}
3039        proc e::e {this p q r} c {$p $q $r} d {$q $q $r} {
3040            lappend ::result "e::e $this"
3041            set ($this,q) $q
3042        }
3043        proc e::~e {this} {
3044            lappend ::result "e::~e $this"
3045        }
3046        set o [new e {x y} z {1 2}]
3047        eval lappend ::result [dumpArrays a:: b:: c:: d:: e::]
3048        delete $o
3049        eval lappend ::result [dumpArrays a:: b:: c:: d:: e::]
3050
3051        class A {
3052            proc A {this p} {
3053                lappend ::result "A::A $this"
3054                set ($this,m) $p
3055            }
3056            proc ~A {this} {
3057                lappend ::result "A::~A $this"
3058            }
3059        }
3060        class B {
3061            proc B {this p} {
3062                lappend ::result "B::B $this"
3063                set ($this,n) $p
3064            }
3065            proc ~B {this} {
3066                lappend ::result "B::~B $this"
3067            }
3068        }
3069        class C {
3070            proc C {this p q r} A {$p} B {$q} {
3071                lappend ::result "C::C $this"
3072                set ($this,o) $r
3073            }
3074            proc ~C {this} {
3075                lappend ::result "C::~C $this"
3076            }
3077        }
3078        class D {
3079            proc D {this p q r} A {$p} B {$q} {
3080                lappend ::result "D::D $this"
3081                set ($this,p) $p
3082            }
3083            proc ~D {this} {
3084                lappend ::result "D::~D $this"
3085            }
3086        }
3087        class E {
3088            proc E {this p q r} C {$p $q $r} D {$q $q $r} {
3089                lappend ::result "E::E $this"
3090                set ($this,q) $q
3091            }
3092            proc ~E {this} {
3093                lappend ::result "E::~E $this"
3094            }
3095        }
3096        set o [new E {x y} z {1 2}]
3097        eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
3098        delete $o
3099        eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
3100
3101        set ::result
3102    }]
3103    interp delete $interpreter
3104    set result
3105} [list\
3106    {a::a 1}\
3107    {b::b 1}\
3108    {c::c 1}\
3109    {a::a 1}\
3110    {b::b 1}\
3111    {d::d 1}\
3112    {e::e 1}\
3113    {a::(1,_derived) = ::d}\
3114    {a::(1,m) = z}\
3115    {b::(1,_derived) = ::d}\
3116    {b::(1,n) = z}\
3117    {c::(1,_derived) = ::e}\
3118    {c::(1,o) = 1 2}\
3119    {d::(1,_derived) = ::e}\
3120    {d::(1,p) = z}\
3121    {e::(1,q) = z}\
3122    {e::~e 1}\
3123    {d::~d 1}\
3124    {b::~b 1}\
3125    {a::~a 1}\
3126    {c::~c 1}\
3127    {b::~b 1}\
3128    {a::~a 1}\
3129    {A::A 2}\
3130    {B::B 2}\
3131    {C::C 2}\
3132    {A::A 2}\
3133    {B::B 2}\
3134    {D::D 2}\
3135    {E::E 2}\
3136    {A::(2,_derived) = ::D}\
3137    {A::(2,m) = z}\
3138    {B::(2,_derived) = ::D}\
3139    {B::(2,n) = z}\
3140    {C::(2,_derived) = ::E}\
3141    {C::(2,o) = 1 2}\
3142    {D::(2,_derived) = ::E}\
3143    {D::(2,p) = z}\
3144    {E::(2,q) = z}\
3145    {E::~E 2}\
3146    {D::~D 2}\
3147    {B::~B 2}\
3148    {A::~A 2}\
3149    {C::~C 2}\
3150    {B::~B 2}\
3151    {A::~A 2}\
3152]
3153
3154test stooop-37 {
3155    check that multiply inherited base classes constructors work with variable
3156    number of arguments (see test 72 for nested class version)
3157} {
3158    set interpreter [interp create]
3159    $interpreter eval "source $source; namespace import stooop::*"
3160    $interpreter eval $dumpArraysCode
3161    set result [$interpreter eval {
3162        class a {}
3163        proc a::a {this args} {
3164            lappend ::result "a::a $this $args"
3165            set ($this,m) [lindex $args 0]
3166        }
3167        class b {}
3168        proc b::b {this p} {
3169            lappend ::result "b::b $this $p"
3170            set ($this,n) $p
3171        }
3172        class c {}
3173        proc c::c {this p args} {
3174            lappend ::result "c::c $this $p $args"
3175            set ($this,o) $p
3176            set ($this,p) [lindex $args 0]
3177        }
3178        class d {}
3179        proc d::d {this p args} a {$args} b {$p} c {$p $args} {
3180            lappend ::result "d::d $this $p $args"
3181            set ($this,q) $p
3182            set ($this,r) [lindex $args 0]
3183        }
3184        new d {x y} {1 2} 3
3185        eval lappend ::result [dumpArrays a:: b:: c:: d::]
3186
3187        class A {
3188            proc A {this args} {
3189                lappend ::result "A::A $this $args"
3190                set ($this,m) [lindex $args 0]
3191            }
3192        }
3193        class B {
3194            proc B {this p} {
3195                lappend ::result "B::B $this $p"
3196                set ($this,n) $p
3197            }
3198        }
3199        class C {
3200            proc C {this p args} {
3201                lappend ::result "C::C $this $p $args"
3202                set ($this,o) $p
3203                set ($this,p) [lindex $args 0]
3204            }
3205        }
3206        class D {
3207            proc D {this p args} A {$args} B {$p} C {$p $args} {
3208                lappend ::result "D::D $this $p $args"
3209                set ($this,q) $p
3210                set ($this,r) [lindex $args 0]
3211            }
3212        }
3213        new D {x y} {1 2} 3
3214        eval lappend ::result [dumpArrays A:: B:: C:: D::]
3215
3216        set ::result
3217    }]
3218    interp delete $interpreter
3219    set result
3220} [list\
3221    {a::a 1 {1 2} 3}\
3222    {b::b 1 x y}\
3223    {c::c 1 x y {1 2} 3}\
3224    {d::d 1 x y {1 2} 3}\
3225    {a::(1,_derived) = ::d}\
3226    {a::(1,m) = 1 2}\
3227    {b::(1,_derived) = ::d}\
3228    {b::(1,n) = x y}\
3229    {c::(1,_derived) = ::d}\
3230    {c::(1,o) = x y}\
3231    {c::(1,p) = 1 2}\
3232    {d::(1,q) = x y}\
3233    {d::(1,r) = 1 2}\
3234    {A::A 2 {1 2} 3}\
3235    {B::B 2 x y}\
3236    {C::C 2 x y {1 2} 3}\
3237    {D::D 2 x y {1 2} 3}\
3238    {A::(2,_derived) = ::D}\
3239    {A::(2,m) = 1 2}\
3240    {B::(2,_derived) = ::D}\
3241    {B::(2,n) = x y}\
3242    {C::(2,_derived) = ::D}\
3243    {C::(2,o) = x y}\
3244    {C::(2,p) = 1 2}\
3245    {D::(2,q) = x y}\
3246    {D::(2,r) = 1 2}\
3247]
3248
3249test stooop-38 {
3250    check multiple inheritance destruction order and data deallocation with a
3251    common indirect base class (see test 73 for nested class version)
3252} {
3253    set interpreter [interp create]
3254    $interpreter eval "source $source; namespace import stooop::*"
3255    $interpreter eval $dumpArraysCode
3256    set result [$interpreter eval {
3257        class a {}
3258        proc a::a {this p} {
3259            lappend ::result "a::a $this"
3260            set ($this,m) $p
3261        }
3262        proc a::~a {this} {
3263            lappend ::result "a::~a $this"
3264        }
3265        class b {}
3266        proc b::b {this p} {
3267            lappend ::result "b::b $this"
3268            set ($this,n) $p
3269        }
3270        proc b::~b {this} {
3271            lappend ::result "b::~b $this"
3272        }
3273        class c {}
3274        proc c::c {this p q r} a {$p} b {$q} {
3275            lappend ::result "c::c $this"
3276            set ($this,o) $r
3277        }
3278        proc c::~c {this} {
3279            lappend ::result "c::~c $this"
3280        }
3281        class d {}
3282        proc d::d {this p q r} a {$p} b {$q} {
3283            lappend ::result "d::d $this"
3284            set ($this,p) $p
3285        }
3286        proc d::~d {this} {
3287            lappend ::result "d::~d $this"
3288        }
3289        class e {}
3290        proc e::e {this p q r} c {$p $q $r} d {$q $q $r} {
3291            lappend ::result "e::e $this"
3292            set ($this,q) $q
3293        }
3294        proc e::~e {this} {
3295            lappend ::result "e::~e $this"
3296        }
3297        set o [new e {x y} z {1 2}]
3298        eval lappend ::result [dumpArrays a:: b:: c:: d:: e::]
3299        delete $o
3300        eval lappend ::result [dumpArrays a:: b:: c:: d:: e::]
3301
3302        class A {
3303            proc A {this p} {
3304                lappend ::result "A::A $this"
3305                set ($this,m) $p
3306            }
3307            proc ~A {this} {
3308                lappend ::result "A::~A $this"
3309            }
3310        }
3311        class B {
3312            proc B {this p} {
3313                lappend ::result "B::B $this"
3314                set ($this,n) $p
3315            }
3316            proc ~B {this} {
3317                lappend ::result "B::~B $this"
3318            }
3319        }
3320        class C {
3321            proc C {this p q r} A {$p} B {$q} {
3322                lappend ::result "C::C $this"
3323                set ($this,o) $r
3324            }
3325            proc ~C {this} {
3326                lappend ::result "C::~C $this"
3327            }
3328        }
3329        class D {
3330            proc D {this p q r} A {$p} B {$q} {
3331                lappend ::result "D::D $this"
3332                set ($this,p) $p
3333            }
3334            proc ~D {this} {
3335                lappend ::result "D::~D $this"
3336            }
3337        }
3338        class E {
3339            proc E {this p q r} C {$p $q $r} D {$q $q $r} {
3340                lappend ::result "E::E $this"
3341                set ($this,q) $q
3342            }
3343            proc ~E {this} {
3344                lappend ::result "E::~E $this"
3345            }
3346        }
3347        set o [new E {x y} z {1 2}]
3348        eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
3349        delete $o
3350        eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
3351
3352        set ::result
3353    }]
3354    interp delete $interpreter
3355    set result
3356} [list\
3357    {a::a 1}\
3358    {b::b 1}\
3359    {c::c 1}\
3360    {a::a 1}\
3361    {b::b 1}\
3362    {d::d 1}\
3363    {e::e 1}\
3364    {a::(1,_derived) = ::d}\
3365    {a::(1,m) = z}\
3366    {b::(1,_derived) = ::d}\
3367    {b::(1,n) = z}\
3368    {c::(1,_derived) = ::e}\
3369    {c::(1,o) = 1 2}\
3370    {d::(1,_derived) = ::e}\
3371    {d::(1,p) = z}\
3372    {e::(1,q) = z}\
3373    {e::~e 1}\
3374    {d::~d 1}\
3375    {b::~b 1}\
3376    {a::~a 1}\
3377    {c::~c 1}\
3378    {b::~b 1}\
3379    {a::~a 1}\
3380    {A::A 2}\
3381    {B::B 2}\
3382    {C::C 2}\
3383    {A::A 2}\
3384    {B::B 2}\
3385    {D::D 2}\
3386    {E::E 2}\
3387    {A::(2,_derived) = ::D}\
3388    {A::(2,m) = z}\
3389    {B::(2,_derived) = ::D}\
3390    {B::(2,n) = z}\
3391    {C::(2,_derived) = ::E}\
3392    {C::(2,o) = 1 2}\
3393    {D::(2,_derived) = ::E}\
3394    {D::(2,p) = z}\
3395    {E::(2,q) = z}\
3396    {E::~E 2}\
3397    {D::~D 2}\
3398    {B::~B 2}\
3399    {A::~A 2}\
3400    {C::~C 2}\
3401    {B::~B 2}\
3402    {A::~A 2}\
3403]
3404
3405test stooop-39 {
3406    check that optional arguments in constructors and multiple inheritance work
3407    together (see test 74 for nested class version)
3408} {
3409    set interpreter [interp create]
3410    $interpreter eval "source $source; namespace import stooop::*"
3411    $interpreter eval $dumpArraysCode
3412    set result [$interpreter eval {
3413        class a {}
3414        proc a::a {this {p 0}} {
3415            lappend ::result "a::a $this"
3416            set ($this,m) $p
3417        }
3418        proc a::~a {this} {
3419            lappend ::result "a::~a $this"
3420        }
3421        class b {}
3422        proc b::b {this {p 1}} {
3423            lappend ::result "b::b $this"
3424            set ($this,n) $p
3425        }
3426        proc b::~b {this} {
3427            lappend ::result "b::~b $this"
3428        }
3429        class c {}
3430        proc c::c {this {p 2} {q 3}} a {$p} b {$q} {
3431            lappend ::result "c::c $this"
3432            set ($this,o) $p
3433            set ($this,p) $q
3434        }
3435        proc c::~c {this} {
3436            lappend ::result "c::~c $this"
3437        }
3438        set o [new c {x y} z]
3439        eval lappend ::result [dumpArrays a:: b:: c::]
3440        delete $o
3441        set o [new c]
3442        eval lappend ::result [dumpArrays a:: b:: c::]
3443
3444        class A {
3445            proc A {this {p 0}} {
3446                lappend ::result "A::A $this"
3447                set ($this,m) $p
3448            }
3449            proc ~A {this} {
3450                lappend ::result "A::~A $this"
3451            }
3452        }
3453        class B {
3454            proc B {this {p 1}} {
3455                lappend ::result "B::B $this"
3456                set ($this,n) $p
3457            }
3458            proc ~B {this} {
3459                lappend ::result "B::~B $this"
3460            }
3461        }
3462        class C {
3463            proc C {this {p 2} {q 3}} A {$p} B {$q} {
3464                lappend ::result "C::C $this"
3465                set ($this,o) $p
3466                set ($this,p) $q
3467            }
3468            proc ~C {this} {
3469                lappend ::result "C::~C $this"
3470            }
3471        }
3472        set o [new C {x y} z]
3473        eval lappend ::result [dumpArrays A:: B:: C::]
3474        delete $o
3475        set o [new C]
3476        eval lappend ::result [dumpArrays A:: B:: C::]
3477
3478        set ::result
3479    }]
3480    interp delete $interpreter
3481    set result
3482} [list\
3483    {a::a 1}\
3484    {b::b 1}\
3485    {c::c 1}\
3486    {a::(1,_derived) = ::c}\
3487    {a::(1,m) = x y}\
3488    {b::(1,_derived) = ::c}\
3489    {b::(1,n) = z}\
3490    {c::(1,o) = x y}\
3491    {c::(1,p) = z}\
3492    {c::~c 1}\
3493    {b::~b 1}\
3494    {a::~a 1}\
3495    {a::a 2}\
3496    {b::b 2}\
3497    {c::c 2}\
3498    {a::(2,_derived) = ::c}\
3499    {a::(2,m) = 2}\
3500    {b::(2,_derived) = ::c}\
3501    {b::(2,n) = 3}\
3502    {c::(2,o) = 2}\
3503    {c::(2,p) = 3}\
3504    {A::A 3}\
3505    {B::B 3}\
3506    {C::C 3}\
3507    {A::(3,_derived) = ::C}\
3508    {A::(3,m) = x y}\
3509    {B::(3,_derived) = ::C}\
3510    {B::(3,n) = z}\
3511    {C::(3,o) = x y}\
3512    {C::(3,p) = z}\
3513    {C::~C 3}\
3514    {B::~B 3}\
3515    {A::~A 3}\
3516    {A::A 4}\
3517    {B::B 4}\
3518    {C::C 4}\
3519    {A::(4,_derived) = ::C}\
3520    {A::(4,m) = 2}\
3521    {B::(4,_derived) = ::C}\
3522    {B::(4,n) = 3}\
3523    {C::(4,o) = 2}\
3524    {C::(4,p) = 3}\
3525]
3526
3527test stooop-40 {
3528    check various virtual procedures configurations in a 3 level deep class
3529    hierarchy (see test 75 for nested class version)
3530} {
3531    set interpreter [interp create]
3532    $interpreter eval "source $source; namespace import stooop::*"
3533    set result [$interpreter eval {
3534        class a {}
3535        proc a::a {this} {}
3536        proc a::~a {this} {}
3537        virtual proc a::f {this p q} {}
3538        virtual proc a::g {this p q}
3539        virtual proc a::h {this p q} {
3540            lappend ::result "a::h $this $p $q"
3541        }
3542        virtual proc a::i {this p q} {
3543            lappend ::result "a::i $this $p $q"
3544        }
3545        virtual proc a::k {this p q}
3546        virtual proc a::l {this p q} {
3547            lappend ::result "a::l $this $p $q"
3548        }
3549        class b {}
3550        proc b::b {this} a {} {}
3551        proc b::~b {this} {}
3552        virtual proc b::f {this p q} {
3553            lappend ::result "b::f $this $p $q"
3554        }
3555        virtual proc b::g {this p q}
3556        virtual proc b::h {this p q} {
3557            lappend ::result "b::h $this $p $q"
3558        }
3559        proc b::i {this p q} {
3560            lappend ::result "b::i $this $p $q"
3561        }
3562        virtual proc b::k {this p q} {
3563            lappend ::result "b::k $this $p $q"
3564        }
3565        virtual proc b::l {this p q}
3566        class c {}
3567        proc c::c {this} b {} {}
3568        proc c::~c {this} {}
3569        proc c::f {this p q} {
3570            lappend ::result "c::f $this $p $q"
3571        }
3572        proc c::g {this p q} {
3573            lappend ::result "c::g $this $p $q"
3574        }
3575        proc c::i {this p q} {
3576            lappend ::result "c::i $this $p $q"
3577        }
3578        proc c::k {this p q} {
3579            lappend ::result "c::k $this $p $q"
3580        }
3581        proc c::l {this p q} {
3582            lappend ::result "c::l $this $p $q"
3583        }
3584        set o [new c]
3585        a::f $o x {y z}
3586        a::g $o x {y z}
3587        a::h $o x {y z}
3588        a::i $o x {y z}
3589        a::k $o x {y z}
3590        a::l $o x {y z}
3591
3592        class A {
3593            proc A {this} {}
3594            proc ~A {this} {}
3595            virtual proc f {this p q} {}
3596            virtual proc g {this p q}
3597            virtual proc h {this p q} {
3598                lappend ::result "A::h $this $p $q"
3599            }
3600            virtual proc i {this p q} {
3601                lappend ::result "A::i $this $p $q"
3602            }
3603            virtual proc k {this p q}
3604            virtual proc l {this p q} {
3605                lappend ::result "A::l $this $p $q"
3606            }
3607        }
3608        class B {
3609            proc B {this} A {} {}
3610            proc ~B {this} {}
3611            virtual proc f {this p q} {
3612                lappend ::result "B::f $this $p $q"
3613            }
3614            virtual proc g {this p q}
3615            virtual proc h {this p q} {
3616                lappend ::result "B::h $this $p $q"
3617            }
3618            proc i {this p q} {
3619                lappend ::result "B::i $this $p $q"
3620            }
3621            virtual proc k {this p q} {
3622                lappend ::result "B::k $this $p $q"
3623            }
3624            virtual proc l {this p q}
3625        }
3626        class C {
3627            proc C {this} B {} {}
3628            proc ~C {this} {}
3629            proc f {this p q} {
3630                lappend ::result "C::f $this $p $q"
3631            }
3632            proc g {this p q} {
3633                lappend ::result "C::g $this $p $q"
3634            }
3635            proc i {this p q} {
3636                lappend ::result "C::i $this $p $q"
3637            }
3638            proc k {this p q} {
3639                lappend ::result "C::k $this $p $q"
3640            }
3641            proc l {this p q} {
3642                lappend ::result "C::l $this $p $q"
3643            }
3644        }
3645        set o [new C]
3646        A::f $o x {y z}
3647        A::g $o x {y z}
3648        A::h $o x {y z}
3649        A::i $o x {y z}
3650        A::k $o x {y z}
3651        A::l $o x {y z}
3652
3653        set ::result
3654    }]
3655    interp delete $interpreter
3656    set result
3657} [list\
3658    {c::f 1 x y z}\
3659    {c::g 1 x y z}\
3660    {b::h 1 x y z}\
3661    {b::i 1 x y z}\
3662    {c::k 1 x y z}\
3663    {c::l 1 x y z}\
3664    {C::f 2 x y z}\
3665    {C::g 2 x y z}\
3666    {B::h 2 x y z}\
3667    {B::i 2 x y z}\
3668    {C::k 2 x y z}\
3669    {C::l 2 x y z}\
3670]
3671
3672test stooop-41 {
3673    check various virtual procedures with variable number of arguments
3674    configurations in a 3 level deep class hierarchy
3675    (see 76.tcl for nested class version)
3676} {
3677    set interpreter [interp create]
3678    $interpreter eval "source $source; namespace import stooop::*"
3679    set result [$interpreter eval {
3680        class a {}
3681        proc a::a {this} {}
3682        proc a::~a {this} {}
3683        virtual proc a::f {this p args} {}
3684        virtual proc a::g {this p args}
3685        virtual proc a::h {this p args} {
3686            lappend ::result "a::h $this $p $args"
3687        }
3688        virtual proc a::i {this p args} {
3689            lappend ::result "a::i $this $p $args"
3690        }
3691        virtual proc a::k {this p args}
3692        virtual proc a::l {this p args} {
3693            lappend ::result "a::l $this $p $args"
3694        }
3695        class b {}
3696        proc b::b {this} a {} {}
3697        proc b::~b {this} {}
3698        virtual proc b::f {this p args} {
3699            lappend ::result "b::f $this $p $args"
3700        }
3701        virtual proc b::g {this p args}
3702        virtual proc b::h {this p args} {
3703            lappend ::result "b::h $this $p $args"
3704        }
3705        proc b::i {this p args} {
3706            lappend ::result "b::i $this $p $args"
3707        }
3708        virtual proc b::k {this p args} {
3709            lappend ::result "b::k $this $p $args"
3710        }
3711        virtual proc b::l {this p args}
3712        class c {}
3713        proc c::c {this} b {} {}
3714        proc c::~c {this} {}
3715        proc c::f {this p args} {
3716            lappend ::result "c::f $this $p $args"
3717        }
3718        proc c::g {this p args} {
3719            lappend ::result "c::g $this $p $args"
3720        }
3721        proc c::i {this p args} {
3722            lappend ::result "c::i $this $p $args"
3723        }
3724        proc c::k {this p args} {
3725            lappend ::result "c::k $this $p $args"
3726        }
3727        proc c::l {this p args} {
3728            lappend ::result "c::l $this $p $args"
3729        }
3730        set o [new c]
3731        a::f $o x {y z}
3732        a::g $o x {y z}
3733        a::h $o x {y z}
3734        a::i $o x {y z}
3735        a::k $o x {y z}
3736        a::l $o x {y z}
3737
3738        class A {
3739            proc A {this} {}
3740            proc ~A {this} {}
3741            virtual proc f {this p args} {}
3742            virtual proc g {this p args}
3743            virtual proc h {this p args} {
3744                lappend ::result "A::h $this $p $args"
3745            }
3746            virtual proc i {this p args} {
3747                lappend ::result "A::i $this $p $args"
3748            }
3749            virtual proc k {this p args}
3750            virtual proc l {this p args} {
3751                lappend ::result "A::l $this $p $args"
3752            }
3753        }
3754        class B {
3755            proc B {this} A {} {}
3756            proc ~B {this} {}
3757            virtual proc f {this p args} {
3758                lappend ::result "B::f $this $p $args"
3759            }
3760            virtual proc g {this p args}
3761            virtual proc h {this p args} {
3762                lappend ::result "B::h $this $p $args"
3763            }
3764            proc i {this p args} {
3765                lappend ::result "B::i $this $p $args"
3766            }
3767            virtual proc k {this p args} {
3768                lappend ::result "B::k $this $p $args"
3769            }
3770            virtual proc l {this p args}
3771        }
3772        class C {
3773            proc C {this} B {} {}
3774            proc ~C {this} {}
3775            proc f {this p args} {
3776                lappend ::result "C::f $this $p $args"
3777            }
3778            proc g {this p args} {
3779                lappend ::result "C::g $this $p $args"
3780            }
3781            proc i {this p args} {
3782                lappend ::result "C::i $this $p $args"
3783            }
3784            proc k {this p args} {
3785                lappend ::result "C::k $this $p $args"
3786            }
3787            proc l {this p args} {
3788                lappend ::result "C::l $this $p $args"
3789            }
3790        }
3791        set o [new C]
3792        A::f $o x {y z}
3793        A::g $o x {y z}
3794        A::h $o x {y z}
3795        A::i $o x {y z}
3796        A::k $o x {y z}
3797        A::l $o x {y z}
3798
3799        set ::result
3800    }]
3801    interp delete $interpreter
3802    set result
3803} [list\
3804    {c::f 1 x {y z}}\
3805    {c::g 1 x {y z}}\
3806    {b::h 1 x {y z}}\
3807    {b::i 1 x {y z}}\
3808    {c::k 1 x {y z}}\
3809    {c::l 1 x {y z}}\
3810    {C::f 2 x {y z}}\
3811    {C::g 2 x {y z}}\
3812    {B::h 2 x {y z}}\
3813    {B::i 2 x {y z}}\
3814    {C::k 2 x {y z}}\
3815    {C::l 2 x {y z}}\
3816]
3817
3818test stooop-42 {
3819    check basic cloning operation (see nested class version in test 70)
3820} {
3821    set interpreter [interp create]
3822    $interpreter eval "source $source; namespace import stooop::*"
3823    $interpreter eval $dumpArraysCode
3824    set result [$interpreter eval {
3825        class a {}
3826        proc a::a {this} {
3827            set ($this,x) 0
3828        }
3829        new [new a]
3830        eval lappend ::result [dumpArrays a::]
3831
3832        class A {
3833            proc A {this} {
3834                set ($this,x) 0
3835            }
3836        }
3837        new [new A]
3838        eval lappend ::result [dumpArrays A::]
3839
3840        set ::result
3841    }]
3842    interp delete $interpreter
3843    set result
3844} [list\
3845    {a::(1,x) = 0}\
3846    {a::(2,x) = 0}\
3847    {A::(3,x) = 0}\
3848    {A::(4,x) = 0}\
3849]
3850
3851test stooop-43 {
3852    check user defined cloning operation (see nested class version in test 69)
3853} {
3854    set interpreter [interp create]
3855    $interpreter eval "source $source; namespace import stooop::*"
3856    $interpreter eval $dumpArraysCode
3857    set result [$interpreter eval {
3858        class a {}
3859        proc a::a {this} {
3860            set ($this,x) 0
3861        }
3862        proc a::a {this copy} {
3863            set ($this,x) [expr $($copy,x)+1]
3864        }
3865        new [new a]
3866        eval lappend ::result [dumpArrays a::]
3867
3868        class A {
3869            proc A {this} {
3870                set ($this,x) 0
3871            }
3872            proc A {this copy} {
3873                set ($this,x) [expr $($copy,x)+1]
3874            }
3875        }
3876        new [new A]
3877        eval lappend ::result [dumpArrays A::]
3878
3879        set ::result
3880    }]
3881    interp delete $interpreter
3882    set result
3883} [list\
3884    {a::(1,x) = 0}\
3885    {a::(2,x) = 1}\
3886    {A::(3,x) = 0}\
3887    {A::(4,x) = 1}\
3888]
3889
3890test stooop-44 {
3891    check cloning operation in a 3 level deep class hierarchy
3892} {
3893    set interpreter [interp create]
3894    $interpreter eval "source $source; namespace import stooop::*"
3895    $interpreter eval $dumpArraysCode
3896    set result [$interpreter eval {
3897        class a {}
3898        proc a::a {this} {
3899            set ($this,x) 0
3900        }
3901        class b {}
3902        proc b::b {this} a {} {
3903            set ($this,y) 1
3904        }
3905        class c {}
3906        proc c::c {this} b {} {
3907            set ($this,z) 2
3908        }
3909        new [new c]
3910        eval lappend ::result [dumpArrays a:: b:: c::]
3911
3912        class A {
3913            proc A {this} {
3914                set ($this,x) 0
3915            }
3916        }
3917        class B {
3918            proc B {this} A {} {
3919                set ($this,y) 1
3920            }
3921        }
3922        class C {
3923            proc C {this} B {} {
3924                set ($this,z) 2
3925            }
3926        }
3927        new [new C]
3928        eval lappend ::result [dumpArrays A:: B:: C::]
3929
3930        class d {}
3931        class d::e {}
3932        proc d::e::e {this} {
3933            set ($this,x) 0
3934        }
3935        class d::f {}
3936        proc d::f::f {this} d::e {} {
3937            set ($this,y) 1
3938        }
3939        class d::g {}
3940        proc d::g::g {this} d::f {} {
3941            set ($this,z) 2
3942        }
3943        new [new d::g]
3944        eval lappend ::result [dumpArrays d::e:: d::f:: d::g::]
3945
3946        class D {
3947            class E {
3948                proc E {this} {
3949                    set ($this,x) 0
3950                }
3951            }
3952            class F {
3953                proc F {this} D::E {} {
3954                    set ($this,y) 1
3955                }
3956            }
3957            class G {
3958                proc G {this} D::F {} {
3959                    set ($this,z) 2
3960                }
3961            }
3962            new [new G]
3963            eval lappend ::result [dumpArrays E:: F:: G::]
3964        }
3965        new [new D::G]
3966        eval lappend ::result [dumpArrays D::E:: D::F:: D::G::]
3967
3968        set ::result
3969    }]
3970    interp delete $interpreter
3971    set result
3972} [list\
3973    {a::(1,_derived) = ::b}\
3974    {a::(1,x) = 0}\
3975    {a::(2,_derived) = ::b}\
3976    {a::(2,x) = 0}\
3977    {b::(1,_derived) = ::c}\
3978    {b::(1,y) = 1}\
3979    {b::(2,_derived) = ::c}\
3980    {b::(2,y) = 1}\
3981    {c::(1,z) = 2}\
3982    {c::(2,z) = 2}\
3983    {A::(3,_derived) = ::B}\
3984    {A::(3,x) = 0}\
3985    {A::(4,_derived) = ::B}\
3986    {A::(4,x) = 0}\
3987    {B::(3,_derived) = ::C}\
3988    {B::(3,y) = 1}\
3989    {B::(4,_derived) = ::C}\
3990    {B::(4,y) = 1}\
3991    {C::(3,z) = 2}\
3992    {C::(4,z) = 2}\
3993    {d::e::(5,_derived) = ::d::f}\
3994    {d::e::(5,x) = 0}\
3995    {d::e::(6,_derived) = ::d::f}\
3996    {d::e::(6,x) = 0}\
3997    {d::f::(5,_derived) = ::d::g}\
3998    {d::f::(5,y) = 1}\
3999    {d::f::(6,_derived) = ::d::g}\
4000    {d::f::(6,y) = 1}\
4001    {d::g::(5,z) = 2}\
4002    {d::g::(6,z) = 2}\
4003    {E::(7,_derived) = ::D::F}\
4004    {E::(7,x) = 0}\
4005    {E::(8,_derived) = ::D::F}\
4006    {E::(8,x) = 0}\
4007    {F::(7,_derived) = ::D::G}\
4008    {F::(7,y) = 1}\
4009    {F::(8,_derived) = ::D::G}\
4010    {F::(8,y) = 1}\
4011    {G::(7,z) = 2}\
4012    {G::(8,z) = 2}\
4013    {D::E::(10,_derived) = ::D::F}\
4014    {D::E::(10,x) = 0}\
4015    {D::E::(7,_derived) = ::D::F}\
4016    {D::E::(7,x) = 0}\
4017    {D::E::(8,_derived) = ::D::F}\
4018    {D::E::(8,x) = 0}\
4019    {D::E::(9,_derived) = ::D::F}\
4020    {D::E::(9,x) = 0}\
4021    {D::F::(10,_derived) = ::D::G}\
4022    {D::F::(10,y) = 1}\
4023    {D::F::(7,_derived) = ::D::G}\
4024    {D::F::(7,y) = 1}\
4025    {D::F::(8,_derived) = ::D::G}\
4026    {D::F::(8,y) = 1}\
4027    {D::F::(9,_derived) = ::D::G}\
4028    {D::F::(9,y) = 1}\
4029    {D::G::(10,z) = 2}\
4030    {D::G::(7,z) = 2}\
4031    {D::G::(8,z) = 2}\
4032    {D::G::(9,z) = 2}\
4033]
4034
4035test stooop-45 {
4036    check user defined cloning operation error checking
4037} {
4038    set interpreter [interp create]
4039    $interpreter eval "source $source; namespace import stooop::*"
4040    set result [$interpreter eval {
4041        catch {
4042            class a {}
4043            proc a::a {this} {
4044                set ($this,x) 0
4045            }
4046            proc a::a {destination source} {}
4047            new [new a]
4048        } message
4049        lappend ::result $message
4050
4051        catch {
4052            class A {
4053                proc A {this} {
4054                    set ($this,x) 0
4055                }
4056                proc A {destination source} {}
4057            }
4058            new [new A]
4059        } message
4060        lappend ::result $message
4061
4062        catch {
4063            class b {}
4064            class b::c {}
4065            proc b::c::c {this} {
4066                set ($this,x) 0
4067            }
4068            proc b::c::c {destination source} {}
4069            new [new b::c]
4070        } message
4071        lappend ::result $message
4072
4073        catch {
4074            class B {
4075                class C {
4076                    proc C {this} {
4077                        set ($this,x) 0
4078                    }
4079                    proc C {destination source} {}
4080                }
4081                new [new C]
4082            }
4083        } message
4084        lappend ::result $message
4085
4086        set ::result
4087    }]
4088    interp delete $interpreter
4089    set result
4090} [list\
4091    {class ::a constructor first argument must be this}\
4092    {class ::A constructor first argument must be this}\
4093    {class ::b::c constructor first argument must be this}\
4094    {class ::B::C constructor first argument must be this}\
4095]
4096
4097test stooop-46 {
4098    check user defined cloning operation error checking
4099} {
4100    set interpreter [interp create]
4101    $interpreter eval "source $source; namespace import stooop::*"
4102    set result [$interpreter eval {
4103        catch {
4104            class a {}
4105            proc a::a {this} {
4106                set ($this,x) 0
4107            }
4108            proc a::a {this copy dummy} {}
4109            new [new a]
4110        } message
4111        lappend ::result $message
4112
4113        catch {
4114            class A {
4115                proc A {this} {
4116                    set ($this,x) 0
4117                }
4118                proc A {this copy dummy} {}
4119            }
4120            new [new A]
4121        } message
4122        lappend ::result $message
4123
4124        catch {
4125            class b {}
4126            class b::c {}
4127            proc b::c::c {this} {
4128                set ($this,x) 0
4129            }
4130            proc b::c::c {this copy dummy} {}
4131            new [new b::c]
4132        } message
4133        lappend ::result $message
4134
4135        catch {
4136            class B {
4137                class C {
4138                    proc C {this} {
4139                        set ($this,x) 0
4140                    }
4141                    proc C {this copy dummy} {}
4142                }
4143                new [new C]
4144            }
4145        } message
4146        lappend ::result $message
4147
4148        set ::result
4149    }]
4150    interp delete $interpreter
4151    set result
4152} [list\
4153    {class ::a copy constructor must have 2 arguments exactly}\
4154    {class ::A copy constructor must have 2 arguments exactly}\
4155    {class ::b::c copy constructor must have 2 arguments exactly}\
4156    {class ::B::C copy constructor must have 2 arguments exactly}\
4157]
4158
4159test stooop-47 {
4160    check normal and user defined cloning operation with multiple inheritance
4161    and member objects (see test 77 for nested class version)
4162} {
4163    set interpreter [interp create]
4164    $interpreter eval "source $source; namespace import stooop::*"
4165    $interpreter eval $dumpArraysCode
4166    set result [$interpreter eval {
4167        class a {}
4168        proc a::a {this p} {
4169            set ($this,m) $p
4170        }
4171        class b {}
4172        proc b::b {this p} {
4173            set ($this,n) $p
4174        }
4175        class c {}
4176        proc c::c {this p q r} a {$p} b {$q} {
4177            set ($this,o) $r
4178            set ($this,O) [new f]
4179        }
4180        proc c::c {this copy} a {$a::($copy,m)} b 1 {
4181            set ($this,o) $($copy,o)
4182            set ($this,O) [new f]
4183        }
4184        class d {}
4185        proc d::d {this p q r} a {$p} b {$q} {
4186            set ($this,p) $p
4187        }
4188        class e {}
4189        proc e::e {this p q r} c {$p $q $r} d {$q $q $r} {
4190            set ($this,q) $q
4191        }
4192        class f {}
4193        proc f::f {this} {
4194            set ($this,x) 0
4195        }
4196        new [new e {x y} z {1 2}]
4197        eval lappend ::result [dumpArrays a:: b:: c:: d:: e:: f::]
4198
4199        class A {
4200            proc A {this p} {
4201                set ($this,m) $p
4202            }
4203        }
4204        class B {
4205            proc B {this p} {
4206                set ($this,n) $p
4207            }
4208        }
4209        class C {
4210            proc C {this p q r} A {$p} B {$q} {
4211                set ($this,o) $r
4212                set ($this,O) [new F]
4213            }
4214            proc C {this copy} A {$A::($copy,m)} B 1 {
4215                set ($this,o) $($copy,o)
4216                set ($this,O) [new F]
4217            }
4218        }
4219        class D {
4220            proc D {this p q r} A {$p} B {$q} {
4221                set ($this,p) $p
4222            }
4223        }
4224        class E {
4225            proc E {this p q r} C {$p $q $r} D {$q $q $r} {
4226                set ($this,q) $q
4227            }
4228        }
4229        class F {
4230            proc F {this} {
4231                set ($this,x) 0
4232            }
4233        }
4234        new [new E {x y} z {1 2}]
4235        eval lappend ::result [dumpArrays A:: B:: C:: D:: E:: F::]
4236
4237        set ::result
4238    }]
4239    interp delete $interpreter
4240    set result
4241} [list\
4242    {a::(1,_derived) = ::d}\
4243    {a::(1,m) = z}\
4244    {a::(3,_derived) = ::d}\
4245    {a::(3,m) = z}\
4246    {b::(1,_derived) = ::d}\
4247    {b::(1,n) = z}\
4248    {b::(3,_derived) = ::d}\
4249    {b::(3,n) = z}\
4250    {c::(1,O) = 2}\
4251    {c::(1,_derived) = ::e}\
4252    {c::(1,o) = 1 2}\
4253    {c::(3,O) = 4}\
4254    {c::(3,_derived) = ::e}\
4255    {c::(3,o) = 1 2}\
4256    {d::(1,_derived) = ::e}\
4257    {d::(1,p) = z}\
4258    {d::(3,_derived) = ::e}\
4259    {d::(3,p) = z}\
4260    {e::(1,q) = z}\
4261    {e::(3,q) = z}\
4262    {f::(2,x) = 0}\
4263    {f::(4,x) = 0}\
4264    {A::(5,_derived) = ::D}\
4265    {A::(5,m) = z}\
4266    {A::(7,_derived) = ::D}\
4267    {A::(7,m) = z}\
4268    {B::(5,_derived) = ::D}\
4269    {B::(5,n) = z}\
4270    {B::(7,_derived) = ::D}\
4271    {B::(7,n) = z}\
4272    {C::(5,O) = 6}\
4273    {C::(5,_derived) = ::E}\
4274    {C::(5,o) = 1 2}\
4275    {C::(7,O) = 8}\
4276    {C::(7,_derived) = ::E}\
4277    {C::(7,o) = 1 2}\
4278    {D::(5,_derived) = ::E}\
4279    {D::(5,p) = z}\
4280    {D::(7,_derived) = ::E}\
4281    {D::(7,p) = z}\
4282    {E::(5,q) = z}\
4283    {E::(7,q) = z}\
4284    {F::(6,x) = 0}\
4285    {F::(8,x) = 0}\
4286]
4287
4288test stooop-48 {
4289    check basic cloning operation with array members
4290} {
4291    set interpreter [interp create]
4292    $interpreter eval "source $source; namespace import stooop::*"
4293    $interpreter eval $dumpArraysCode
4294    set result [$interpreter eval {
4295        class a {}
4296        proc a::a {this} {
4297            variable ${this}x
4298            set ${this}x(0) 0
4299            set ($this,y) 1
4300        }
4301        proc a::a {this copy} {
4302            variable ${this}x
4303            variable ${copy}x
4304            array set ${this}x [array get ${copy}x]
4305            set ($this,y) $($copy,y)
4306        }
4307        new [new a]
4308        eval lappend ::result [dumpArrays a:: a::1x a::2x]
4309
4310        class A {
4311            proc A {this} {
4312                variable ${this}x
4313                set ${this}x(0) 0
4314                set ($this,y) 1
4315            }
4316            proc A {this copy} {
4317                variable ${this}x
4318                variable ${copy}x
4319                array set ${this}x [array get ${copy}x]
4320                set ($this,y) $($copy,y)
4321            }
4322        }
4323        new [new A]
4324        eval lappend ::result [dumpArrays A:: A::3x A::4x]
4325
4326        class b {}
4327        class b::c {}
4328        proc b::c::c {this} {
4329            variable ${this}x
4330            set ${this}x(0) 0
4331            set ($this,y) 1
4332        }
4333        proc b::c::c {this copy} {
4334            variable ${this}x
4335            variable ${copy}x
4336            array set ${this}x [array get ${copy}x]
4337            set ($this,y) $($copy,y)
4338        }
4339        new [new b::c]
4340        eval lappend ::result [dumpArrays b::c:: b::c::5x b::c::6x]
4341
4342        class B {
4343            class C {
4344                proc C {this} {
4345                    variable ${this}x
4346                    set ${this}x(0) 0
4347                    set ($this,y) 1
4348                }
4349                proc C {this copy} {
4350                    variable ${this}x
4351                    variable ${copy}x
4352                    array set ${this}x [array get ${copy}x]
4353                    set ($this,y) $($copy,y)
4354                }
4355            }
4356            new [new C]
4357            eval lappend ::result [dumpArrays C:: C::7x C::8x]
4358        }
4359        new [new B::C]
4360        eval lappend ::result [dumpArrays B::C:: B::C::9x B::C::10x]
4361
4362        set ::result
4363    }]
4364    interp delete $interpreter
4365    set result
4366} [list\
4367    {a::(1,y) = 1}\
4368    {a::(2,y) = 1}\
4369    {a::1x(0) = 0}\
4370    {a::2x(0) = 0}\
4371    {A::(3,y) = 1}\
4372    {A::(4,y) = 1}\
4373    {A::3x(0) = 0}\
4374    {A::4x(0) = 0}\
4375    {b::c::(5,y) = 1}\
4376    {b::c::(6,y) = 1}\
4377    {b::c::5x(0) = 0}\
4378    {b::c::6x(0) = 0}\
4379    {C::(7,y) = 1}\
4380    {C::(8,y) = 1}\
4381    {C::7x(0) = 0}\
4382    {C::8x(0) = 0}\
4383    {B::C::(10,y) = 1}\
4384    {B::C::(7,y) = 1}\
4385    {B::C::(8,y) = 1}\
4386    {B::C::(9,y) = 1}\
4387    {B::C::9x(0) = 0}\
4388    {B::C::10x(0) = 0}\
4389]
4390
4391test stooop-49 {
4392    check user defined cloning operation error checking
4393} {
4394    set interpreter [interp create]
4395    $interpreter eval "source $source; namespace import stooop::*"
4396    set result [$interpreter eval {
4397        catch {
4398            class a {}
4399            proc a::a {this copy} {}
4400        } message
4401        lappend ::result $message
4402
4403        catch {
4404            class A {
4405                proc A {this copy} {}
4406            }
4407        } message
4408        lappend ::result $message
4409
4410        catch {
4411            class b {}
4412            class b::c {}
4413            proc b::c::c {this copy} {}
4414        } message
4415        lappend ::result $message
4416
4417        catch {
4418            class B {
4419                class C {
4420                    proc C {this copy} {}
4421                }
4422            }
4423        } message
4424        lappend ::result $message
4425
4426        set ::result
4427    }]
4428    interp delete $interpreter
4429    set result
4430} [list\
4431    {class ::a copy constructor defined before constructor}\
4432    {class ::A copy constructor defined before constructor}\
4433    {class ::b::c copy constructor defined before constructor}\
4434    {class ::B::C copy constructor defined before constructor}\
4435]
4436
4437test stooop-50 {
4438    check copy constructor base class(es) initialization errors
4439} {
4440    set interpreter [interp create]
4441    $interpreter eval "source $source; namespace import stooop::*"
4442    set result [$interpreter eval {
4443        catch {
4444            class a {}
4445            proc a::a {this p} {}
4446            class b {}
4447            proc b::b {this} a 0 {}
4448            proc b::b {this copy} {}
4449            new [new b]
4450        } message
4451        lappend ::result $message
4452
4453        catch {
4454            class A {
4455                proc A {this p} {}
4456            }
4457            class B {
4458                proc B {this} A 0 {}
4459                proc B {this copy} {}
4460            }
4461            new [new B]
4462        } message
4463        lappend ::result $message
4464
4465        catch {
4466            class c {}
4467            class c::d {}
4468            proc c::d::d {this p} {}
4469            class c::e {}
4470            proc c::e::e {this} c::d 0 {}
4471            proc c::e::e {this copy} {}
4472            new [new c::e]
4473        } message
4474        lappend ::result $message
4475
4476        catch {
4477            class C {
4478                class D {
4479                    proc D {this p} {}
4480                }
4481                class E {
4482                    proc E {this} C::D 0 {}
4483                    proc E {this copy} {}
4484                }
4485                new [new E]
4486            }
4487        } message
4488        lappend ::result $message
4489
4490        set ::result
4491    }]
4492    interp delete $interpreter
4493    set result
4494} [list\
4495    {missing base class ::a constructor arguments from class ::b constructor}\
4496    {missing base class ::A constructor arguments from class ::B constructor}\
4497    {missing base class ::c::d constructor arguments from class ::c::e constructor}\
4498    {missing base class ::C::D constructor arguments from class ::C::E constructor}\
4499]
4500
4501test stooop-51 {
4502    check that multiple declarations that can occur when a class declaration
4503    file is sourced multiple times have no adverse effects
4504} {
4505    set interpreter [interp create]
4506    $interpreter eval "source $source; namespace import stooop::*"
4507    set result [$interpreter eval {
4508        class a {}
4509        proc a::a {this} {}
4510        class b {}
4511        proc b::b {this} a {} {}
4512        proc b::b {this} a {} {}
4513
4514        class A {
4515            proc A {this} {}
4516        }
4517        class B {
4518            proc B {this} A {} {}
4519        }
4520        class B {
4521            proc B {this} A {} {}
4522        }
4523
4524        class c {}
4525        class c::d {}
4526        proc c::d::d {this} {}
4527        class c::e {}
4528        proc c::e::e {this} c::d {} {}
4529        proc c::e::e {this} c::d {} {}
4530
4531        class C {
4532            class D {
4533                proc D {this} {}
4534            }
4535            class E {
4536                proc E {this} C::D {} {}
4537            }
4538            class E {
4539                proc E {this} C::D {} {}
4540            }
4541        }
4542
4543        set ::result {}
4544    }]
4545    interp delete $interpreter
4546    set result
4547} {}
4548
4549test stooop-52 {
4550    check that member procedure cannot be defined before constructor
4551    declaration for we need ancestors for global ancestors array declaration
4552} {
4553    set interpreter [interp create]
4554    $interpreter eval "source $source; namespace import stooop::*"
4555    set result [$interpreter eval {
4556        catch {
4557            class a {}
4558            proc a::p {this} {}
4559        } message
4560        lappend ::result $message
4561
4562        catch {
4563            class A {
4564                proc p {this} {}
4565            }
4566        } message
4567        lappend ::result $message
4568
4569        catch {
4570            class b {}
4571            class b::c {}
4572            proc b::c::p {this} {}
4573        } message
4574        lappend ::result $message
4575
4576        catch {
4577            class B {
4578                class C {
4579                    proc p {this} {}
4580                }
4581            }
4582        } message
4583        lappend ::result $message
4584
4585        set ::result
4586    }]
4587    interp delete $interpreter
4588    set result
4589} [list\
4590    {class ::a member procedure p defined before constructor}\
4591    {class ::A member procedure p defined before constructor}\
4592    {class ::b::c member procedure p defined before constructor}\
4593    {class ::B::C member procedure p defined before constructor}\
4594]
4595
4596test stooop-53 {
4597    check that embedded command in base class constructor arguments does not
4598    interfere with variable number of arguments processing special case
4599} {
4600    set interpreter [interp create]
4601    $interpreter eval "source $source; namespace import stooop::*"
4602    set result [$interpreter eval {
4603        class a {}
4604        proc a::a {this p args} {}
4605        proc a::~a {this} {}
4606        class b {}
4607        proc b::b {this args} a {[list {}] $args} {}
4608        proc b::b {this args} a {[list {}] $args } {}
4609        proc b::b {this args} a {
4610            [list {}] $args
4611        } {}
4612
4613        class A {
4614            proc A {this p args} {}
4615            proc ~A {this} {}
4616        }
4617        class B {
4618            proc B {this args} A {[list {}] $args} {}
4619            proc B {this args} A {[list {}] $args } {}
4620            proc B {this args} A {
4621                [list {}] $args
4622            } {}
4623        }
4624
4625        class c {}
4626        class c::d {}
4627        proc c::d::d {this p args} {}
4628        proc c::d::~d {this} {}
4629        class c::e {}
4630        proc c::e::e {this args} c::d {[list {}] $args} {}
4631        proc c::e::e {this args} c::d {[list {}] $args } {}
4632        proc c::e::e {this args} c::d {
4633            [list {}] $args
4634        } {}
4635
4636        class C {
4637            class D {
4638                proc D {this p args} {}
4639                proc ~D {this} {}
4640            }
4641            class E {
4642                proc E {this args} C::D {[list {}] $args} {}
4643                proc E {this args} C::D {[list {}] $args } {}
4644                proc E {this args} C::D {
4645                    [list {}] $args
4646                } {}
4647            }
4648        }
4649
4650        set ::result {}
4651    }]
4652    interp delete $interpreter
4653    set result
4654} {}
4655
4656test stooop-54 {
4657    check that virtual procedure invocations from base class constructor behave
4658    as in C++ (see test 78 for nested class version)
4659} {
4660    set interpreter [interp create]
4661    $interpreter eval "source $source; namespace import stooop::*"
4662    set result [$interpreter eval {
4663        class a {}
4664        proc a::a {this} {
4665            a::f $this x
4666            a::g $this x {y z}
4667            # pure virtual invocations behavior is undefined
4668            lappend ::result [catch {a::h $this x}]
4669            lappend ::result [catch {a::i $this x {y z}}]
4670        }
4671        proc a::~a {this} {}
4672        virtual proc a::f {this p} {
4673            lappend ::result "a::f $this $p"
4674        }
4675        virtual proc a::g {this p args} {
4676            lappend ::result "a::g $this $p $args"
4677        }
4678        virtual proc a::h {this p}
4679        virtual proc a::i {this p args}
4680        class b {}
4681        proc b::b {this} a {} {}
4682        proc b::~b {this} {}
4683        virtual proc b::f {this p} {
4684            lappend ::result "b::f $this $p"
4685        }
4686        virtual proc b::g {this p args} {
4687            lappend ::result "b::g $this $p $args"
4688        }
4689        virtual proc b::h {this p} {
4690            lappend ::result "b::h $this $p"
4691        }
4692        proc b::i {this p args} {
4693            lappend ::result "b::i $this $p $args"
4694        }
4695        new b
4696
4697        class A {
4698            proc A {this} {
4699                A::f $this x
4700                A::g $this x {y z}
4701                # pure virtual invocations behavior is undefined
4702                lappend ::result [catch {A::h $this x}]
4703                lappend ::result [catch {A::i $this x {y z}}]
4704            }
4705            proc ~A {this} {}
4706            virtual proc f {this p} {
4707                lappend ::result "A::f $this $p"
4708            }
4709            virtual proc g {this p args} {
4710                lappend ::result "A::g $this $p $args"
4711            }
4712            virtual proc h {this p}
4713            virtual proc i {this p args}
4714        }
4715        class B {
4716            proc B {this} A {} {}
4717            proc ~B {this} {}
4718            virtual proc f {this p} {
4719                lappend ::result "B::f $this $p"
4720            }
4721            virtual proc g {this p args} {
4722                lappend ::result "B::g $this $p $args"
4723            }
4724            virtual proc h {this p} {
4725                lappend ::result "B::h $this $p"
4726            }
4727            proc i {this p args} {
4728                lappend ::result "B::i $this $p $args"
4729            }
4730        }
4731        new B
4732
4733        set ::result
4734    }]
4735    interp delete $interpreter
4736    set result
4737} [list\
4738    {a::f 1 x}\
4739    {a::g 1 x {y z}}\
4740    {1}\
4741    {1}\
4742    {A::f 2 x}\
4743    {A::g 2 x {y z}}\
4744    {1}\
4745    {1}\
4746]
4747
4748test stooop-55 {
4749    check that procedure invocation on variable arguments in derived class base
4750    class constructor arguments works
4751} {
4752    set interpreter [interp create]
4753    $interpreter eval "source $source; namespace import stooop::*"
4754    $interpreter eval $dumpArraysCode
4755    set result [$interpreter eval {
4756        class a {}
4757        proc a::a {this p args} {
4758            lappend ::result "a::a $this $p $args"
4759            set ($this,m) [lindex $args 0]
4760        }
4761        proc a::~a {this} {
4762            lappend ::result "a::~a $this"
4763        }
4764        class b {}
4765        proc b::b {this p args} a {$p [concat $args]} {
4766            lappend ::result "b::b $this $p $args"
4767            set ($this,n) [lindex $args 0]
4768        }
4769        proc b::~b {this} {
4770            lappend ::result "b::~b $this"
4771        }
4772        new b {x y} {1 2} 3
4773        eval lappend ::result [dumpArrays a:: b::]
4774
4775        class A {
4776            proc A {this p args} {
4777                lappend ::result "A::A $this $p $args"
4778                set ($this,m) [lindex $args 0]
4779            }
4780            proc ~A {this} {
4781                lappend ::result "A::~A $this"
4782            }
4783        }
4784        class B {
4785            proc B {this p args} A {$p [concat $args]} {
4786                lappend ::result "B::B $this $p $args"
4787                set ($this,n) [lindex $args 0]
4788            }
4789            proc ~B {this} {
4790                lappend ::result "B::~B $this"
4791            }
4792        }
4793        new B {x y} {1 2} 3
4794        eval lappend ::result [dumpArrays A:: B::]
4795
4796        class c {}
4797        class c::d {}
4798        proc c::d::d {this p args} {
4799            lappend ::result "d::d $this $p $args"
4800            set ($this,m) [lindex $args 0]
4801        }
4802        proc c::d::~d {this} {
4803            lappend ::result "d::~d $this"
4804        }
4805        class c::e {}
4806        proc c::e::e {this p args} c::d {$p [concat $args]} {
4807            lappend ::result "e::e $this $p $args"
4808            set ($this,n) [lindex $args 0]
4809        }
4810        proc c::e::~e {this} {
4811            lappend ::result "e::~e $this"
4812        }
4813        new c::e {x y} {1 2} 3
4814        eval lappend ::result [dumpArrays c::d:: c::e::]
4815
4816        class C {
4817            class D {
4818                proc D {this p args} {
4819                    lappend ::result "D::D $this $p $args"
4820                    set ($this,m) [lindex $args 0]
4821                }
4822                proc ~D {this} {
4823                    lappend ::result "D::~D $this"
4824                }
4825            }
4826            class E {
4827                proc E {this p args} C::D {$p [concat $args]} {
4828                    lappend ::result "E::E $this $p $args"
4829                    set ($this,n) [lindex $args 0]
4830                }
4831                proc ~E {this} {
4832                    lappend ::result "E::~E $this"
4833                }
4834            }
4835            new E {x y} {1 2} 3
4836            eval lappend ::result [dumpArrays D:: E::]
4837        }
4838        new C::E {x y} {1 2} 3
4839        eval lappend ::result [dumpArrays C::D:: C::E::]
4840
4841        set ::result
4842    }]
4843    interp delete $interpreter
4844    set result
4845} [list\
4846    {a::a 1 x y {1 2} 3}\
4847    {b::b 1 x y {1 2} 3}\
4848    {a::(1,_derived) = ::b}\
4849    {a::(1,m) = 1 2}\
4850    {b::(1,n) = 1 2}\
4851    {A::A 2 x y {1 2} 3}\
4852    {B::B 2 x y {1 2} 3}\
4853    {A::(2,_derived) = ::B}\
4854    {A::(2,m) = 1 2}\
4855    {B::(2,n) = 1 2}\
4856    {d::d 3 x y {1 2} 3}\
4857    {e::e 3 x y {1 2} 3}\
4858    {c::d::(3,_derived) = ::c::e}\
4859    {c::d::(3,m) = 1 2}\
4860    {c::e::(3,n) = 1 2}\
4861    {D::D 4 x y {1 2} 3}\
4862    {E::E 4 x y {1 2} 3}\
4863    {D::(4,_derived) = ::C::E}\
4864    {D::(4,m) = 1 2}\
4865    {E::(4,n) = 1 2}\
4866    {D::D 5 x y {1 2} 3}\
4867    {E::E 5 x y {1 2} 3}\
4868    {C::D::(4,_derived) = ::C::E}\
4869    {C::D::(4,m) = 1 2}\
4870    {C::D::(5,_derived) = ::C::E}\
4871    {C::D::(5,m) = 1 2}\
4872    {C::E::(4,n) = 1 2}\
4873    {C::E::(5,n) = 1 2}\
4874]
4875
4876test stooop-56 {
4877    check that procedure invocation on variable arguments in derived class base
4878    class constructor arguments works
4879} {
4880    set interpreter [interp create]
4881    $interpreter eval "source $source; namespace import stooop::*"
4882    $interpreter eval $dumpArraysCode
4883    set result [$interpreter eval {
4884        class a {}
4885        proc a::a {this args} {
4886            lappend ::result "a::a $this $args"
4887            set ($this,m) [lindex $args 0]
4888        }
4889        proc a::~a {this} {
4890            lappend ::result "a::~a $this"
4891        }
4892        class b {}
4893        proc b::b {this args} a {[concat $args]} {
4894            lappend ::result "b::b $this $args"
4895            set ($this,n) [lindex $args 0]
4896        }
4897        proc b::~b {this} {
4898            lappend ::result "b::~b $this"
4899        }
4900        new b {1 2} 3
4901        eval lappend ::result [dumpArrays a:: b::]
4902
4903        class A {
4904            proc A {this args} {
4905                lappend ::result "A::A $this $args"
4906                set ($this,m) [lindex $args 0]
4907            }
4908            proc ~A {this} {
4909                lappend ::result "A::~A $this"
4910            }
4911        }
4912        class B {
4913            proc B {this args} A {[concat $args]} {
4914                lappend ::result "B::B $this $args"
4915                set ($this,n) [lindex $args 0]
4916            }
4917            proc ~B {this} {
4918                lappend ::result "B::~B $this"
4919            }
4920        }
4921        new B {1 2} 3
4922        eval lappend ::result [dumpArrays A:: B::]
4923
4924        class c {}
4925        class c::d {}
4926        proc c::d::d {this args} {
4927            lappend ::result "d::d $this $args"
4928            set ($this,m) [lindex $args 0]
4929        }
4930        proc c::d::~d {this} {
4931            lappend ::result "d::~d $this"
4932        }
4933        class c::e {}
4934        proc c::e::e {this args} c::d {[concat $args]} {
4935            lappend ::result "e::e $this $args"
4936            set ($this,n) [lindex $args 0]
4937        }
4938        proc c::e::~e {this} {
4939            lappend ::result "e::~e $this"
4940        }
4941        new c::e {1 2} 3
4942        eval lappend ::result [dumpArrays c::d:: c::e::]
4943
4944        class C {
4945            class D {
4946                proc D {this args} {
4947                    lappend ::result "D::D $this $args"
4948                    set ($this,m) [lindex $args 0]
4949                }
4950                proc ~D {this} {
4951                    lappend ::result "D::~D $this"
4952                }
4953            }
4954            class E {
4955                proc E {this args} C::D {[concat $args]} {
4956                    lappend ::result "E::E $this $args"
4957                    set ($this,n) [lindex $args 0]
4958                }
4959                proc ~E {this} {
4960                    lappend ::result "E::~E $this"
4961                }
4962            }
4963            new E {1 2} 3
4964            eval lappend ::result [dumpArrays D:: E::]
4965        }
4966        new C::E {1 2} 3
4967        eval lappend ::result [dumpArrays C::D:: C::E::]
4968
4969        set ::result
4970    }]
4971    interp delete $interpreter
4972    set result
4973} [list\
4974    {a::a 1 {1 2} 3}\
4975    {b::b 1 {1 2} 3}\
4976    {a::(1,_derived) = ::b}\
4977    {a::(1,m) = 1 2}\
4978    {b::(1,n) = 1 2}\
4979    {A::A 2 {1 2} 3}\
4980    {B::B 2 {1 2} 3}\
4981    {A::(2,_derived) = ::B}\
4982    {A::(2,m) = 1 2}\
4983    {B::(2,n) = 1 2}\
4984    {d::d 3 {1 2} 3}\
4985    {e::e 3 {1 2} 3}\
4986    {c::d::(3,_derived) = ::c::e}\
4987    {c::d::(3,m) = 1 2}\
4988    {c::e::(3,n) = 1 2}\
4989    {D::D 4 {1 2} 3}\
4990    {E::E 4 {1 2} 3}\
4991    {D::(4,_derived) = ::C::E}\
4992    {D::(4,m) = 1 2}\
4993    {E::(4,n) = 1 2}\
4994    {D::D 5 {1 2} 3}\
4995    {E::E 5 {1 2} 3}\
4996    {C::D::(4,_derived) = ::C::E}\
4997    {C::D::(4,m) = 1 2}\
4998    {C::D::(5,_derived) = ::C::E}\
4999    {C::D::(5,m) = 1 2}\
5000    {C::E::(4,n) = 1 2}\
5001    {C::E::(5,n) = 1 2}\
5002]
5003
5004test stooop-57 {
5005    check that variable arguments in derived class work with base class
5006    constructor constant arguments
5007} {
5008    set interpreter [interp create]
5009    $interpreter eval "source $source; namespace import stooop::*"
5010    $interpreter eval $dumpArraysCode
5011    set result [$interpreter eval {
5012        class a {}
5013        proc a::a {this p} {
5014            lappend ::result "a::a $this $p"
5015            set ($this,m) $p
5016        }
5017        proc a::~a {this} {}
5018        class b {}
5019        proc b::b {this p args} a {$args} {
5020            lappend ::result "b::b $this $p $args"
5021        }
5022        proc b::~b {this} {}
5023        new b {x y} {1 2} 3
5024        eval lappend ::result [dumpArrays a::]
5025
5026        class A {
5027            proc A {this p} {
5028                lappend ::result "A::A $this $p"
5029                set ($this,m) $p
5030            }
5031            proc ~A {this} {}
5032        }
5033        class B {
5034            proc B {this p args} A {$args} {
5035                lappend ::result "B::B $this $p $args"
5036            }
5037            proc ~B {this} {}
5038        }
5039        new B {x y} {1 2} 3
5040        eval lappend ::result [dumpArrays A::]
5041
5042        class c {}
5043        class c::d {}
5044        proc c::d::d {this p} {
5045            lappend ::result "d::d $this $p"
5046            set ($this,m) $p
5047        }
5048        proc c::d::~d {this} {}
5049        class c::e {}
5050        proc c::e::e {this p args} c::d {$args} {
5051            lappend ::result "e::e $this $p $args"
5052        }
5053        proc c::e::~e {this} {}
5054        new c::e {x y} {1 2} 3
5055        eval lappend ::result [dumpArrays c::d::]
5056
5057        class C {
5058            class D {
5059                proc D {this p} {
5060                    lappend ::result "D::D $this $p"
5061                    set ($this,m) $p
5062                }
5063                proc ~D {this} {}
5064            }
5065            class E {
5066                proc E {this p args} C::D {$args} {
5067                    lappend ::result "E::E $this $p $args"
5068                }
5069                proc ~E {this} {}
5070            }
5071            new E {x y} {1 2} 3
5072            eval lappend ::result [dumpArrays D::]
5073        }
5074        new C::E {x y} {1 2} 3
5075        eval lappend ::result [dumpArrays C::D::]
5076
5077        set ::result
5078    }]
5079    interp delete $interpreter
5080    set result
5081} [list\
5082    {a::a 1 {1 2} 3}\
5083    {b::b 1 x y {1 2} 3}\
5084    {a::(1,_derived) = ::b}\
5085    {a::(1,m) = {1 2} 3}\
5086    {A::A 2 {1 2} 3}\
5087    {B::B 2 x y {1 2} 3}\
5088    {A::(2,_derived) = ::B}\
5089    {A::(2,m) = {1 2} 3}\
5090    {d::d 3 {1 2} 3}\
5091    {e::e 3 x y {1 2} 3}\
5092    {c::d::(3,_derived) = ::c::e}\
5093    {c::d::(3,m) = {1 2} 3}\
5094    {D::D 4 {1 2} 3}\
5095    {E::E 4 x y {1 2} 3}\
5096    {D::(4,_derived) = ::C::E}\
5097    {D::(4,m) = {1 2} 3}\
5098    {D::D 5 {1 2} 3}\
5099    {E::E 5 x y {1 2} 3}\
5100    {C::D::(4,_derived) = ::C::E}\
5101    {C::D::(4,m) = {1 2} 3}\
5102    {C::D::(5,_derived) = ::C::E}\
5103    {C::D::(5,m) = {1 2} 3}\
5104]
5105
5106test stooop-58 {
5107    check that variable arguments in derived class work with base class
5108    constructor constant arguments
5109} {
5110    set interpreter [interp create]
5111    $interpreter eval "source $source; namespace import stooop::*"
5112    $interpreter eval $dumpArraysCode
5113    set result [$interpreter eval {
5114        class a {}
5115        proc a::a {this p args} {
5116            lappend ::result "a::a $this $p $args"
5117            set ($this,m) [lindex $args 0]
5118        }
5119        proc a::~a {this} {}
5120        class b {}
5121        proc b::b {this p args} a {$p z} {
5122            lappend ::result "b::b $this $p $args"
5123            set ($this,n) [lindex $args 0]
5124        }
5125        proc b::~b {this} {}
5126        new b {x y} {1 2} 3
5127        eval lappend ::result [dumpArrays a::]
5128
5129        class A {
5130            proc A {this p args} {
5131                lappend ::result "A::A $this $p $args"
5132                set ($this,m) [lindex $args 0]
5133            }
5134            proc ~A {this} {}
5135        }
5136        class B {
5137            proc B {this p args} A {$p z} {
5138                lappend ::result "B::B $this $p $args"
5139                set ($this,n) [lindex $args 0]
5140            }
5141            proc ~B {this} {}
5142        }
5143        new B {x y} {1 2} 3
5144        eval lappend ::result [dumpArrays A::]
5145
5146        class c {}
5147        class c::d {}
5148        proc c::d::d {this p args} {
5149            lappend ::result "d::d $this $p $args"
5150            set ($this,m) [lindex $args 0]
5151        }
5152        proc c::d::~d {this} {}
5153        class c::e {}
5154        proc c::e::e {this p args} c::d {$p z} {
5155            lappend ::result "e::e $this $p $args"
5156            set ($this,n) [lindex $args 0]
5157        }
5158        proc c::e::~e {this} {}
5159        new c::e {x y} {1 2} 3
5160        eval lappend ::result [dumpArrays c::d::]
5161
5162        class C {
5163            class D {
5164                proc D {this p args} {
5165                    lappend ::result "D::D $this $p $args"
5166                    set ($this,m) [lindex $args 0]
5167                }
5168                proc ~D {this} {}
5169            }
5170            class E {
5171                proc E {this p args} C::D {$p z} {
5172                    lappend ::result "E::E $this $p $args"
5173                    set ($this,n) [lindex $args 0]
5174                }
5175                proc ~E {this} {}
5176            }
5177            new E {x y} {1 2} 3
5178            eval lappend ::result [dumpArrays D::]
5179        }
5180        new C::E {x y} {1 2} 3
5181        eval lappend ::result [dumpArrays C::D::]
5182
5183        set ::result
5184    }]
5185    interp delete $interpreter
5186    set result
5187} [list\
5188    {a::a 1 x y z}\
5189    {b::b 1 x y {1 2} 3}\
5190    {a::(1,_derived) = ::b}\
5191    {a::(1,m) = z}\
5192    {A::A 2 x y z}\
5193    {B::B 2 x y {1 2} 3}\
5194    {A::(2,_derived) = ::B}\
5195    {A::(2,m) = z}\
5196    {d::d 3 x y z}\
5197    {e::e 3 x y {1 2} 3}\
5198    {c::d::(3,_derived) = ::c::e}\
5199    {c::d::(3,m) = z}\
5200    {D::D 4 x y z}\
5201    {E::E 4 x y {1 2} 3}\
5202    {D::(4,_derived) = ::C::E}\
5203    {D::(4,m) = z}\
5204    {D::D 5 x y z}\
5205    {E::E 5 x y {1 2} 3}\
5206    {C::D::(4,_derived) = ::C::E}\
5207    {C::D::(4,m) = z}\
5208    {C::D::(5,_derived) = ::C::E}\
5209    {C::D::(5,m) = z}\
5210]
5211
5212test stooop-59 {
5213    check that construction, copy and deletion work transparently for variable
5214    context
5215} {
5216    set interpreter [interp create]
5217    $interpreter eval "source $source; namespace import stooop::*"
5218    $interpreter eval $dumpArraysCode
5219    set result [$interpreter eval {
5220        class a {}
5221        proc a::a {this p} {
5222            upvar $p q
5223            eval lappend ::result [dumpArrays q]
5224        }
5225        proc a::a {this copy} {
5226            upvar d q
5227            eval lappend ::result [dumpArrays q]
5228        }
5229        proc a::~a {this} {
5230            upvar d q
5231            eval lappend ::result [dumpArrays q]
5232        }
5233        set d(0) 0
5234        set o [new a d]
5235        new $o
5236        delete $o
5237
5238        class A {
5239            proc A {this p} {
5240                upvar $p q
5241                eval lappend ::result [dumpArrays q]
5242            }
5243            proc A {this copy} {
5244                upvar d q
5245                eval lappend ::result [dumpArrays q]
5246            }
5247            proc ~A {this} {
5248                upvar d q
5249                eval lappend ::result [dumpArrays q]
5250            }
5251        }
5252        set d(0) 1
5253        set o [new A d]
5254        new $o
5255        delete $o
5256
5257        class b {}
5258        class b::c {}
5259        proc b::c::c {this p} {
5260            upvar $p q
5261            eval lappend ::result [dumpArrays q]
5262        }
5263        proc b::c::c {this copy} {
5264            upvar d q
5265            eval lappend ::result [dumpArrays q]
5266        }
5267        proc b::c::~c {this} {
5268            upvar d q
5269            eval lappend ::result [dumpArrays q]
5270        }
5271        set d(0) 2
5272        set o [new b::c d]
5273        new $o
5274        delete $o
5275
5276        class B {
5277            class C {
5278                proc C {this p} {
5279                    upvar $p q
5280                    eval lappend ::result [dumpArrays q]
5281                }
5282                proc C {this copy} {
5283                    upvar d q
5284                    eval lappend ::result [dumpArrays q]
5285                }
5286                proc ~C {this} {
5287                    upvar d q
5288                    eval lappend ::result [dumpArrays q]
5289                }
5290            }
5291            set d(0) 3
5292            set o [new C d]
5293            new $o
5294            delete $o
5295        }
5296        set d(0) 4
5297        set o [new B::C d]
5298        new $o
5299        delete $o
5300
5301        set ::result
5302    }]
5303    interp delete $interpreter
5304    set result
5305} [list\
5306    {q(0) = 0}\
5307    {q(0) = 0}\
5308    {q(0) = 0}\
5309    {q(0) = 1}\
5310    {q(0) = 1}\
5311    {q(0) = 1}\
5312    {q(0) = 2}\
5313    {q(0) = 2}\
5314    {q(0) = 2}\
5315    {q(0) = 3}\
5316    {q(0) = 3}\
5317    {q(0) = 3}\
5318    {q(0) = 4}\
5319    {q(0) = 4}\
5320    {q(0) = 4}\
5321]
5322
5323test stooop-60 {
5324    undocumented
5325} {
5326    set interpreter [interp create]
5327    $interpreter eval "source $source; namespace import stooop::*"
5328    set result [$interpreter eval {
5329        catch {
5330            class a {}
5331            proc a::a::p {this} {}
5332        } message
5333        lappend ::result $message
5334
5335        catch {
5336            class A {
5337                proc A::p {this} {}
5338            }
5339        } message
5340        lappend ::result $message
5341
5342        catch {
5343            class b {}
5344            class b::c {}
5345            proc b::c::c::p {this} {}
5346        } message
5347        lappend ::result $message
5348
5349        catch {
5350            class B {
5351                class C {
5352                    proc C::p {this} {}
5353                }
5354            }
5355        } message
5356        lappend ::result $message
5357
5358        set ::result
5359    }]
5360    interp delete $interpreter
5361    set result
5362} [list\
5363    {can't create procedure "a::a::p": unknown namespace}\
5364    {can't create procedure "A::p": unknown namespace}\
5365    {can't create procedure "b::c::c::p": unknown namespace}\
5366    {can't create procedure "C::p": unknown namespace}\
5367]
5368
5369test stooop-61 {
5370    undocumented
5371} {
5372    set interpreter [interp create]
5373    $interpreter eval "source $source; namespace import stooop::*"
5374    set result [$interpreter eval {
5375        catch {new 1} ::result
5376        set ::result
5377    }]
5378    interp delete $interpreter
5379    set result
5380} {invalid object identifier 1}
5381
5382test stooop-62 {
5383    check that multiple class definitions for the same class are possible
5384} {
5385    set interpreter [interp create]
5386    $interpreter eval "source $source; namespace import stooop::*"
5387    set result [$interpreter eval {
5388        class a {
5389            proc a {this} {}
5390            proc ~a {this} {}
5391        }
5392        proc a::p {this p} {
5393            set ($this,m) $p
5394        }
5395        class a {
5396            proc q {this} {
5397                lappend ::result $($this,m)
5398            }
5399        }
5400        set o [new a]
5401        a::p $o 0
5402        a::q $o
5403
5404        class b {
5405            class c {
5406                proc c {this} {}
5407                proc ~c {this} {}
5408            }
5409            proc c::p {this p} {
5410                set ($this,m) $p
5411            }
5412            class c {
5413                proc q {this} {
5414                    lappend ::result $($this,m)
5415                }
5416            }
5417            set o [new c]
5418            c::p $o 0
5419            c::q $o
5420        }
5421        set o [new b::c]
5422        b::c::p $o 0
5423        b::c::q $o
5424
5425        set ::result
5426    }]
5427    interp delete $interpreter
5428    set result
5429} [list\
5430    0\
5431    0\
5432    0\
5433]
5434
5435test stooop-63 {
5436    check that non qualified procedure invocation in derived class base class
5437    constructor arguments works
5438} {
5439    set interpreter [interp create]
5440    $interpreter eval "source $source; namespace import stooop::*"
5441    $interpreter eval $dumpArraysCode
5442    set result [$interpreter eval {
5443        proc p {p} {error "::p invoked"}
5444
5445        class a {}
5446        proc a::a {this p} {
5447            set ($this,m) $p
5448        }
5449        proc a::~a {this} {}
5450        class b {}
5451        proc b::b {this p} a {[p $p]} {
5452            set ($this,n) $p
5453        }
5454        proc b::~b {this} {}
5455        proc b::p {p} {
5456            return [incr p]
5457        }
5458        new b 0
5459        eval lappend ::result [dumpArrays a:: b::]
5460
5461        class A {
5462            proc A {this p} {
5463                set ($this,m) $p
5464            }
5465            proc ~A {this} {}
5466        }
5467        class B {
5468            proc B {this p} A {[p $p]} {
5469                set ($this,n) $p
5470            }
5471            proc ~B {this} {}
5472            proc p {p} {
5473                return [incr p]
5474            }
5475        }
5476        new B 0
5477        eval lappend ::result [dumpArrays A:: B::]
5478
5479        class c {}
5480        class c::d {}
5481        proc c::d::d {this p} {
5482            set ($this,m) $p
5483        }
5484        proc c::d::~d {this} {}
5485        class c::e {}
5486        proc c::e::e {this p} c::d {[p $p]} {
5487            set ($this,n) $p
5488        }
5489        proc c::e::~e {this} {}
5490        proc c::e::p {p} {
5491            return [incr p]
5492        }
5493        new c::e 0
5494        eval lappend ::result [dumpArrays c::d:: c::e::]
5495
5496        class C {
5497            class D {
5498                proc D {this p} {
5499                    set ($this,m) $p
5500                }
5501                proc ~D {this} {}
5502            }
5503            class E {
5504                proc E {this p} C::D {[p $p]} {
5505                    set ($this,n) $p
5506                }
5507                proc ~E {this} {}
5508                proc p {p} {
5509                    return [incr p]
5510                }
5511            }
5512            new E 0
5513            eval lappend ::result [dumpArrays D:: E::]
5514        }
5515        new C::E 0
5516        eval lappend ::result [dumpArrays C::D:: C::E::]
5517
5518        set ::result
5519    }]
5520    interp delete $interpreter
5521    set result
5522} [list\
5523    {a::(1,_derived) = ::b}\
5524    {a::(1,m) = 1}\
5525    {b::(1,n) = 0}\
5526    {A::(2,_derived) = ::B}\
5527    {A::(2,m) = 1}\
5528    {B::(2,n) = 0}\
5529    {c::d::(3,_derived) = ::c::e}\
5530    {c::d::(3,m) = 1}\
5531    {c::e::(3,n) = 0}\
5532    {D::(4,_derived) = ::C::E}\
5533    {D::(4,m) = 1}\
5534    {E::(4,n) = 0}\
5535    {C::D::(4,_derived) = ::C::E}\
5536    {C::D::(4,m) = 1}\
5537    {C::D::(5,_derived) = ::C::E}\
5538    {C::D::(5,m) = 1}\
5539    {C::E::(4,n) = 0}\
5540    {C::E::(5,n) = 0}\
5541]
5542
5543test stooop-64 {
5544    check static member initialization within class body
5545} {
5546    set interpreter [interp create]
5547    $interpreter eval "source $source; namespace import stooop::*"
5548    $interpreter eval $dumpArraysCode
5549    set result [$interpreter eval {
5550        class a {
5551            set (l) {}
5552        }
5553        proc a::a {this} {
5554            lappend (l) $this
5555        }
5556        proc a::~a {this} {}
5557        new a
5558        new a
5559        eval lappend ::result [dumpArrays a::]
5560
5561        class A {
5562            set A::(l) {}
5563            proc A {this} {
5564                lappend (l) $this
5565            }
5566            proc ~A {this} {}
5567        }
5568        new A
5569        new A
5570        eval lappend ::result [dumpArrays A::]
5571
5572        class b {}
5573        class b::c {
5574            set (l) {}
5575        }
5576        proc b::c::c {this} {
5577            lappend (l) $this
5578        }
5579        proc b::c::~c {this} {}
5580        new b::c
5581        new b::c
5582        eval lappend ::result [dumpArrays b::c::]
5583
5584        class B {
5585            class C {
5586                set (l) {}
5587                proc C {this} {
5588                    lappend (l) $this
5589                }
5590                proc ~C {this} {}
5591            }
5592            new C
5593            new C
5594            eval lappend ::result [dumpArrays C::]
5595        }
5596        new B::C
5597        new B::C
5598        eval lappend ::result [dumpArrays B::C::]
5599
5600        set ::result
5601    }]
5602    interp delete $interpreter
5603    set result
5604} [list\
5605    {a::(l) = 1 2}\
5606    {A::(l) = 3 4}\
5607    {b::c::(l) = 5 6}\
5608    {C::(l) = 7 8}\
5609    {B::C::(l) = 7 8 9 10}\
5610]
5611
5612test stooop-65 {
5613    undocumented
5614} {
5615    set interpreter [interp create]
5616    $interpreter eval "source $source; namespace import stooop::*"
5617    set result [$interpreter eval {
5618        catch {
5619            class a {}
5620            proc a::a {this} {}
5621            virtual proc a::a::p {this} {}
5622        } message
5623        lappend ::result $message
5624
5625        catch {
5626            class A {
5627                proc A {this} {}
5628                virtual proc A::p {this} {}
5629            }
5630        } message
5631        lappend ::result $message
5632
5633        catch {
5634            class b {}
5635            class b::c {}
5636            proc b::c::c {this} {}
5637            virtual proc b::c::c::p {this} {}
5638        } message
5639        lappend ::result $message
5640
5641        catch {
5642            class B {
5643                class C {
5644                    proc C {this} {}
5645                    virtual proc C::p {this} {}
5646                }
5647            }
5648        } message
5649        lappend ::result $message
5650
5651        set ::result
5652    }]
5653    interp delete $interpreter
5654    set result
5655} [list\
5656    {procedure ::a::a::p class ::a::a is unknown}\
5657    {procedure ::A::A::p class ::A::A is unknown}\
5658    {procedure ::b::c::c::p class ::b::c::c is unknown}\
5659    {procedure ::B::C::C::p class ::B::C::C is unknown}\
5660]
5661
5662test stooop-66 {
5663    check that nested class procedure definition works inside and outside
5664    nested class or namespace
5665} {
5666    set interpreter [interp create]
5667    $interpreter eval "source $source; namespace import stooop::*"
5668    set result [$interpreter eval {
5669        class a {
5670            class b {
5671                proc b {this} {}
5672                proc p {this} {
5673                    lappend ::result 1
5674                }
5675            }
5676            set o [new b]
5677            b::p $o
5678            proc b::p {this} {
5679                lappend ::result 2
5680            }
5681            b::p $o
5682        }
5683
5684        namespace eval c {
5685            class b {
5686                proc b {this} {}
5687                proc p {this} {
5688                    lappend ::result 3
5689                }
5690            }
5691            set o [new b]
5692            b::p $o
5693            proc b::p {this} {
5694                lappend ::result 4
5695            }
5696            b::p $o
5697        }
5698
5699        set o [new a::b]
5700        proc a::b::p {this} {
5701            lappend ::result 5
5702        }
5703        a::b::p $o
5704
5705        set o [new c::b]
5706        proc c::b::p {this} {
5707            lappend ::result 6
5708        }
5709        c::b::p $o
5710
5711        set ::result
5712    }]
5713    interp delete $interpreter
5714    set result
5715} [list\
5716    1\
5717    2\
5718    3\
5719    4\
5720    5\
5721    6\
5722]
5723
5724test stooop-67 {
5725    check that nested class procedure definition works inside a separate
5726    namespace and is free from interferences
5727} {
5728    set interpreter [interp create]
5729    $interpreter eval "source $source; namespace import stooop::*"
5730    set result [$interpreter eval {
5731        class a {
5732            proc a {this} {}
5733            proc p {this} {
5734                lappend ::result 1
5735            }
5736        }
5737        set o [new a]
5738        a::p $o
5739
5740        namespace eval b {
5741            namespace eval a {}
5742            proc a::p {this} {
5743                lappend ::result 2
5744            }
5745        }
5746        a::p $o
5747
5748        namespace eval c {
5749            proc ::a::p {this} {
5750                lappend ::result 3
5751            }
5752        }
5753        a::p $o
5754
5755        namespace eval d {
5756            class a {
5757                proc a {this} {}
5758                proc p {this} {
5759                    lappend ::result 4
5760                }
5761            }
5762            set o [new a]
5763            a::p $o
5764
5765            namespace eval b {
5766                namespace eval a {}
5767                proc a::p {this} {
5768                    lappend ::result 5
5769                }
5770            }
5771            a::p $o
5772
5773            namespace eval c {
5774                proc ::d::a::p {this} {
5775                    lappend ::result 6
5776                }
5777            }
5778            a::p $o
5779        }
5780
5781        class e {
5782            proc e {this} {}
5783            class a {
5784                proc a {this} {}
5785                proc p {this} {
5786                    lappend ::result 7
5787                }
5788            }
5789            set o [new a]
5790            a::p $o
5791
5792            namespace eval b {
5793                namespace eval a {}
5794                proc a::p {this} {
5795                    lappend ::result 8
5796                }
5797            }
5798            a::p $o
5799
5800            namespace eval c {
5801                proc ::e::a::p {this} {
5802                    lappend ::result 9
5803                }
5804            }
5805            a::p $o
5806        }
5807
5808        set ::result
5809    }]
5810    interp delete $interpreter
5811    set result
5812} [list\
5813    1\
5814    1\
5815    3\
5816    4\
5817    4\
5818    6\
5819    7\
5820    7\
5821    9\
5822]
5823
5824test stooop-68 {
5825    check inheritance within a deep nested class hierarchy
5826} {
5827    set interpreter [interp create]
5828    $interpreter eval "source $source; namespace import stooop::*"
5829    set result [$interpreter eval {
5830        class a {
5831            proc a {this} {
5832                lappend ::result a::a
5833            }
5834            class b {
5835                proc b {this} a {} {
5836                    lappend ::result b::b
5837                }
5838                class c {
5839                    catch {
5840                        proc c {this} b {} {}
5841                    } message
5842                    lappend ::result $message
5843                    proc c {this} a::b {} {
5844                        lappend ::result c::c
5845                    }
5846                }
5847                new c
5848            }
5849        }
5850
5851        namespace eval d {
5852            proc d {this} {
5853                lappend ::result d::d
5854            }
5855            namespace eval e {
5856                proc e {this} {
5857                    d::d $this
5858                    lappend ::result e::e
5859                }
5860                namespace eval f {
5861                    proc f {this} {
5862                        catch {
5863                            e::e $this
5864                        } message
5865                        lappend ::result $message
5866                        d::e::e $this
5867                        lappend ::result f::f
5868                    }
5869                }
5870                f::f 0
5871            }
5872        }
5873
5874        set ::result
5875    }]
5876    interp delete $interpreter
5877    set result
5878} [list\
5879    {class ::a::b::c constructor defined before base class b constructor}\
5880    {a::a}\
5881    {b::b}\
5882    {c::c}\
5883    {invalid command name "e::e"}\
5884    {d::d}\
5885    {e::e}\
5886    {f::f}\
5887]
5888
5889test stooop-69 {
5890    check user defined cloning operation in nested class context
5891} {
5892    set interpreter [interp create]
5893    $interpreter eval "source $source; namespace import stooop::*"
5894    $interpreter eval $dumpArraysCode
5895    set result [$interpreter eval {
5896        class a {}
5897        proc a::a {this} {}
5898        class a::b {}
5899        proc a::b::b {this} {
5900            set ($this,x) 0
5901        }
5902        proc a::b::b {this copy} {
5903            set ($this,x) [expr $($copy,x)+1]
5904        }
5905        new [new a::b]
5906        eval lappend ::result [dumpArrays a::b::]
5907
5908        class A {
5909            proc A {this} {}
5910            class B {
5911                proc B {this} {
5912                    set ($this,x) 0
5913                }
5914                proc B {this copy} {
5915                    set ($this,x) [expr $($copy,x)+1]
5916                }
5917            }
5918            new [new B]
5919            eval lappend ::result [dumpArrays B::]
5920        }
5921        new [new A::B]
5922        eval lappend ::result [dumpArrays A::B::]
5923
5924        set ::result
5925    }]
5926    interp delete $interpreter
5927    set result
5928} [list\
5929    {a::b::(1,x) = 0}\
5930    {a::b::(2,x) = 1}\
5931    {B::(3,x) = 0}\
5932    {B::(4,x) = 1}\
5933    {A::B::(3,x) = 0}\
5934    {A::B::(4,x) = 1}\
5935    {A::B::(5,x) = 0}\
5936    {A::B::(6,x) = 1}\
5937]
5938
5939test stooop-70 {
5940    check basic cloning operation in nested class context
5941} {
5942    set interpreter [interp create]
5943    $interpreter eval "source $source; namespace import stooop::*"
5944    $interpreter eval $dumpArraysCode
5945    set result [$interpreter eval {
5946        class a {}
5947        proc a::a {this} {}
5948        class a::b {}
5949        proc a::b::b {this} {
5950            set ($this,x) 0
5951        }
5952        new [new a::b]
5953        eval lappend ::result [dumpArrays a::b::]
5954
5955        class A {
5956            proc A {this} {}
5957            class B {
5958                proc B {this} {
5959                    set ($this,x) 0
5960                }
5961            }
5962            new [new B]
5963            eval lappend ::result [dumpArrays B::]
5964        }
5965        new [new A::B]
5966        eval lappend ::result [dumpArrays A::B::]
5967
5968        set ::result
5969    }]
5970    interp delete $interpreter
5971    set result
5972} [list\
5973    {a::b::(1,x) = 0}\
5974    {a::b::(2,x) = 0}\
5975    {B::(3,x) = 0}\
5976    {B::(4,x) = 0}\
5977    {A::B::(3,x) = 0}\
5978    {A::B::(4,x) = 0}\
5979    {A::B::(5,x) = 0}\
5980    {A::B::(6,x) = 0}\
5981]
5982
5983test stooop-71 {
5984    check multiple inheritance construction order, destruction order and data
5985    deallocation with a common indirect base class
5986} {
5987    set interpreter [interp create]
5988    $interpreter eval "source $source; namespace import stooop::*"
5989    $interpreter eval $dumpArraysCode
5990    set result [$interpreter eval {
5991        class z {}
5992        class z::a {}
5993        proc z::a::a {this p} {
5994            lappend ::result "a::a $this"
5995            set ($this,m) $p
5996        }
5997        proc z::a::~a {this} {
5998            lappend ::result "a::~a $this"
5999        }
6000        class z::b {}
6001        proc z::b::b {this p} {
6002            lappend ::result "b::b $this"
6003            set ($this,n) $p
6004        }
6005        proc z::b::~b {this} {
6006            lappend ::result "b::~b $this"
6007        }
6008        class z::c {}
6009        proc z::c::c {this p q r} z::a {$p} z::b {$q} {
6010            lappend ::result "c::c $this"
6011            set ($this,o) $r
6012        }
6013        proc z::c::~c {this} {
6014            lappend ::result "c::~c $this"
6015        }
6016        class z::d {}
6017        proc z::d::d {this p q r} z::a {$p} z::b {$q} {
6018            lappend ::result "d::d $this"
6019            set ($this,p) $p
6020        }
6021        proc z::d::~d {this} {
6022            lappend ::result "d::~d $this"
6023        }
6024        class z::e {}
6025        proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} {
6026            lappend ::result "e::e $this"
6027            set ($this,q) $q
6028        }
6029        proc z::e::~e {this} {
6030            lappend ::result "e::~e $this"
6031        }
6032        set o [new z::e {x y} z {1 2}]
6033        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::]
6034        delete $o
6035        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::]
6036
6037        class Z {
6038            class A {
6039                proc A {this p} {
6040                    lappend ::result "A::A $this"
6041                    set ($this,m) $p
6042                }
6043                proc ~A {this} {
6044                    lappend ::result "A::~A $this"
6045                }
6046            }
6047            class B {
6048                proc B {this p} {
6049                    lappend ::result "B::B $this"
6050                    set ($this,n) $p
6051                }
6052                proc ~B {this} {
6053                    lappend ::result "B::~B $this"
6054                }
6055            }
6056            class C {
6057                proc C {this p q r} Z::A {$p} Z::B {$q} {
6058                    lappend ::result "C::C $this"
6059                    set ($this,o) $r
6060                }
6061                proc ~C {this} {
6062                    lappend ::result "C::~C $this"
6063                }
6064            }
6065            class D {
6066                proc D {this p q r} Z::A {$p} Z::B {$q} {
6067                    lappend ::result "D::D $this"
6068                    set ($this,p) $p
6069                }
6070                proc ~D {this} {
6071                    lappend ::result "D::~D $this"
6072                }
6073            }
6074            class E {
6075                proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} {
6076                    lappend ::result "E::E $this"
6077                    set ($this,q) $q
6078                }
6079                proc ~E {this} {
6080                    lappend ::result "E::~E $this"
6081                }
6082            }
6083            set o [new E {x y} z {1 2}]
6084            eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
6085            delete $o
6086            eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
6087        }
6088        set o [new Z::E {x y} z {1 2}]
6089        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::]
6090        delete $o
6091        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::]
6092
6093        set ::result
6094    }]
6095    interp delete $interpreter
6096    set result
6097} [list\
6098    {a::a 1}\
6099    {b::b 1}\
6100    {c::c 1}\
6101    {a::a 1}\
6102    {b::b 1}\
6103    {d::d 1}\
6104    {e::e 1}\
6105    {z::a::(1,_derived) = ::z::d}\
6106    {z::a::(1,m) = z}\
6107    {z::b::(1,_derived) = ::z::d}\
6108    {z::b::(1,n) = z}\
6109    {z::c::(1,_derived) = ::z::e}\
6110    {z::c::(1,o) = 1 2}\
6111    {z::d::(1,_derived) = ::z::e}\
6112    {z::d::(1,p) = z}\
6113    {z::e::(1,q) = z}\
6114    {e::~e 1}\
6115    {d::~d 1}\
6116    {b::~b 1}\
6117    {a::~a 1}\
6118    {c::~c 1}\
6119    {b::~b 1}\
6120    {a::~a 1}\
6121    {A::A 2}\
6122    {B::B 2}\
6123    {C::C 2}\
6124    {A::A 2}\
6125    {B::B 2}\
6126    {D::D 2}\
6127    {E::E 2}\
6128    {A::(2,_derived) = ::Z::D}\
6129    {A::(2,m) = z}\
6130    {B::(2,_derived) = ::Z::D}\
6131    {B::(2,n) = z}\
6132    {C::(2,_derived) = ::Z::E}\
6133    {C::(2,o) = 1 2}\
6134    {D::(2,_derived) = ::Z::E}\
6135    {D::(2,p) = z}\
6136    {E::(2,q) = z}\
6137    {E::~E 2}\
6138    {D::~D 2}\
6139    {B::~B 2}\
6140    {A::~A 2}\
6141    {C::~C 2}\
6142    {B::~B 2}\
6143    {A::~A 2}\
6144    {A::A 3}\
6145    {B::B 3}\
6146    {C::C 3}\
6147    {A::A 3}\
6148    {B::B 3}\
6149    {D::D 3}\
6150    {E::E 3}\
6151    {Z::A::(3,_derived) = ::Z::D}\
6152    {Z::A::(3,m) = z}\
6153    {Z::B::(3,_derived) = ::Z::D}\
6154    {Z::B::(3,n) = z}\
6155    {Z::C::(3,_derived) = ::Z::E}\
6156    {Z::C::(3,o) = 1 2}\
6157    {Z::D::(3,_derived) = ::Z::E}\
6158    {Z::D::(3,p) = z}\
6159    {Z::E::(3,q) = z}\
6160    {E::~E 3}\
6161    {D::~D 3}\
6162    {B::~B 3}\
6163    {A::~A 3}\
6164    {C::~C 3}\
6165    {B::~B 3}\
6166    {A::~A 3}\
6167]
6168
6169test stooop-72 {
6170    check that multiply inherited base classes constructors work with variable
6171    number of arguments
6172} {
6173    set interpreter [interp create]
6174    $interpreter eval "source $source; namespace import stooop::*"
6175    $interpreter eval $dumpArraysCode
6176    set result [$interpreter eval {
6177        class z {}
6178        class z::a {}
6179        proc z::a::a {this args} {
6180            lappend ::result "a::a $this $args"
6181            set ($this,m) [lindex $args 0]
6182        }
6183        class z::b {}
6184        proc z::b::b {this p} {
6185            lappend ::result "b::b $this $p"
6186            set ($this,n) $p
6187        }
6188        class z::c {}
6189        proc z::c::c {this p args} {
6190            lappend ::result "c::c $this $p $args"
6191            set ($this,o) $p
6192            set ($this,p) [lindex $args 0]
6193        }
6194        class z::d {}
6195        proc z::d::d {this p args} z::a {$args} z::b {$p} z::c {$p $args} {
6196            lappend ::result "d::d $this $p $args"
6197            set ($this,q) $p
6198            set ($this,r) [lindex $args 0]
6199        }
6200        new z::d {x y} {1 2} 3
6201        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d::]
6202
6203        class Z {
6204            class A {
6205                proc A {this args} {
6206                    lappend ::result "A::A $this $args"
6207                    set ($this,m) [lindex $args 0]
6208                }
6209            }
6210            class B {
6211                proc B {this p} {
6212                    lappend ::result "B::B $this $p"
6213                    set ($this,n) $p
6214                }
6215            }
6216            class C {
6217                proc C {this p args} {
6218                    lappend ::result "C::C $this $p $args"
6219                    set ($this,o) $p
6220                    set ($this,p) [lindex $args 0]
6221                }
6222            }
6223            class D {
6224                proc D {this p args} Z::A {$args} Z::B {$p} Z::C {$p $args} {
6225                    lappend ::result "D::D $this $p $args"
6226                    set ($this,q) $p
6227                    set ($this,r) [lindex $args 0]
6228                }
6229            }
6230            new D {x y} {1 2} 3
6231            eval lappend ::result [dumpArrays A:: B:: C:: D::]
6232        }
6233        new Z::D {x y} {1 2} 3
6234        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D::]
6235
6236        set ::result
6237    }]
6238    interp delete $interpreter
6239    set result
6240} [list\
6241    {a::a 1 {1 2} 3}\
6242    {b::b 1 x y}\
6243    {c::c 1 x y {1 2} 3}\
6244    {d::d 1 x y {1 2} 3}\
6245    {z::a::(1,_derived) = ::z::d}\
6246    {z::a::(1,m) = 1 2}\
6247    {z::b::(1,_derived) = ::z::d}\
6248    {z::b::(1,n) = x y}\
6249    {z::c::(1,_derived) = ::z::d}\
6250    {z::c::(1,o) = x y}\
6251    {z::c::(1,p) = 1 2}\
6252    {z::d::(1,q) = x y}\
6253    {z::d::(1,r) = 1 2}\
6254    {A::A 2 {1 2} 3}\
6255    {B::B 2 x y}\
6256    {C::C 2 x y {1 2} 3}\
6257    {D::D 2 x y {1 2} 3}\
6258    {A::(2,_derived) = ::Z::D}\
6259    {A::(2,m) = 1 2}\
6260    {B::(2,_derived) = ::Z::D}\
6261    {B::(2,n) = x y}\
6262    {C::(2,_derived) = ::Z::D}\
6263    {C::(2,o) = x y}\
6264    {C::(2,p) = 1 2}\
6265    {D::(2,q) = x y}\
6266    {D::(2,r) = 1 2}\
6267    {A::A 3 {1 2} 3}\
6268    {B::B 3 x y}\
6269    {C::C 3 x y {1 2} 3}\
6270    {D::D 3 x y {1 2} 3}\
6271    {Z::A::(2,_derived) = ::Z::D}\
6272    {Z::A::(2,m) = 1 2}\
6273    {Z::A::(3,_derived) = ::Z::D}\
6274    {Z::A::(3,m) = 1 2}\
6275    {Z::B::(2,_derived) = ::Z::D}\
6276    {Z::B::(2,n) = x y}\
6277    {Z::B::(3,_derived) = ::Z::D}\
6278    {Z::B::(3,n) = x y}\
6279    {Z::C::(2,_derived) = ::Z::D}\
6280    {Z::C::(2,o) = x y}\
6281    {Z::C::(2,p) = 1 2}\
6282    {Z::C::(3,_derived) = ::Z::D}\
6283    {Z::C::(3,o) = x y}\
6284    {Z::C::(3,p) = 1 2}\
6285    {Z::D::(2,q) = x y}\
6286    {Z::D::(2,r) = 1 2}\
6287    {Z::D::(3,q) = x y}\
6288    {Z::D::(3,r) = 1 2}\
6289]
6290
6291test stooop-73 {
6292    check multiple inheritance destruction order and data deallocation with a
6293    common indirect base class
6294} {
6295    set interpreter [interp create]
6296    $interpreter eval "source $source; namespace import stooop::*"
6297    $interpreter eval $dumpArraysCode
6298    set result [$interpreter eval {
6299        class z {}
6300        class z::a {}
6301        proc z::a::a {this p} {
6302            lappend ::result "a::a $this"
6303            set ($this,m) $p
6304        }
6305        proc z::a::~a {this} {
6306            lappend ::result "a::~a $this"
6307        }
6308        class z::b {}
6309        proc z::b::b {this p} {
6310            lappend ::result "b::b $this"
6311            set ($this,n) $p
6312        }
6313        proc z::b::~b {this} {
6314            lappend ::result "b::~b $this"
6315        }
6316        class z::c {}
6317        proc z::c::c {this p q r} z::a {$p} z::b {$q} {
6318            lappend ::result "c::c $this"
6319            set ($this,o) $r
6320        }
6321        proc z::c::~c {this} {
6322            lappend ::result "c::~c $this"
6323        }
6324        class z::d {}
6325        proc z::d::d {this p q r} z::a {$p} z::b {$q} {
6326            lappend ::result "d::d $this"
6327            set ($this,p) $p
6328        }
6329        proc z::d::~d {this} {
6330            lappend ::result "d::~d $this"
6331        }
6332        class z::e {}
6333        proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} {
6334            lappend ::result "e::e $this"
6335            set ($this,q) $q
6336        }
6337        proc z::e::~e {this} {
6338            lappend ::result "e::~e $this"
6339        }
6340        set o [new z::e {x y} z {1 2}]
6341        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::]
6342        delete $o
6343        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::]
6344
6345        class Z {
6346            class A {
6347                proc A {this p} {
6348                    lappend ::result "A::A $this"
6349                    set ($this,m) $p
6350                }
6351                proc ~A {this} {
6352                    lappend ::result "A::~A $this"
6353                }
6354            }
6355            class B {
6356                proc B {this p} {
6357                    lappend ::result "B::B $this"
6358                    set ($this,n) $p
6359                }
6360                proc ~B {this} {
6361                    lappend ::result "B::~B $this"
6362                }
6363            }
6364            class C {
6365                proc C {this p q r} Z::A {$p} Z::B {$q} {
6366                    lappend ::result "C::C $this"
6367                    set ($this,o) $r
6368                }
6369                proc ~C {this} {
6370                    lappend ::result "C::~C $this"
6371                }
6372            }
6373            class D {
6374                proc D {this p q r} Z::A {$p} Z::B {$q} {
6375                    lappend ::result "D::D $this"
6376                    set ($this,p) $p
6377                }
6378                proc ~D {this} {
6379                    lappend ::result "D::~D $this"
6380                }
6381            }
6382            class E {
6383                proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} {
6384                    lappend ::result "E::E $this"
6385                    set ($this,q) $q
6386                }
6387                proc ~E {this} {
6388                    lappend ::result "E::~E $this"
6389                }
6390            }
6391            set o [new E {x y} z {1 2}]
6392            eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
6393            delete $o
6394            eval lappend ::result [dumpArrays A:: B:: C:: D:: E::]
6395        }
6396        set o [new Z::E {x y} z {1 2}]
6397        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::]
6398        delete $o
6399        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::]
6400
6401        set ::result
6402    }]
6403    interp delete $interpreter
6404    set result
6405} [list\
6406    {a::a 1}\
6407    {b::b 1}\
6408    {c::c 1}\
6409    {a::a 1}\
6410    {b::b 1}\
6411    {d::d 1}\
6412    {e::e 1}\
6413    {z::a::(1,_derived) = ::z::d}\
6414    {z::a::(1,m) = z}\
6415    {z::b::(1,_derived) = ::z::d}\
6416    {z::b::(1,n) = z}\
6417    {z::c::(1,_derived) = ::z::e}\
6418    {z::c::(1,o) = 1 2}\
6419    {z::d::(1,_derived) = ::z::e}\
6420    {z::d::(1,p) = z}\
6421    {z::e::(1,q) = z}\
6422    {e::~e 1}\
6423    {d::~d 1}\
6424    {b::~b 1}\
6425    {a::~a 1}\
6426    {c::~c 1}\
6427    {b::~b 1}\
6428    {a::~a 1}\
6429    {A::A 2}\
6430    {B::B 2}\
6431    {C::C 2}\
6432    {A::A 2}\
6433    {B::B 2}\
6434    {D::D 2}\
6435    {E::E 2}\
6436    {A::(2,_derived) = ::Z::D}\
6437    {A::(2,m) = z}\
6438    {B::(2,_derived) = ::Z::D}\
6439    {B::(2,n) = z}\
6440    {C::(2,_derived) = ::Z::E}\
6441    {C::(2,o) = 1 2}\
6442    {D::(2,_derived) = ::Z::E}\
6443    {D::(2,p) = z}\
6444    {E::(2,q) = z}\
6445    {E::~E 2}\
6446    {D::~D 2}\
6447    {B::~B 2}\
6448    {A::~A 2}\
6449    {C::~C 2}\
6450    {B::~B 2}\
6451    {A::~A 2}\
6452    {A::A 3}\
6453    {B::B 3}\
6454    {C::C 3}\
6455    {A::A 3}\
6456    {B::B 3}\
6457    {D::D 3}\
6458    {E::E 3}\
6459    {Z::A::(3,_derived) = ::Z::D}\
6460    {Z::A::(3,m) = z}\
6461    {Z::B::(3,_derived) = ::Z::D}\
6462    {Z::B::(3,n) = z}\
6463    {Z::C::(3,_derived) = ::Z::E}\
6464    {Z::C::(3,o) = 1 2}\
6465    {Z::D::(3,_derived) = ::Z::E}\
6466    {Z::D::(3,p) = z}\
6467    {Z::E::(3,q) = z}\
6468    {E::~E 3}\
6469    {D::~D 3}\
6470    {B::~B 3}\
6471    {A::~A 3}\
6472    {C::~C 3}\
6473    {B::~B 3}\
6474    {A::~A 3}\
6475]
6476
6477test stooop-74 {
6478    check that optional arguments in constructors and multiple inheritance work
6479    together
6480} {
6481    set interpreter [interp create]
6482    $interpreter eval "source $source; namespace import stooop::*"
6483    $interpreter eval $dumpArraysCode
6484    set result [$interpreter eval {
6485        class z {}
6486        class z::a {}
6487        proc z::a::a {this {p 0}} {
6488            lappend ::result "a::a $this"
6489            set ($this,m) $p
6490        }
6491        proc z::a::~a {this} {
6492            lappend ::result "a::~a $this"
6493        }
6494        class z::b {}
6495        proc z::b::b {this {p 1}} {
6496            lappend ::result "b::b $this"
6497            set ($this,n) $p
6498        }
6499        proc z::b::~b {this} {
6500            lappend ::result "b::~b $this"
6501        }
6502        class z::c {}
6503        proc z::c::c {this {p 2} {q 3}} z::a {$p} z::b {$q} {
6504            lappend ::result "c::c $this"
6505            set ($this,o) $p
6506            set ($this,p) $q
6507        }
6508        proc z::c::~c {this} {
6509            lappend ::result "c::~c $this"
6510        }
6511        set o [new z::c {x y} z]
6512        eval lappend ::result [dumpArrays z::a:: z::b:: z::c::]
6513        delete $o
6514        set o [new z::c]
6515        eval lappend ::result [dumpArrays z::a:: z::b:: z::c::]
6516
6517        class Z {
6518            class A {
6519                proc A {this {p 0}} {
6520                    lappend ::result "A::A $this"
6521                    set ($this,m) $p
6522                }
6523                proc ~A {this} {
6524                    lappend ::result "A::~A $this"
6525                }
6526            }
6527            class B {
6528                proc B {this {p 1}} {
6529                    lappend ::result "B::B $this"
6530                    set ($this,n) $p
6531                }
6532                proc ~B {this} {
6533                    lappend ::result "B::~B $this"
6534                }
6535            }
6536            class C {
6537                proc C {this {p 2} {q 3}} Z::A {$p} Z::B {$q} {
6538                    lappend ::result "C::C $this"
6539                    set ($this,o) $p
6540                    set ($this,p) $q
6541                }
6542                proc ~C {this} {
6543                    lappend ::result "C::~C $this"
6544                }
6545            }
6546            set o [new C {x y} z]
6547            eval lappend ::result [dumpArrays A:: B:: C::]
6548            delete $o
6549            set o [new C]
6550            eval lappend ::result [dumpArrays A:: B:: C::]
6551            delete $o
6552        }
6553        set o [new Z::C {x y} z]
6554        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C::]
6555        delete $o
6556        set o [new Z::C]
6557        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C::]
6558
6559        set ::result
6560    }]
6561    interp delete $interpreter
6562    set result
6563} [list\
6564    {a::a 1}\
6565    {b::b 1}\
6566    {c::c 1}\
6567    {z::a::(1,_derived) = ::z::c}\
6568    {z::a::(1,m) = x y}\
6569    {z::b::(1,_derived) = ::z::c}\
6570    {z::b::(1,n) = z}\
6571    {z::c::(1,o) = x y}\
6572    {z::c::(1,p) = z}\
6573    {c::~c 1}\
6574    {b::~b 1}\
6575    {a::~a 1}\
6576    {a::a 2}\
6577    {b::b 2}\
6578    {c::c 2}\
6579    {z::a::(2,_derived) = ::z::c}\
6580    {z::a::(2,m) = 2}\
6581    {z::b::(2,_derived) = ::z::c}\
6582    {z::b::(2,n) = 3}\
6583    {z::c::(2,o) = 2}\
6584    {z::c::(2,p) = 3}\
6585    {A::A 3}\
6586    {B::B 3}\
6587    {C::C 3}\
6588    {A::(3,_derived) = ::Z::C}\
6589    {A::(3,m) = x y}\
6590    {B::(3,_derived) = ::Z::C}\
6591    {B::(3,n) = z}\
6592    {C::(3,o) = x y}\
6593    {C::(3,p) = z}\
6594    {C::~C 3}\
6595    {B::~B 3}\
6596    {A::~A 3}\
6597    {A::A 4}\
6598    {B::B 4}\
6599    {C::C 4}\
6600    {A::(4,_derived) = ::Z::C}\
6601    {A::(4,m) = 2}\
6602    {B::(4,_derived) = ::Z::C}\
6603    {B::(4,n) = 3}\
6604    {C::(4,o) = 2}\
6605    {C::(4,p) = 3}\
6606    {C::~C 4}\
6607    {B::~B 4}\
6608    {A::~A 4}\
6609    {A::A 5}\
6610    {B::B 5}\
6611    {C::C 5}\
6612    {Z::A::(5,_derived) = ::Z::C}\
6613    {Z::A::(5,m) = x y}\
6614    {Z::B::(5,_derived) = ::Z::C}\
6615    {Z::B::(5,n) = z}\
6616    {Z::C::(5,o) = x y}\
6617    {Z::C::(5,p) = z}\
6618    {C::~C 5}\
6619    {B::~B 5}\
6620    {A::~A 5}\
6621    {A::A 6}\
6622    {B::B 6}\
6623    {C::C 6}\
6624    {Z::A::(6,_derived) = ::Z::C}\
6625    {Z::A::(6,m) = 2}\
6626    {Z::B::(6,_derived) = ::Z::C}\
6627    {Z::B::(6,n) = 3}\
6628    {Z::C::(6,o) = 2}\
6629    {Z::C::(6,p) = 3}\
6630]
6631
6632test stooop-75 {
6633    check various virtual procedures configurations in a 3 level deep class
6634    hierarchy
6635} {
6636    set interpreter [interp create]
6637    $interpreter eval "source $source; namespace import stooop::*"
6638    set result [$interpreter eval {
6639        class z {}
6640        class z::a {}
6641        proc z::a::a {this} {}
6642        proc z::a::~a {this} {}
6643        virtual proc z::a::f {this p q} {}
6644        virtual proc z::a::g {this p q}
6645        virtual proc z::a::h {this p q} {
6646            lappend ::result "a::h $this $p $q"
6647        }
6648        virtual proc z::a::i {this p q} {
6649            lappend ::result "a::i $this $p $q"
6650        }
6651        virtual proc z::a::k {this p q}
6652        virtual proc z::a::l {this p q} {
6653            lappend ::result "a::l $this $p $q"
6654        }
6655        class z::b {}
6656        proc z::b::b {this} z::a {} {}
6657        proc z::b::~b {this} {}
6658        virtual proc z::b::f {this p q} {
6659            lappend ::result "b::f $this $p $q"
6660        }
6661        virtual proc z::b::g {this p q}
6662        virtual proc z::b::h {this p q} {
6663            lappend ::result "b::h $this $p $q"
6664        }
6665        proc z::b::i {this p q} {
6666            lappend ::result "b::i $this $p $q"
6667        }
6668        virtual proc z::b::k {this p q} {
6669            lappend ::result "b::k $this $p $q"
6670        }
6671        virtual proc z::b::l {this p q}
6672        class z::c {}
6673        proc z::c::c {this} z::b {} {}
6674        proc z::c::~c {this} {}
6675        proc z::c::f {this p q} {
6676            lappend ::result "c::f $this $p $q"
6677        }
6678        proc z::c::g {this p q} {
6679            lappend ::result "c::g $this $p $q"
6680        }
6681        proc z::c::i {this p q} {
6682            lappend ::result "c::i $this $p $q"
6683        }
6684        proc z::c::k {this p q} {
6685            lappend ::result "c::k $this $p $q"
6686        }
6687        proc z::c::l {this p q} {
6688            lappend ::result "c::l $this $p $q"
6689        }
6690        set o [new z::c]
6691        z::a::f $o x {y z}
6692        z::a::g $o x {y z}
6693        z::a::h $o x {y z}
6694        z::a::i $o x {y z}
6695        z::a::k $o x {y z}
6696        z::a::l $o x {y z}
6697
6698        class Z {
6699            class A {
6700                proc A {this} {}
6701                proc ~A {this} {}
6702                virtual proc f {this p q} {}
6703                virtual proc g {this p q}
6704                virtual proc h {this p q} {
6705                    lappend ::result "A::h $this $p $q"
6706                }
6707                virtual proc i {this p q} {
6708                    lappend ::result "A::i $this $p $q"
6709                }
6710                virtual proc k {this p q}
6711                virtual proc l {this p q} {
6712                    lappend ::result "A::l $this $p $q"
6713                }
6714            }
6715            class B {
6716                proc B {this} Z::A {} {}
6717                proc ~B {this} {}
6718                virtual proc f {this p q} {
6719                    lappend ::result "B::f $this $p $q"
6720                }
6721                virtual proc g {this p q}
6722                virtual proc h {this p q} {
6723                    lappend ::result "B::h $this $p $q"
6724                }
6725                proc i {this p q} {
6726                    lappend ::result "B::i $this $p $q"
6727                }
6728                virtual proc k {this p q} {
6729                    lappend ::result "B::k $this $p $q"
6730                }
6731                virtual proc l {this p q}
6732            }
6733            class C {
6734                proc C {this} Z::B {} {}
6735                proc ~C {this} {}
6736                proc f {this p q} {
6737                    lappend ::result "C::f $this $p $q"
6738                }
6739                proc g {this p q} {
6740                    lappend ::result "C::g $this $p $q"
6741                }
6742                proc i {this p q} {
6743                    lappend ::result "C::i $this $p $q"
6744                }
6745                proc k {this p q} {
6746                    lappend ::result "C::k $this $p $q"
6747                }
6748                proc l {this p q} {
6749                    lappend ::result "C::l $this $p $q"
6750                }
6751            }
6752            set o [new C]
6753            A::f $o x {y z}
6754            A::g $o x {y z}
6755            A::h $o x {y z}
6756            A::i $o x {y z}
6757            A::k $o x {y z}
6758            A::l $o x {y z}
6759        }
6760        set o [new Z::C]
6761        Z::A::f $o x {y z}
6762        Z::A::g $o x {y z}
6763        Z::A::h $o x {y z}
6764        Z::A::i $o x {y z}
6765        Z::A::k $o x {y z}
6766        Z::A::l $o x {y z}
6767
6768        set ::result
6769    }]
6770    interp delete $interpreter
6771    set result
6772} [list\
6773    {c::f 1 x y z}\
6774    {c::g 1 x y z}\
6775    {b::h 1 x y z}\
6776    {b::i 1 x y z}\
6777    {c::k 1 x y z}\
6778    {c::l 1 x y z}\
6779    {C::f 2 x y z}\
6780    {C::g 2 x y z}\
6781    {B::h 2 x y z}\
6782    {B::i 2 x y z}\
6783    {C::k 2 x y z}\
6784    {C::l 2 x y z}\
6785    {C::f 3 x y z}\
6786    {C::g 3 x y z}\
6787    {B::h 3 x y z}\
6788    {B::i 3 x y z}\
6789    {C::k 3 x y z}\
6790    {C::l 3 x y z}\
6791]
6792
6793test stooop-76 {
6794    check various virtual procedures with variable number of arguments
6795    configurations in a 3 level deep class hierarchy
6796} {
6797    set interpreter [interp create]
6798    $interpreter eval "source $source; namespace import stooop::*"
6799    set result [$interpreter eval {
6800        class z {}
6801        class z::a {}
6802        proc z::a::a {this} {}
6803        proc z::a::~a {this} {}
6804        virtual proc z::a::f {this p args} {}
6805        virtual proc z::a::g {this p args}
6806        virtual proc z::a::h {this p args} {
6807            lappend ::result "a::h $this $p $args"
6808        }
6809        virtual proc z::a::i {this p args} {
6810            lappend ::result "a::i $this $p $args"
6811        }
6812        virtual proc z::a::k {this p args}
6813        virtual proc z::a::l {this p args} {
6814            lappend ::result "a::l $this $p $args"
6815        }
6816        class z::b {}
6817        proc z::b::b {this} z::a {} {}
6818        proc z::b::~b {this} {}
6819        virtual proc z::b::f {this p args} {
6820            lappend ::result "b::f $this $p $args"
6821        }
6822        virtual proc z::b::g {this p args}
6823        virtual proc z::b::h {this p args} {
6824            lappend ::result "b::h $this $p $args"
6825        }
6826        proc z::b::i {this p args} {
6827            lappend ::result "b::i $this $p $args"
6828        }
6829        virtual proc z::b::k {this p args} {
6830            lappend ::result "b::k $this $p $args"
6831        }
6832        virtual proc z::b::l {this p args}
6833        class z::c {}
6834        proc z::c::c {this} z::b {} {}
6835        proc z::c::~c {this} {}
6836        proc z::c::f {this p args} {
6837            lappend ::result "c::f $this $p $args"
6838        }
6839        proc z::c::g {this p args} {
6840            lappend ::result "c::g $this $p $args"
6841        }
6842        proc z::c::i {this p args} {
6843            lappend ::result "c::i $this $p $args"
6844        }
6845        proc z::c::k {this p args} {
6846            lappend ::result "c::k $this $p $args"
6847        }
6848        proc z::c::l {this p args} {
6849            lappend ::result "c::l $this $p $args"
6850        }
6851        set o [new z::c]
6852        z::a::f $o x {y z}
6853        z::a::g $o x {y z}
6854        z::a::h $o x {y z}
6855        z::a::i $o x {y z}
6856        z::a::k $o x {y z}
6857        z::a::l $o x {y z}
6858
6859        class Z {
6860            class A {
6861                proc A {this} {}
6862                proc ~A {this} {}
6863                virtual proc f {this p args} {}
6864                virtual proc g {this p args}
6865                virtual proc h {this p args} {
6866                    lappend ::result "A::h $this $p $args"
6867                }
6868                virtual proc i {this p args} {
6869                    lappend ::result "A::i $this $p $args"
6870                }
6871                virtual proc k {this p args}
6872                virtual proc l {this p args} {
6873                    lappend ::result "A::l $this $p $args"
6874                }
6875            }
6876            class B {
6877                proc B {this} Z::A {} {}
6878                proc ~B {this} {}
6879                virtual proc f {this p args} {
6880                    lappend ::result "B::f $this $p $args"
6881                }
6882                virtual proc g {this p args}
6883                virtual proc h {this p args} {
6884                    lappend ::result "B::h $this $p $args"
6885                }
6886                proc i {this p args} {
6887                    lappend ::result "B::i $this $p $args"
6888                }
6889                virtual proc k {this p args} {
6890                    lappend ::result "B::k $this $p $args"
6891                }
6892                virtual proc l {this p args}
6893            }
6894            class C {
6895                proc C {this} Z::B {} {}
6896                proc ~C {this} {}
6897                proc f {this p args} {
6898                    lappend ::result "C::f $this $p $args"
6899                }
6900                proc g {this p args} {
6901                    lappend ::result "C::g $this $p $args"
6902                }
6903                proc i {this p args} {
6904                    lappend ::result "C::i $this $p $args"
6905                }
6906                proc k {this p args} {
6907                    lappend ::result "C::k $this $p $args"
6908                }
6909                proc l {this p args} {
6910                    lappend ::result "C::l $this $p $args"
6911                }
6912            }
6913            set o [new C]
6914            A::f $o x {y z}
6915            A::g $o x {y z}
6916            A::h $o x {y z}
6917            A::i $o x {y z}
6918            A::k $o x {y z}
6919            A::l $o x {y z}
6920        }
6921        set o [new Z::C]
6922        Z::A::f $o x {y z}
6923        Z::A::g $o x {y z}
6924        Z::A::h $o x {y z}
6925        Z::A::i $o x {y z}
6926        Z::A::k $o x {y z}
6927        Z::A::l $o x {y z}
6928
6929        set ::result
6930    }]
6931    interp delete $interpreter
6932    set result
6933} [list\
6934    {c::f 1 x {y z}}\
6935    {c::g 1 x {y z}}\
6936    {b::h 1 x {y z}}\
6937    {b::i 1 x {y z}}\
6938    {c::k 1 x {y z}}\
6939    {c::l 1 x {y z}}\
6940    {C::f 2 x {y z}}\
6941    {C::g 2 x {y z}}\
6942    {B::h 2 x {y z}}\
6943    {B::i 2 x {y z}}\
6944    {C::k 2 x {y z}}\
6945    {C::l 2 x {y z}}\
6946    {C::f 3 x {y z}}\
6947    {C::g 3 x {y z}}\
6948    {B::h 3 x {y z}}\
6949    {B::i 3 x {y z}}\
6950    {C::k 3 x {y z}}\
6951    {C::l 3 x {y z}}\
6952]
6953
6954test stooop-77 {
6955    check normal and user defined cloning operation with multiple inheritance
6956    and member objects
6957} {
6958    set interpreter [interp create]
6959    $interpreter eval "source $source; namespace import stooop::*"
6960    $interpreter eval $dumpArraysCode
6961    set result [$interpreter eval {
6962        class z {}
6963        class z::a {}
6964        proc z::a::a {this p} {
6965            set ($this,m) $p
6966        }
6967        class z::b {}
6968        proc z::b::b {this p} {
6969            set ($this,n) $p
6970        }
6971        class z::c {}
6972        proc z::c::c {this p q r} z::a {$p} z::b {$q} {
6973            set ($this,o) $r
6974            set ($this,O) [new z::f]
6975        }
6976        proc z::c::c {this copy} z::a {$z::a::($copy,m)} z::b 1 {
6977            set ($this,o) $($copy,o)
6978            set ($this,O) [new z::f]
6979        }
6980        class z::d {}
6981        proc z::d::d {this p q r} z::a {$p} z::b {$q} {
6982            set ($this,p) $p
6983        }
6984        class z::e {}
6985        proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} {
6986            set ($this,q) $q
6987        }
6988        class z::f {}
6989        proc z::f::f {this} {
6990            set ($this,x) 0
6991        }
6992        new [new z::e {x y} z {1 2}]
6993        eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e:: z::f::]
6994
6995        class Z {
6996            class A {
6997                proc A {this p} {
6998                    set ($this,m) $p
6999                }
7000            }
7001            class B {
7002                proc B {this p} {
7003                    set ($this,n) $p
7004                }
7005            }
7006            class C {
7007                proc C {this p q r} Z::A {$p} Z::B {$q} {
7008                    set ($this,o) $r
7009                    set ($this,O) [new Z::F]
7010                }
7011                proc C {this copy} Z::A {$Z::A::($copy,m)} Z::B 1 {
7012                    set ($this,o) $($copy,o)
7013                    set ($this,O) [new Z::F]
7014                }
7015            }
7016            class D {
7017                proc D {this p q r} Z::A {$p} Z::B {$q} {
7018                    set ($this,p) $p
7019                }
7020            }
7021            class E {
7022                proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} {
7023                    set ($this,q) $q
7024                }
7025            }
7026            class F {
7027                proc F {this} {
7028                    set ($this,x) 0
7029                }
7030            }
7031            new [new E {x y} z {1 2}]
7032            eval lappend ::result [dumpArrays A:: B:: C:: D:: E:: F::]
7033        }
7034        new [new Z::E {x y} z {1 2}]
7035        eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E:: Z::F::]
7036
7037        set ::result
7038    }]
7039    interp delete $interpreter
7040    set result
7041} [list\
7042    {z::a::(1,_derived) = ::z::d}\
7043    {z::a::(1,m) = z}\
7044    {z::a::(3,_derived) = ::z::d}\
7045    {z::a::(3,m) = z}\
7046    {z::b::(1,_derived) = ::z::d}\
7047    {z::b::(1,n) = z}\
7048    {z::b::(3,_derived) = ::z::d}\
7049    {z::b::(3,n) = z}\
7050    {z::c::(1,O) = 2}\
7051    {z::c::(1,_derived) = ::z::e}\
7052    {z::c::(1,o) = 1 2}\
7053    {z::c::(3,O) = 4}\
7054    {z::c::(3,_derived) = ::z::e}\
7055    {z::c::(3,o) = 1 2}\
7056    {z::d::(1,_derived) = ::z::e}\
7057    {z::d::(1,p) = z}\
7058    {z::d::(3,_derived) = ::z::e}\
7059    {z::d::(3,p) = z}\
7060    {z::e::(1,q) = z}\
7061    {z::e::(3,q) = z}\
7062    {z::f::(2,x) = 0}\
7063    {z::f::(4,x) = 0}\
7064    {A::(5,_derived) = ::Z::D}\
7065    {A::(5,m) = z}\
7066    {A::(7,_derived) = ::Z::D}\
7067    {A::(7,m) = z}\
7068    {B::(5,_derived) = ::Z::D}\
7069    {B::(5,n) = z}\
7070    {B::(7,_derived) = ::Z::D}\
7071    {B::(7,n) = z}\
7072    {C::(5,O) = 6}\
7073    {C::(5,_derived) = ::Z::E}\
7074    {C::(5,o) = 1 2}\
7075    {C::(7,O) = 8}\
7076    {C::(7,_derived) = ::Z::E}\
7077    {C::(7,o) = 1 2}\
7078    {D::(5,_derived) = ::Z::E}\
7079    {D::(5,p) = z}\
7080    {D::(7,_derived) = ::Z::E}\
7081    {D::(7,p) = z}\
7082    {E::(5,q) = z}\
7083    {E::(7,q) = z}\
7084    {F::(6,x) = 0}\
7085    {F::(8,x) = 0}\
7086    {Z::A::(11,_derived) = ::Z::D}\
7087    {Z::A::(11,m) = z}\
7088    {Z::A::(5,_derived) = ::Z::D}\
7089    {Z::A::(5,m) = z}\
7090    {Z::A::(7,_derived) = ::Z::D}\
7091    {Z::A::(7,m) = z}\
7092    {Z::A::(9,_derived) = ::Z::D}\
7093    {Z::A::(9,m) = z}\
7094    {Z::B::(11,_derived) = ::Z::D}\
7095    {Z::B::(11,n) = z}\
7096    {Z::B::(5,_derived) = ::Z::D}\
7097    {Z::B::(5,n) = z}\
7098    {Z::B::(7,_derived) = ::Z::D}\
7099    {Z::B::(7,n) = z}\
7100    {Z::B::(9,_derived) = ::Z::D}\
7101    {Z::B::(9,n) = z}\
7102    {Z::C::(11,O) = 12}\
7103    {Z::C::(11,_derived) = ::Z::E}\
7104    {Z::C::(11,o) = 1 2}\
7105    {Z::C::(5,O) = 6}\
7106    {Z::C::(5,_derived) = ::Z::E}\
7107    {Z::C::(5,o) = 1 2}\
7108    {Z::C::(7,O) = 8}\
7109    {Z::C::(7,_derived) = ::Z::E}\
7110    {Z::C::(7,o) = 1 2}\
7111    {Z::C::(9,O) = 10}\
7112    {Z::C::(9,_derived) = ::Z::E}\
7113    {Z::C::(9,o) = 1 2}\
7114    {Z::D::(11,_derived) = ::Z::E}\
7115    {Z::D::(11,p) = z}\
7116    {Z::D::(5,_derived) = ::Z::E}\
7117    {Z::D::(5,p) = z}\
7118    {Z::D::(7,_derived) = ::Z::E}\
7119    {Z::D::(7,p) = z}\
7120    {Z::D::(9,_derived) = ::Z::E}\
7121    {Z::D::(9,p) = z}\
7122    {Z::E::(11,q) = z}\
7123    {Z::E::(5,q) = z}\
7124    {Z::E::(7,q) = z}\
7125    {Z::E::(9,q) = z}\
7126    {Z::F::(10,x) = 0}\
7127    {Z::F::(12,x) = 0}\
7128    {Z::F::(6,x) = 0}\
7129    {Z::F::(8,x) = 0}\
7130]
7131
7132test stooop-78 {
7133    check that virtual procedure invocations from base class constructor behave
7134    as in C++
7135} {
7136    set interpreter [interp create]
7137    $interpreter eval "source $source; namespace import stooop::*"
7138    set result [$interpreter eval {
7139        class z {}
7140        class z::a {}
7141        proc z::a::a {this} {
7142            z::a::f $this x
7143            z::a::g $this x {y z}
7144            # pure virtual invocations behavior is undefined
7145            lappend ::result [catch {z::a::h $this x}]
7146            lappend ::result [catch {z::a::i $this x {y z}}]
7147        }
7148        proc z::a::~a {this} {}
7149        virtual proc z::a::f {this p} {
7150            lappend ::result "a::f $this $p"
7151        }
7152        virtual proc z::a::g {this p args} {
7153            lappend ::result "a::g $this $p $args"
7154        }
7155        virtual proc z::a::h {this p}
7156        virtual proc z::a::i {this p args}
7157        class z::b {}
7158        proc z::b::b {this} z::a {} {}
7159        proc z::b::~b {this} {}
7160        virtual proc z::b::f {this p} {
7161            lappend ::result "b::f $this $p"
7162        }
7163        virtual proc z::b::g {this p args} {
7164            lappend ::result "b::g $this $p $args"
7165        }
7166        virtual proc z::b::h {this p} {
7167            lappend ::result "b::h $this $p"
7168        }
7169        proc z::b::i {this p args} {
7170            lappend ::result "b::i $this $p $args"
7171        }
7172        new z::b
7173
7174        class Z {
7175            class A {
7176                proc A {this} {
7177                    f $this x
7178                    g $this x {y z}
7179                    # pure virtual invocations behavior is undefined
7180                    lappend ::result [catch {A::h $this x}]
7181                    lappend ::result [catch {A::i $this x {y z}}]
7182                }
7183                proc ~A {this} {}
7184                virtual proc f {this p} {
7185                    lappend ::result "A::f $this $p"
7186                }
7187                virtual proc g {this p args} {
7188                    lappend ::result "A::g $this $p $args"
7189                }
7190                virtual proc h {this p}
7191                virtual proc i {this p args}
7192            }
7193            class B {
7194                proc B {this} Z::A {} {}
7195                proc ~B {this} {}
7196                virtual proc f {this p} {
7197                    lappend ::result "B::f $this $p"
7198                }
7199                virtual proc g {this p args} {
7200                    lappend ::result "B::g $this $p $args"
7201                }
7202                virtual proc h {this p} {
7203                    lappend ::result "B::h $this $p"
7204                }
7205                proc i {this p args} {
7206                    lappend ::result "B::i $this $p $args"
7207                }
7208            }
7209            new B
7210        }
7211        new Z::B
7212
7213        set ::result
7214    }]
7215    interp delete $interpreter
7216    set result
7217} [list\
7218    {a::f 1 x}\
7219    {a::g 1 x {y z}}\
7220    {1}\
7221    {1}\
7222    {A::f 2 x}\
7223    {A::g 2 x {y z}}\
7224    {1}\
7225    {1}\
7226    {A::f 3 x}\
7227    {A::g 3 x {y z}}\
7228    {1}\
7229    {1}\
7230]
7231
7232test stooop-79 {
7233    check that child nested class is visible within parent namespace
7234} {
7235    set interpreter [interp create]
7236    $interpreter eval "source $source; namespace import stooop::*"
7237    set result [$interpreter eval {
7238        class a {}
7239        proc a::a {this} {
7240            lappend ::result "a::a $this"
7241            new b
7242        }
7243        class a::b {}
7244        proc a::b::b {this} {
7245            lappend ::result "b::b $this"
7246        }
7247        new a
7248
7249        class a {
7250            proc a {this} {
7251                lappend ::result "a::a $this"
7252                new b
7253            }
7254            class b {
7255                proc b {this} {
7256                    lappend ::result "b::b $this"
7257                }
7258            }
7259            new a
7260        }
7261
7262        set ::result
7263    }]
7264    interp delete $interpreter
7265    set result
7266} [list\
7267    {a::a 1}\
7268    {b::b 2}\
7269    {a::a 3}\
7270    {b::b 4}\
7271]
7272
7273test stooop-80 {
7274    verify regular member procedure checking in procedure checking debug mode
7275} {
7276    set interpreter [interp create]
7277    $interpreter eval {
7278        # reset any existing environment variables:
7279        foreach name [array names env STOOOP*] {unset env($name)}
7280        set env(STOOOPCHECKPROCEDURES) 1
7281    }
7282    $interpreter eval "source $source; namespace import stooop::*"
7283    set result [$interpreter eval {
7284        class a {}
7285        proc a::a {this} {}
7286        proc a::p {this} {}
7287        class b {}
7288        proc b::b {this} {}
7289        proc b::p {this} {}
7290        set o [new a]
7291        a::p $o
7292        catch {b::p $o} message
7293        lappend ::result $message
7294
7295        class A {
7296            proc A {this} {}
7297            proc p {this} {}
7298        }
7299        class B {
7300            proc B {this} {}
7301            proc p {this} {}
7302        }
7303        set o [new A]
7304        A::p $o
7305        catch {B::p $o} message
7306        lappend ::result $message
7307
7308        class c {}
7309        class c::d {}
7310        proc c::d::d {this} {}
7311        proc c::d::p {this} {}
7312        class c::e {}
7313        proc c::e::e {this} {}
7314        proc c::e::p {this} {}
7315        set o [new c::d]
7316        c::d::p $o
7317        catch {c::e::p $o} message
7318        lappend ::result $message
7319
7320        class C {
7321            class D {
7322                proc D {this} {}
7323                proc p {this} {}
7324            }
7325            class E {
7326                proc E {this} {}
7327                proc p {this} {}
7328            }
7329            set o [new D]
7330            D::p $o
7331            catch {E::p $o} message
7332            lappend ::result $message
7333        }
7334        set o [new C::D]
7335        C::D::p $o
7336        catch {C::E::p $o} message
7337        lappend ::result $message
7338
7339        set ::result
7340    }]
7341    interp delete $interpreter
7342    set result
7343} [list\
7344    {class b of ::b::p procedure not an ancestor of object 1 class a}\
7345    {class B of ::B::p procedure not an ancestor of object 2 class A}\
7346    {class c::e of ::c::e::p procedure not an ancestor of object 3 class c::d}\
7347    {class C::E of ::C::E::p procedure not an ancestor of object 4 class C::D}\
7348    {class C::E of ::C::E::p procedure not an ancestor of object 5 class C::D}\
7349]
7350
7351test stooop-81 {
7352    verify regular member procedure checking within class hierarchy in
7353    procedure checking debug mode
7354} {
7355    set interpreter [interp create]
7356    $interpreter eval {
7357        # reset any existing environment variables:
7358        foreach name [array names env STOOOP*] {unset env($name)}
7359        set env(STOOOPCHECKPROCEDURES) 1
7360    }
7361    $interpreter eval "source $source; namespace import stooop::*"
7362    set result [$interpreter eval {
7363        class a {}
7364        proc a::a {this} {}
7365        proc a::~a {this} {}
7366        proc a::p {this} {}
7367        class b {}
7368        proc b::b {this} a {} {}
7369        proc b::~b {this} {}
7370        proc b::p {this} {}
7371        class c {}
7372        proc c::c {this} b {} {}
7373        proc c::~c {this} {}
7374        proc c::p {this} {}
7375        set o [new a]
7376        a::p $o
7377        catch {b::p $o} message
7378        lappend ::result $message
7379        catch {c::p $o} message
7380        lappend ::result $message
7381        delete $o
7382        set o [new b]
7383        a::p $o
7384        b::p $o
7385        catch {c::p $o} message
7386        lappend ::result $message
7387        delete $o
7388        set o [new c]
7389        a::p $o
7390        b::p $o
7391        c::p $o
7392        delete $o
7393
7394        class a {
7395            proc a {this} {}
7396            proc ~a {this} {}
7397            proc p {this} {}
7398        }
7399        class b {
7400            proc b {this} a {} {}
7401            proc ~b {this} {}
7402            proc p {this} {}
7403        }
7404        class c {
7405            proc c {this} b {} {}
7406            proc ~c {this} {}
7407            proc p {this} {}
7408        }
7409        set o [new a]
7410        a::p $o
7411        catch {b::p $o} message
7412        lappend ::result $message
7413        catch {c::p $o} message
7414        lappend ::result $message
7415        delete $o
7416        set o [new b]
7417        a::p $o
7418        b::p $o
7419        catch {c::p $o} message
7420        lappend ::result $message
7421        delete $o
7422        set o [new c]
7423        a::p $o
7424        b::p $o
7425        c::p $o
7426        delete $o
7427
7428        class d {}
7429        class d::e {}
7430        proc d::e::e {this} {}
7431        proc d::e::~e {this} {}
7432        proc d::e::p {this} {}
7433        class d::f {}
7434        proc d::f::f {this} d::e {} {}
7435        proc d::f::~f {this} {}
7436        proc d::f::p {this} {}
7437        class d::g {}
7438        proc d::g::g {this} d::f {} {}
7439        proc d::g::~g {this} {}
7440        proc d::g::p {this} {}
7441        set o [new d::e]
7442        d::e::p $o
7443        catch {d::f::p $o} message
7444        lappend ::result $message
7445        catch {d::g::p $o} message
7446        lappend ::result $message
7447        delete $o
7448        set o [new d::f]
7449        d::e::p $o
7450        d::f::p $o
7451        catch {d::g::p $o} message
7452        lappend ::result $message
7453        delete $o
7454        set o [new d::g]
7455        d::e::p $o
7456        d::f::p $o
7457        d::g::p $o
7458        delete $o
7459
7460        class C {
7461            class D {
7462                proc D {this} {}
7463                proc ~D {this} {}
7464                proc p {this} {}
7465            }
7466            class E {
7467                proc E {this} C::D {} {}
7468                proc ~E {this} {}
7469                proc p {this} {}
7470            }
7471            class F {
7472                proc F {this} C::E {} {}
7473                proc ~F {this} {}
7474                proc p {this} {}
7475            }
7476            set o [new D]
7477            D::p $o
7478            catch {E::p $o} message
7479            lappend ::result $message
7480            catch {F::p $o} message
7481            lappend ::result $message
7482            delete $o
7483            set o [new E]
7484            D::p $o
7485            E::p $o
7486            catch {F::p $o} message
7487            lappend ::result $message
7488            delete $o
7489            set o [new F]
7490            D::p $o
7491            E::p $o
7492            F::p $o
7493            delete $o
7494        }
7495        set o [new C::D]
7496        C::D::p $o
7497        catch {C::E::p $o} message
7498        lappend ::result $message
7499        catch {C::F::p $o} message
7500        lappend ::result $message
7501        delete $o
7502        set o [new C::E]
7503        C::D::p $o
7504        C::E::p $o
7505        catch {C::F::p $o} message
7506        lappend ::result $message
7507        delete $o
7508        set o [new C::F]
7509        C::D::p $o
7510        C::E::p $o
7511        C::F::p $o
7512        delete $o
7513
7514        set ::result
7515    }]
7516    interp delete $interpreter
7517    set result
7518} [list\
7519    {class b of ::b::p procedure not an ancestor of object 1 class a}\
7520    {class c of ::c::p procedure not an ancestor of object 1 class a}\
7521    {class c of ::c::p procedure not an ancestor of object 2 class b}\
7522    {class b of ::b::p procedure not an ancestor of object 4 class a}\
7523    {class c of ::c::p procedure not an ancestor of object 4 class a}\
7524    {class c of ::c::p procedure not an ancestor of object 5 class b}\
7525    {class d::f of ::d::f::p procedure not an ancestor of object 7 class d::e}\
7526    {class d::g of ::d::g::p procedure not an ancestor of object 7 class d::e}\
7527    {class d::g of ::d::g::p procedure not an ancestor of object 8 class d::f}\
7528    {class C::E of ::C::E::p procedure not an ancestor of object 10 class C::D}\
7529    {class C::F of ::C::F::p procedure not an ancestor of object 10 class C::D}\
7530    {class C::F of ::C::F::p procedure not an ancestor of object 11 class C::E}\
7531    {class C::E of ::C::E::p procedure not an ancestor of object 13 class C::D}\
7532    {class C::F of ::C::F::p procedure not an ancestor of object 13 class C::D}\
7533    {class C::F of ::C::F::p procedure not an ancestor of object 14 class C::E}\
7534]
7535
7536test stooop-82 {
7537    verify regular member procedure checking within multiple inheritance class
7538    hierarchy in procedure checking debug mode
7539} {
7540    set interpreter [interp create]
7541    $interpreter eval {
7542        # reset any existing environment variables:
7543        foreach name [array names env STOOOP*] {unset env($name)}
7544        set env(STOOOPCHECKPROCEDURES) 1
7545    }
7546    $interpreter eval "source $source; namespace import stooop::*"
7547    set result [$interpreter eval {
7548        class a {}
7549        proc a::a {this} {}
7550        proc a::p {this} {}
7551        class b {}
7552        proc b::b {this} {}
7553        proc b::p {this} {}
7554        class c {}
7555        proc c::c {this} a {} b {} {}
7556        proc c::p {this} {}
7557        set o [new a]
7558        a::p $o
7559        catch {b::p $o} message
7560        lappend ::result $message
7561        catch {c::p $o} message
7562        lappend ::result $message
7563
7564        class A {
7565            proc A {this} {}
7566            proc p {this} {}
7567        }
7568        class B {
7569            proc B {this} {}
7570            proc p {this} {}
7571        }
7572        class C {
7573            proc C {this} A {} B {} {}
7574            proc p {this} {}
7575        }
7576        set o [new A]
7577        A::p $o
7578        catch {B::p $o} message
7579        lappend ::result $message
7580        catch {C::p $o} message
7581        lappend ::result $message
7582
7583        class d {}
7584        class d::e {}
7585        proc d::e::e {this} {}
7586        proc d::e::p {this} {}
7587        class d::f {}
7588        proc d::f::f {this} {}
7589        proc d::f::p {this} {}
7590        class d::g {}
7591        proc d::g::g {this} d::e {} d::f {} {}
7592        proc d::g::p {this} {}
7593        set o [new d::e]
7594        d::e::p $o
7595        catch {d::f::p $o} message
7596        lappend ::result $message
7597        catch {d::g::p $o} message
7598        lappend ::result $message
7599
7600        class D {
7601            class E {
7602                proc E {this} {}
7603                proc p {this} {}
7604            }
7605            class F {
7606                proc F {this} {}
7607                proc p {this} {}
7608            }
7609            class G {
7610                proc G {this} D::E {} D::F {} {}
7611                proc p {this} {}
7612            }
7613            set o [new E]
7614            E::p $o
7615            catch {F::p $o} message
7616            lappend ::result $message
7617            catch {G::p $o} message
7618            lappend ::result $message
7619        }
7620        set o [new D::E]
7621        D::E::p $o
7622        catch {D::F::p $o} message
7623        lappend ::result $message
7624        catch {D::G::p $o} message
7625        lappend ::result $message
7626
7627        set ::result
7628    }]
7629    interp delete $interpreter
7630    set result
7631} [list\
7632    {class b of ::b::p procedure not an ancestor of object 1 class a}\
7633    {class c of ::c::p procedure not an ancestor of object 1 class a}\
7634    {class B of ::B::p procedure not an ancestor of object 2 class A}\
7635    {class C of ::C::p procedure not an ancestor of object 2 class A}\
7636    {class d::f of ::d::f::p procedure not an ancestor of object 3 class d::e}\
7637    {class d::g of ::d::g::p procedure not an ancestor of object 3 class d::e}\
7638    {class D::F of ::D::F::p procedure not an ancestor of object 4 class D::E}\
7639    {class D::G of ::D::G::p procedure not an ancestor of object 4 class D::E}\
7640    {class D::F of ::D::F::p procedure not an ancestor of object 5 class D::E}\
7641    {class D::G of ::D::G::p procedure not an ancestor of object 5 class D::E}\
7642]
7643
7644test stooop-83 {
7645    verify object identifier checking in procedure checking debug mode
7646} {
7647    set interpreter [interp create]
7648    $interpreter eval {
7649        # reset any existing environment variables:
7650        foreach name [array names env STOOOP*] {unset env($name)}
7651        set env(STOOOPCHECKPROCEDURES) 1
7652    }
7653    $interpreter eval "source $source; namespace import stooop::*"
7654    set result [$interpreter eval {
7655        class a {}
7656        proc a::a {this} {}
7657        proc a::p {this} {}
7658        catch {a::p 1} message
7659        lappend ::result $message
7660
7661        class A {
7662            proc A {this} {}
7663            proc p {this} {}
7664        }
7665        catch {A::p 2} message
7666        lappend ::result $message
7667
7668        class b {}
7669        class b::c {}
7670        proc b::c::c {this} {}
7671        proc b::c::p {this} {}
7672        catch {b::c::p 3} message
7673        lappend ::result $message
7674
7675        class B {
7676            class C {
7677                proc C {this} {}
7678                proc p {this} {}
7679            }
7680            catch {C::p 4} message
7681            lappend ::result $message
7682        }
7683        catch {B::C::p 5} message
7684        lappend ::result $message
7685
7686        set ::result
7687    }]
7688    interp delete $interpreter
7689    set result
7690} [list\
7691    {1 is not a valid object identifier}\
7692    {2 is not a valid object identifier}\
7693    {3 is not a valid object identifier}\
7694    {4 is not a valid object identifier}\
7695    {5 is not a valid object identifier}\
7696]
7697
7698test stooop-84 {
7699    verify virtual member procedure checking in procedure checking debug mode
7700} {
7701    set interpreter [interp create]
7702    $interpreter eval {
7703        # reset any existing environment variables:
7704        foreach name [array names env STOOOP*] {unset env($name)}
7705        set env(STOOOPCHECKPROCEDURES) 1
7706    }
7707    $interpreter eval "source $source; namespace import stooop::*"
7708    set result [$interpreter eval {
7709        class a {}
7710        proc a::a {this} {}
7711        proc a::~a {this} {}
7712        virtual proc a::p {this} {
7713            lappend ::result "a::p $this"
7714        }
7715        virtual proc a::q {this}
7716        virtual proc a::r {this} {
7717            lappend ::result "a::r $this"
7718        }
7719        class b {}
7720        proc b::b {this} a {} {}
7721        proc b::~b {this} {}
7722        proc b::p {this} {
7723            lappend ::result "b::p $this"
7724        }
7725        proc b::q {this} {
7726            lappend ::result "b::q $this"
7727        }
7728        set o [new b]
7729        a::p $o
7730        a::q $o
7731        a::r $o
7732        b::p $o
7733        b::q $o
7734        delete $o
7735        catch {a::p $o} message; lappend ::result $message
7736        catch {a::q $o} message; lappend ::result $message
7737        catch {a::r $o} message; lappend ::result $message
7738        catch {b::p $o} message; lappend ::result $message
7739        catch {b::q $o} message; lappend ::result $message
7740
7741        class A {
7742            proc A {this} {}
7743            proc ~A {this} {}
7744            virtual proc p {this} {
7745                lappend ::result "A::p $this"
7746            }
7747            virtual proc q {this}
7748            virtual proc r {this} {
7749                lappend ::result "A::r $this"
7750            }
7751        }
7752        class B {
7753            proc B {this} A {} {}
7754            proc ~B {this} {}
7755            proc p {this} {
7756                lappend ::result "B::p $this"
7757            }
7758            proc q {this} {
7759                lappend ::result "B::q $this"
7760            }
7761        }
7762        set o [new B]
7763        A::p $o
7764        A::q $o
7765        A::r $o
7766        B::p $o
7767        B::q $o
7768        delete $o
7769        catch {A::p $o} message; lappend ::result $message
7770        catch {A::q $o} message; lappend ::result $message
7771        catch {A::r $o} message; lappend ::result $message
7772        catch {B::p $o} message; lappend ::result $message
7773        catch {B::q $o} message; lappend ::result $message
7774
7775        class c {}
7776        class c::d {}
7777        proc c::d::d {this} {}
7778        proc c::d::~d {this} {}
7779        virtual proc c::d::p {this} {
7780            lappend ::result "d::p $this"
7781        }
7782        virtual proc c::d::q {this}
7783        virtual proc c::d::r {this} {
7784            lappend ::result "d::r $this"
7785        }
7786        class c::e {}
7787        proc c::e::e {this} c::d {} {}
7788        proc c::e::~e {this} {}
7789        proc c::e::p {this} {
7790            lappend ::result "e::p $this"
7791        }
7792        proc c::e::q {this} {
7793            lappend ::result "e::q $this"
7794        }
7795        set o [new c::e]
7796        c::d::p $o
7797        c::d::q $o
7798        c::d::r $o
7799        c::e::p $o
7800        c::e::q $o
7801        delete $o
7802        catch {c::d::p $o} message; lappend ::result $message
7803        catch {c::d::q $o} message; lappend ::result $message
7804        catch {c::d::r $o} message; lappend ::result $message
7805        catch {c::e::p $o} message; lappend ::result $message
7806        catch {c::e::q $o} message; lappend ::result $message
7807
7808        class C {
7809            class D {
7810                proc D {this} {}
7811                proc ~D {this} {}
7812                virtual proc p {this} {
7813                    lappend ::result "D::p $this"
7814                }
7815                virtual proc q {this}
7816                virtual proc r {this} {
7817                    lappend ::result "D::r $this"
7818                }
7819            }
7820            class E {
7821                proc E {this} C::D {} {}
7822                proc ~E {this} {}
7823                proc p {this} {
7824                    lappend ::result "E::p $this"
7825                }
7826                proc q {this} {
7827                    lappend ::result "E::q $this"
7828                }
7829            }
7830            set o [new E]
7831            D::p $o
7832            D::q $o
7833            D::r $o
7834            E::p $o
7835            E::q $o
7836            delete $o
7837            catch {D::p $o} message; lappend ::result $message
7838            catch {D::q $o} message; lappend ::result $message
7839            catch {D::r $o} message; lappend ::result $message
7840            catch {E::p $o} message; lappend ::result $message
7841            catch {E::q $o} message; lappend ::result $message
7842        }
7843        set o [new C::E]
7844        C::D::p $o
7845        C::D::q $o
7846        C::D::r $o
7847        C::E::p $o
7848        C::E::q $o
7849        delete $o
7850        catch {C::D::p $o} message; lappend ::result $message
7851        catch {C::D::q $o} message; lappend ::result $message
7852        catch {C::D::r $o} message; lappend ::result $message
7853        catch {C::E::p $o} message; lappend ::result $message
7854        catch {C::E::q $o} message; lappend ::result $message
7855
7856        set ::result
7857    }]
7858    interp delete $interpreter
7859    set result
7860} [list\
7861    {b::p 1}\
7862    {b::q 1}\
7863    {a::r 1}\
7864    {b::p 1}\
7865    {b::q 1}\
7866    {1 is not a valid object identifier}\
7867    {1 is not a valid object identifier}\
7868    {1 is not a valid object identifier}\
7869    {1 is not a valid object identifier}\
7870    {1 is not a valid object identifier}\
7871    {B::p 2}\
7872    {B::q 2}\
7873    {A::r 2}\
7874    {B::p 2}\
7875    {B::q 2}\
7876    {2 is not a valid object identifier}\
7877    {2 is not a valid object identifier}\
7878    {2 is not a valid object identifier}\
7879    {2 is not a valid object identifier}\
7880    {2 is not a valid object identifier}\
7881    {e::p 3}\
7882    {e::q 3}\
7883    {d::r 3}\
7884    {e::p 3}\
7885    {e::q 3}\
7886    {3 is not a valid object identifier}\
7887    {3 is not a valid object identifier}\
7888    {3 is not a valid object identifier}\
7889    {3 is not a valid object identifier}\
7890    {3 is not a valid object identifier}\
7891    {E::p 4}\
7892    {E::q 4}\
7893    {D::r 4}\
7894    {E::p 4}\
7895    {E::q 4}\
7896    {4 is not a valid object identifier}\
7897    {4 is not a valid object identifier}\
7898    {4 is not a valid object identifier}\
7899    {4 is not a valid object identifier}\
7900    {4 is not a valid object identifier}\
7901    {E::p 5}\
7902    {E::q 5}\
7903    {D::r 5}\
7904    {E::p 5}\
7905    {E::q 5}\
7906    {5 is not a valid object identifier}\
7907    {5 is not a valid object identifier}\
7908    {5 is not a valid object identifier}\
7909    {5 is not a valid object identifier}\
7910    {5 is not a valid object identifier}\
7911]
7912
7913test stooop-85 {
7914    verify pure interface class object creation in procedure checking debug mode
7915} {
7916    set interpreter [interp create]
7917    $interpreter eval {
7918        # reset any existing environment variables:
7919        foreach name [array names env STOOOP*] {unset env($name)}
7920        set env(STOOOPCHECKPROCEDURES) 1
7921    }
7922    $interpreter eval "source $source; namespace import stooop::*"
7923    set result [$interpreter eval {
7924        class a {}
7925        proc a::a {this} {
7926            lappend ::result "a::a $this"
7927        }
7928        proc a::~a {this} {}
7929        virtual proc a::p {this} {}
7930        set o [new a]
7931        delete $o
7932        virtual proc a::q {this}
7933        catch {new a} message
7934        lappend ::result $message
7935
7936        class A {
7937            proc A {this} {
7938                lappend ::result "A::A $this"
7939            }
7940            proc ~A {this} {}
7941            virtual proc p {this} {}
7942        }
7943        set o [new A]
7944        delete $o
7945        class A {
7946            virtual proc q {this}
7947        }
7948        catch {new A} message
7949        lappend ::result $message
7950
7951        class b {}
7952        class b::c {}
7953        proc b::c::c {this} {
7954            lappend ::result "c::c $this"
7955        }
7956        proc b::c::~c {this} {}
7957        virtual proc b::c::p {this} {}
7958        set o [new b::c]
7959        delete $o
7960        virtual proc b::c::q {this}
7961        catch {new b::c} message
7962        lappend ::result $message
7963
7964        class B {
7965            class C {
7966                proc C {this} {
7967                    lappend ::result "C::C $this"
7968                }
7969                proc ~C {this} {}
7970                virtual proc p {this} {}
7971            }
7972            set o [new C]
7973            delete $o
7974            class C {
7975                virtual proc q {this}
7976            }
7977            catch {new C} message
7978            lappend ::result $message
7979        }
7980        catch {new B::C} message
7981        lappend ::result $message
7982
7983        set ::result
7984    }]
7985    interp delete $interpreter
7986    set result
7987} [list\
7988    {a::a 1}\
7989    {class ::a with pure virtual procedures should not be instanciated}\
7990    {A::A 2}\
7991    {class ::A with pure virtual procedures should not be instanciated}\
7992    {c::c 3}\
7993    {class ::b::c with pure virtual procedures should not be instanciated}\
7994    {C::C 4}\
7995    {class ::B::C with pure virtual procedures should not be instanciated}\
7996    {class ::B::C with pure virtual procedures should not be instanciated}\
7997]
7998
7999test stooop-86 {
8000    verify member writing and unsetting within class procedures in member data
8001    checking mode
8002    (it seems that unset tracing prevents error reporting at this time (bug?))
8003} {
8004    set interpreter [interp create]
8005    $interpreter eval {
8006        # reset any existing environment variables:
8007        foreach name [array names env STOOOP*] {unset env($name)}
8008        set env(STOOOPCHECKDATA) 1
8009    }
8010    $interpreter eval "source $source; namespace import stooop::*"
8011    set result [$interpreter eval {
8012        class a {}
8013        proc a::a {this} {}
8014        proc a::~a {this} {}
8015        proc a::p {this} {
8016            set b::($this,m) 0
8017        }
8018        proc a::q {this} {
8019            set b::(n) 0
8020        }
8021        proc a::r {this} {
8022            unset b::($this,m)
8023        }
8024        proc a::s {this} {
8025            unset b::(n)
8026        }
8027        set o [new a]
8028        class b {}
8029        set b::($o,m) 0
8030        set b::(n) 0
8031        catch {a::p $o} message; lappend ::result $message
8032        catch {a::q $o} message; lappend ::result $message
8033        catch {a::r $o} message; lappend ::result bug
8034        catch {a::s $o} message; lappend ::result bug
8035        delete $o
8036
8037        class A {
8038            proc A {this} {}
8039            proc ~A {this} {}
8040            proc p {this} {
8041                set B::($this,m) 0
8042            }
8043            proc q {this} {
8044                set B::(n) 0
8045            }
8046            proc r {this} {
8047                unset B::($this,m)
8048            }
8049            proc s {this} {
8050                unset B::(n)
8051            }
8052        }
8053        set o [new A]
8054        class B {
8055            set ($o,m) 0
8056            set (n) 0
8057        }
8058        class A {
8059            catch {p $o} message; lappend ::result $message
8060            catch {q $o} message; lappend ::result $message
8061            catch {r $o} message; lappend ::result bug
8062            catch {s $o} message; lappend ::result bug
8063        }
8064        delete $o
8065
8066        class c {}
8067        class c::d {}
8068        proc c::d::d {this} {}
8069        proc c::d::~d {this} {}
8070        proc c::d::p {this} {
8071            set c::e::($this,m) 0
8072        }
8073        proc c::d::q {this} {
8074            set c::e::(n) 0
8075        }
8076        proc c::d::r {this} {
8077            unset c::e::($this,m)
8078        }
8079        proc c::d::s {this} {
8080            unset c::e::(n)
8081        }
8082        class c::e {}
8083        set o [new c::d]
8084        set c::e::($o,m) 0
8085        set c::e::(n) 0
8086        catch {c::d::p $o} message; lappend ::result $message
8087        catch {c::d::q $o} message; lappend ::result $message
8088        catch {c::d::r $o} message; lappend ::result bug
8089        catch {c::d::s $o} message; lappend ::result bug
8090        delete $o
8091
8092        class C {
8093            class D {
8094                proc D {this} {}
8095                proc ~D {this} {}
8096                proc p {this} {
8097                    set C::E::($this,m) 0
8098                }
8099                proc q {this} {
8100                    set C::E::(n) 0
8101                }
8102                proc r {this} {
8103                    unset C::E::($this,m)
8104                }
8105                proc s {this} {
8106                    unset C::E::(n)
8107                }
8108            }
8109            set ::o [new D]
8110            class E {
8111                set ($o,m) 0
8112                set (n) 0
8113            }
8114            class D {
8115                catch {p $o} message; lappend ::result $message
8116                catch {q $o} message; lappend ::result $message
8117                catch {r $o} message; lappend ::result bug
8118                catch {s $o} message; lappend ::result bug
8119            }
8120        }
8121        catch {C::D::p $o} message; lappend ::result $message
8122        catch {C::D::q $o} message; lappend ::result $message
8123        catch {C::D::r $o} message; lappend ::result bug
8124        catch {C::D::s $o} message; lappend ::result bug
8125        delete $o
8126
8127        set ::result
8128    }]
8129    interp delete $interpreter
8130    set result
8131} [list\
8132    {can't set "b::(1,m)": class access violation in procedure ::a::p}\
8133    {can't set "b::(n)": class access violation in procedure ::a::q}\
8134    bug\
8135    bug\
8136    {can't set "B::(2,m)": class access violation in procedure ::A::p}\
8137    {can't set "B::(n)": class access violation in procedure ::A::q}\
8138    bug\
8139    bug\
8140    {can't set "c::e::(3,m)": class access violation in procedure ::c::d::p}\
8141    {can't set "c::e::(n)": class access violation in procedure ::c::d::q}\
8142    bug\
8143    bug\
8144    {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\
8145    {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\
8146    bug\
8147    bug\
8148    {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\
8149    {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\
8150    bug\
8151    bug\
8152]
8153
8154test 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?))} {
8155    set interpreter [interp create]
8156    $interpreter eval {
8157        # reset any existing environment variables:
8158        foreach name [array names env STOOOP*] {unset env($name)}
8159        set env(STOOOPCHECKDATA) 1
8160    }
8161    $interpreter eval "source $source; namespace import stooop::*"
8162    set result [$interpreter eval {
8163        class a {
8164            set (m) 0
8165        }
8166        proc a::a {this} {
8167            set ($this,n) 0
8168        }
8169        proc a::~a {this} {}
8170        set o [new a]
8171        catch {class b {incr a::(m)}} message; lappend ::result $message
8172        catch {class b {incr a::($o,n)}} message; lappend ::result $message
8173        catch {class b {unset a::(m)}} message; lappend ::result bug
8174        catch {class b {unset a::($o,n)}} message; lappend ::result bug
8175        delete $o
8176
8177        class A {
8178            set (m) 0
8179            proc A {this} {
8180                set ($this,n) 0
8181            }
8182            proc ~A {this} {}
8183        }
8184        set o [new A]
8185        class B {
8186            catch {incr A::(m)} message; lappend ::result $message
8187            catch {incr A::($o,n)} message; lappend ::result $message
8188            catch {unset A::(m)} message; lappend ::result bug
8189            catch {unset A::($o,n)} message; lappend ::result bug
8190        }
8191        delete $o
8192
8193        class c {}
8194        class c::d {
8195            set (m) 0
8196        }
8197        proc c::d::d {this} {
8198            set ($this,n) 0
8199        }
8200        proc c::d::~d {this} {}
8201        set o [new c::d]
8202        catch {class c::e {incr c::d::(m)}} message; lappend ::result $message
8203        catch {class c::e {incr c::d::($o,n)}} message; lappend ::result $message
8204        catch {class c::e {unset c::d::(m)}} message; lappend ::result bug
8205        catch {class c::e {unset c::d::($o,n)}} message; lappend ::result bug
8206        delete $o
8207
8208        class C {
8209            class D {
8210                set (m) 0
8211                proc D {this} {
8212                    set ($this,n) 0
8213                }
8214                proc ~D {this} {}
8215            }
8216            set ::o [new D]
8217            class B {
8218                catch {incr C::D::(m)} message; lappend ::result $message
8219                catch {incr C::D::($o,n)} message; lappend ::result $message
8220                catch {unset C::D::(m)} message; lappend ::result bug
8221                catch {unset C::D::($o,n)} message; lappend ::result bug
8222            }
8223        }
8224        catch {set C::D::(m)} message; lappend ::result $message
8225        catch {set C::D::($o,n)} message; lappend ::result $message
8226        catch {unset C::D::(m)} message; lappend ::result bug
8227        catch {unset C::D::($o,n)} message; lappend ::result bug
8228        delete $o
8229
8230        set ::result
8231    }]
8232    interp delete $interpreter
8233    set result
8234} [list\
8235    {can't set "a::(m)": class access violation in class b namespace}\
8236    {can't set "a::(1,n)": class access violation in class b namespace}\
8237    bug\
8238    bug\
8239    {can't set "A::(m)": class access violation in class B namespace}\
8240    {can't set "A::(2,n)": class access violation in class B namespace}\
8241    bug\
8242    bug\
8243    {can't set "c::d::(m)": class access violation in class c::e namespace}\
8244    {can't set "c::d::(3,n)": class access violation in class c::e namespace}\
8245    bug\
8246    bug\
8247    {can't set "C::D::(m)": class access violation in class C::B namespace}\
8248    {can't set "C::D::(4,n)": class access violation in class C::B namespace}\
8249    bug\
8250    bug\
8251    {can't read "C::D::(m)": no such element in array}\
8252    {can't read "C::D::(4,n)": no such element in array}\
8253    bug\
8254    bug\
8255]
8256
8257test stooop-88 {
8258    verify that object copying still works in member data checking mode
8259} {
8260    set interpreter [interp create]
8261    $interpreter eval {
8262        # reset any existing environment variables:
8263        foreach name [array names env STOOOP*] {unset env($name)}
8264        set env(STOOOPCHECKDATA) 1
8265    }
8266    $interpreter eval "source $source; namespace import stooop::*"
8267    set result [$interpreter eval {
8268        class a {}
8269        proc a::a {this} {
8270            set ($this,n) 0
8271        }
8272        new [new a]
8273
8274        class A {
8275            proc A {this} {
8276                set ($this,n) 0
8277            }
8278        }
8279        new [new A]
8280
8281        class b {}
8282        class b::c {}
8283        proc b::c::c {this} {
8284            set ($this,n) 0
8285        }
8286        new [new b::c]
8287
8288        class B {
8289            class C {
8290                proc C {this} {
8291                    set ($this,n) 0
8292                }
8293            }
8294            new [new C]
8295        }
8296        new [new B::C]
8297
8298        set ::result {}
8299    }]
8300    interp delete $interpreter
8301    set result
8302} {}
8303
8304test stooop-89 {
8305    verify both data and procedure static access in member data checking mode
8306} {
8307    set interpreter [interp create]
8308    $interpreter eval {
8309        # reset any existing environment variables:
8310        foreach name [array names env STOOOP*] {unset env($name)}
8311        set env(STOOOPCHECKDATA) 1
8312    }
8313    $interpreter eval "source $source; namespace import stooop::*"
8314    set result [$interpreter eval {
8315        class a {
8316            set (m) 0
8317        }
8318        proc a::a {this} {
8319            set ($this,n) 0
8320        }
8321        proc a::~a {this} {}
8322        proc a::p {this} {
8323            incr (m)
8324            incr b::(o)
8325        }
8326        proc a::q {object} {
8327            incr ($object,n)
8328            incr b::($object,p)
8329        }
8330        class b {
8331            set (o) 0
8332        }
8333        proc b::b {this} a {} {
8334            set ($this,p) 0
8335        }
8336        proc b::~b {this} {}
8337        proc b::r {this} {
8338            incr (o)
8339            incr a::(m)
8340        }
8341        proc b::s {object} {
8342            incr ($object,p)
8343            incr a::($object,n)
8344        }
8345        set o [new b]
8346        catch {a::p $o} message; lappend ::result $message
8347        catch {a::q $o} message; lappend ::result $message
8348        catch {b::r $o} message; lappend ::result $message
8349        catch {b::s $o} message; lappend ::result $message
8350        delete $o
8351
8352        class A {
8353            set (m) 0
8354            proc A {this} {
8355                set ($this,n) 0
8356            }
8357            proc ~A {this} {}
8358            proc p {this} {
8359                incr (m)
8360                incr B::(o)
8361            }
8362            proc q {object} {
8363                incr ($object,n)
8364                incr B::($object,p)
8365            }
8366        }
8367        class B {
8368            set (o) 0
8369            proc B {this} A {} {
8370                set ($this,p) 0
8371            }
8372            proc ~B {this} {}
8373            proc r {this} {
8374                incr (o)
8375                incr A::(m)
8376            }
8377            proc s {object} {
8378                incr ($object,p)
8379                incr A::($object,n)
8380            }
8381        }
8382        set o [new B]
8383        catch {A::p $o} message; lappend ::result $message
8384        catch {A::q $o} message; lappend ::result $message
8385        catch {B::r $o} message; lappend ::result $message
8386        catch {B::s $o} message; lappend ::result $message
8387        delete $o
8388
8389        class c {}
8390        class c::d {
8391            set (m) 0
8392        }
8393        proc c::d::d {this} {
8394            set ($this,n) 0
8395        }
8396        proc c::d::~d {this} {}
8397        proc c::d::p {this} {
8398            incr (m)
8399            incr c::e::(o)
8400        }
8401        proc c::d::q {object} {
8402            incr ($object,n)
8403            incr c::e::($object,p)
8404        }
8405        class c::e {
8406            set (o) 0
8407        }
8408        proc c::e::e {this} c::d {} {
8409            set ($this,p) 0
8410        }
8411        proc c::e::~e {this} {}
8412        proc c::e::r {this} {
8413            incr (o)
8414            incr c::d::(m)
8415        }
8416        proc c::e::s {object} {
8417            incr ($object,p)
8418            incr c::d::($object,n)
8419        }
8420        set o [new c::e]
8421        catch {c::d::p $o} message; lappend ::result $message
8422        catch {c::d::q $o} message; lappend ::result $message
8423        catch {c::e::r $o} message; lappend ::result $message
8424        catch {c::e::s $o} message; lappend ::result $message
8425        delete $o
8426
8427        class C {
8428            class D {
8429                set (m) 0
8430                proc D {this} {
8431                    set ($this,n) 0
8432                }
8433                proc ~D {this} {}
8434                proc p {this} {
8435                    incr (m)
8436                    incr C::E::(o)
8437                }
8438                proc q {object} {
8439                    incr ($object,n)
8440                    incr C::E::($object,p)
8441                }
8442            }
8443            class E {
8444                set (o) 0
8445                proc E {this} C::D {} {
8446                    set ($this,p) 0
8447                }
8448                proc ~E {this} {}
8449                proc r {this} {
8450                    incr (o)
8451                    incr C::D::(m)
8452                }
8453                proc s {object} {
8454                    incr ($object,p)
8455                    incr C::D::($object,n)
8456                }
8457            }
8458            set ::o [new E]
8459            catch {D::p $o} message; lappend ::result $message
8460            catch {D::q $o} message; lappend ::result $message
8461            catch {E::r $o} message; lappend ::result $message
8462            catch {E::s $o} message; lappend ::result $message
8463        }
8464        catch {C::D::p $o} message; lappend ::result $message
8465        catch {C::D::q $o} message; lappend ::result $message
8466        catch {C::E::r $o} message; lappend ::result $message
8467        catch {C::E::s $o} message; lappend ::result $message
8468        delete $o
8469
8470        set ::result
8471    }]
8472    interp delete $interpreter
8473    set result
8474} [list\
8475    {can't set "b::(o)": class access violation in procedure ::a::p}\
8476    {can't set "b::(1,p)": class access violation in procedure ::a::q}\
8477    {can't set "a::(m)": class access violation in procedure ::b::r}\
8478    {can't set "a::(1,n)": class access violation in procedure ::b::s}\
8479    {can't set "B::(o)": class access violation in procedure ::A::p}\
8480    {can't set "B::(2,p)": class access violation in procedure ::A::q}\
8481    {can't set "A::(m)": class access violation in procedure ::B::r}\
8482    {can't set "A::(2,n)": class access violation in procedure ::B::s}\
8483    {can't set "c::e::(o)": class access violation in procedure ::c::d::p}\
8484    {can't set "c::e::(3,p)": class access violation in procedure ::c::d::q}\
8485    {can't set "c::d::(m)": class access violation in procedure ::c::e::r}\
8486    {can't set "c::d::(3,n)": class access violation in procedure ::c::e::s}\
8487    {can't set "C::E::(o)": class access violation in procedure ::C::D::p}\
8488    {can't set "C::E::(4,p)": class access violation in procedure ::C::D::q}\
8489    {can't set "C::D::(m)": class access violation in procedure ::C::E::r}\
8490    {can't set "C::D::(4,n)": class access violation in procedure ::C::E::s}\
8491    {can't set "C::E::(o)": class access violation in procedure ::C::D::p}\
8492    {can't set "C::E::(4,p)": class access violation in procedure ::C::D::q}\
8493    {can't set "C::D::(m)": class access violation in procedure ::C::E::r}\
8494    {can't set "C::D::(4,n)": class access violation in procedure ::C::E::s}\
8495]
8496
8497test stooop-90 {
8498    verify member data checking when "array set" is used
8499} {
8500    set interpreter [interp create]
8501    $interpreter eval {
8502        # reset any existing environment variables:
8503        foreach name [array names env STOOOP*] {unset env($name)}
8504        set env(STOOOPCHECKDATA) 1
8505    }
8506    $interpreter eval "source $source; namespace import stooop::*"
8507    set result [$interpreter eval {
8508        class a {}
8509        proc a::a {this} {}
8510        proc a::~a {this} {}
8511        proc a::p {this} {
8512            array set b:: "$this,m 0"
8513        }
8514        proc a::q {this} {
8515            array set b:: {n 0}
8516        }
8517        set o [new a]
8518        class b {}
8519        array set b:: "$o,m 0 n 0"
8520        catch {a::p $o} message; lappend ::result $message
8521        catch {a::q $o} message; lappend ::result $message
8522        delete $o
8523
8524        class A {
8525            proc A {this} {}
8526            proc ~A {this} {}
8527            proc p {this} {
8528                array set B:: "$this,m 0"
8529            }
8530            proc q {this} {
8531                array set B:: {n 0}
8532            }
8533        }
8534        set o [new A]
8535        class B {
8536            array set B:: "$o,m 0 n 0"
8537        }
8538        class A {
8539            catch {p $o} message; lappend ::result $message
8540            catch {q $o} message; lappend ::result $message
8541        }
8542        delete $o
8543
8544        class c {}
8545        class c::d {}
8546        proc c::d::d {this} {}
8547        proc c::d::~d {this} {}
8548        proc c::d::p {this} {
8549            array set c::e:: "$this,m 0"
8550        }
8551        proc c::d::q {this} {
8552            array set c::e:: {n 0}
8553        }
8554        class c::e {}
8555        set o [new c::d]
8556        array set c::e:: "$o,m 0 n 0"
8557        catch {c::d::p $o} message; lappend ::result $message
8558        catch {c::d::q $o} message; lappend ::result $message
8559        delete $o
8560
8561        class C {
8562            class D {
8563                proc D {this} {}
8564                proc ~D {this} {}
8565                proc p {this} {
8566                    array set C::E:: "$this,m 0"
8567                }
8568                proc q {this} {
8569                    array set C::E:: {n 0}
8570                }
8571            }
8572            set ::o [new D]
8573            class E {
8574                array set C::E:: "$o,m 0 n 0"
8575            }
8576            class D {
8577                catch {p $o} message; lappend ::result $message
8578                catch {q $o} message; lappend ::result $message
8579            }
8580        }
8581        catch {C::D::p $o} message; lappend ::result $message
8582        catch {C::D::q $o} message; lappend ::result $message
8583        delete $o
8584
8585        set ::result
8586    }]
8587    interp delete $interpreter
8588    set result
8589} [list\
8590    {can't set "b::(1,m)": class access violation in procedure ::a::p}\
8591    {can't set "b::(n)": class access violation in procedure ::a::q}\
8592    {can't set "B::(2,m)": class access violation in procedure ::A::p}\
8593    {can't set "B::(n)": class access violation in procedure ::A::q}\
8594    {can't set "c::e::(3,m)": class access violation in procedure ::c::d::p}\
8595    {can't set "c::e::(n)": class access violation in procedure ::c::d::q}\
8596    {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\
8597    {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\
8598    {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\
8599    {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\
8600]
8601
8602test stooop-91 {
8603    verify that packaged class works even in debugging mode
8604} {
8605    makeDirectory 91
8606    makeFile {package ifneeded 91 1 [list tclPkgSetup $dir 91 1 {{p.tcl source {::a::_copy ::a::a}}}]}\
8607        [file join 91 pkgIndex.tcl]
8608    makeFile {package provide 91 1; class a {proc a {this} {}}}\
8609        [file join 91 p.tcl]
8610    set interpreter [interp create]
8611    $interpreter eval {
8612        # search in test directory sub-directories:
8613        lappend auto_path [file dirname [info script]]
8614        # reset any existing environment variables:
8615        foreach name [array names env STOOOP*] {unset env($name)}
8616        set env(STOOOPCHECKPROCEDURES) 1
8617    }
8618    $interpreter eval "source $source; namespace import stooop::*"
8619    set result [$interpreter eval {
8620        package require 91
8621        new a
8622        set ::result {}
8623    }]
8624    interp delete $interpreter
8625    removeDirectory 91
8626    set result
8627} {}
8628
8629test stooop-92 {
8630    check that parameter passing by reference works with virtual declarations
8631} {
8632    set interpreter [interp create]
8633    $interpreter eval "source $source; namespace import stooop::*"
8634    $interpreter eval $dumpArraysCode
8635    set result [$interpreter eval {
8636        class a {}
8637        proc a::a {this} {}
8638        proc a::~a {this} {}
8639        virtual proc a::f {this a} {}
8640        virtual proc a::g {this a}
8641        virtual proc a::h {this a} {
8642            upvar $a d
8643            set d(0) 0
8644        }
8645        virtual proc a::i {this a} {}
8646        virtual proc a::j {this a}
8647        virtual proc a::k {this a} {}
8648        class b {}
8649        proc b::b {this} a {} {}
8650        proc b::~b {this} {}
8651        proc b::f {this a} {
8652            upvar $a d
8653            set d(1) 1
8654        }
8655        proc b::g {this a} {
8656            upvar $a d
8657            set d(2) 2
8658        }
8659        virtual proc b::i {this a} {}
8660        virtual proc b::j {this a}
8661        virtual proc b::k {this a} {
8662            upvar $a d
8663            set d(3) 3
8664        }
8665        class c {}
8666        proc c::c {this} b {} {}
8667        proc c::~c {this} {}
8668        proc c::i {this a} {
8669            upvar $a d
8670            set d(4) 4
8671        }
8672        proc c::j {this a} {
8673            upvar $a d
8674            set d(5) 5
8675        }
8676        set o [new c]
8677        a::f $o z
8678        a::g $o z
8679        a::h $o z
8680        a::i $o z
8681        a::j $o z
8682        a::k $o z
8683        eval lappend ::result [dumpArrays z]
8684
8685        class A {
8686            proc A {this} {}
8687            proc ~A {this} {}
8688            virtual proc f {this a} {}
8689            virtual proc g {this a}
8690            virtual proc h {this a} {
8691                upvar $a d
8692                set d(0) 0
8693            }
8694            virtual proc i {this a} {}
8695            virtual proc j {this a}
8696            virtual proc k {this a} {}
8697        }
8698        class B {
8699            proc B {this} A {} {}
8700            proc ~B {this} {}
8701            proc f {this a} {
8702                upvar $a d
8703                set d(1) 1
8704            }
8705            proc g {this a} {
8706                upvar $a d
8707                set d(2) 2
8708            }
8709            virtual proc i {this a} {}
8710            virtual proc j {this a}
8711            virtual proc k {this a} {
8712                upvar $a d
8713                set d(3) 3
8714            }
8715        }
8716        class C {
8717            proc C {this} B {} {}
8718            proc ~C {this} {}
8719            proc i {this a} {
8720                upvar $a d
8721                set d(4) 4
8722            }
8723            proc j {this a} {
8724                upvar $a d
8725                set d(5) 5
8726            }
8727        }
8728        set o [new C]
8729        A::f $o Z
8730        A::g $o Z
8731        A::h $o Z
8732        A::i $o Z
8733        A::j $o Z
8734        A::k $o Z
8735        eval lappend ::result [dumpArrays Z]
8736
8737        set ::result
8738    }]
8739    interp delete $interpreter
8740    set result
8741} [list\
8742    {z(0) = 0}\
8743    {z(1) = 1}\
8744    {z(2) = 2}\
8745    {z(3) = 3}\
8746    {z(4) = 4}\
8747    {z(5) = 5}\
8748    {Z(0) = 0}\
8749    {Z(1) = 1}\
8750    {Z(2) = 2}\
8751    {Z(3) = 3}\
8752    {Z(4) = 4}\
8753    {Z(5) = 5}\
8754]
8755
8756test stooop-93 {
8757    check that member procedure invocation within constructor does not break
8758    procedure checking debug mode
8759} {
8760    set interpreter [interp create]
8761    $interpreter eval {
8762        # reset any existing environment variables:
8763        foreach name [array names env STOOOP*] {unset env($name)}
8764        set env(STOOOPCHECKPROCEDURES) 1
8765    }
8766    $interpreter eval "source $source; namespace import stooop::*"
8767    set result [$interpreter eval {
8768        class a {}
8769        proc a::a {this} {
8770            p $this
8771            q
8772        }
8773        proc a::~a {this} {}
8774        proc a::p {this} {}
8775        proc a::q {} {}
8776        new a
8777
8778        class A {
8779            proc A {this} {
8780                p $this
8781                q
8782            }
8783            proc ~A {this} {}
8784            proc p {this} {}
8785            proc q {} {}
8786        }
8787        new A
8788
8789        class b {}
8790        class b::c {}
8791        proc b::c::c {this} {
8792            p $this
8793            q
8794        }
8795        proc b::c::~c {this} {}
8796        proc b::c::p {this} {}
8797        proc b::c::q {} {}
8798        new b::c
8799
8800        class B {
8801            class C {
8802                proc C {this} {
8803                    p $this
8804                    q
8805                }
8806                proc ~C {this} {}
8807                proc p {this} {}
8808                proc q {} {}
8809            }
8810        }
8811        new B::C
8812
8813        set ::result {}
8814    }]
8815    interp delete $interpreter
8816    set result
8817} {}
8818
8819test stooop-94 {
8820    basic objects checking
8821} {
8822    set interpreter [interp create]
8823    $interpreter eval {
8824        # reset any existing environment variables:
8825        foreach name [array names env STOOOP*] {unset env($name)}
8826        set env(STOOOPCHECKOBJECTS) 1
8827    }
8828    $interpreter eval "source $source; namespace import stooop::*"
8829    # alias puts to be able to collect standard output data:
8830    proc appendResult {string} {lappend ::result $string}
8831    $interpreter alias puts appendResult
8832    set result {}
8833    $interpreter eval {
8834        class a {}
8835        proc a::a {this} {}
8836        proc a::~a {this} {}
8837        proc p {} {
8838            new a
8839        }
8840        namespace eval n {
8841            proc p {} {
8842                new a
8843            }
8844        }
8845        stooop::record
8846        new a
8847        stooop::report
8848        p
8849        stooop::report
8850        n::p
8851        stooop::report
8852        stooop::record
8853        delete 1
8854        stooop::report
8855        delete 2
8856        stooop::report
8857        delete 3
8858        stooop::report
8859
8860        class A {
8861            proc A {this} {}
8862            proc ~A {this} {}
8863        }
8864        proc q {} {
8865            new A
8866        }
8867        namespace eval m {
8868            proc q {} {
8869                new A
8870            }
8871        }
8872        stooop::record
8873        new A
8874        stooop::report
8875        q
8876        stooop::report
8877        m::q
8878        stooop::report
8879        stooop::record
8880        delete 4
8881        stooop::report
8882        delete 5
8883        stooop::report
8884        delete 6
8885        stooop::report
8886    }
8887    interp delete $interpreter
8888    set result
8889} [list\
8890    {stooop::record invoked from top level}\
8891    {stooop::report invoked from top level:}\
8892    {+ ::a(1) + top level}\
8893    {stooop::report invoked from top level:}\
8894    {+ ::a(1) + top level}\
8895    {+ ::a(2) + ::p}\
8896    {stooop::report invoked from top level:}\
8897    {+ ::a(1) + top level}\
8898    {+ ::a(2) + ::p}\
8899    {+ ::a(3) + ::n::p}\
8900    {stooop::record invoked from top level}\
8901    {stooop::report invoked from top level:}\
8902    {- ::a(1) - top level + top level}\
8903    {stooop::report invoked from top level:}\
8904    {- ::a(1) - top level + top level}\
8905    {- ::a(2) - top level + ::p}\
8906    {stooop::report invoked from top level:}\
8907    {- ::a(1) - top level + top level}\
8908    {- ::a(2) - top level + ::p}\
8909    {- ::a(3) - top level + ::n::p}\
8910    {stooop::record invoked from top level}\
8911    {stooop::report invoked from top level:}\
8912    {+ ::A(4) + top level}\
8913    {stooop::report invoked from top level:}\
8914    {+ ::A(4) + top level}\
8915    {+ ::A(5) + ::q}\
8916    {stooop::report invoked from top level:}\
8917    {+ ::A(4) + top level}\
8918    {+ ::A(5) + ::q}\
8919    {+ ::A(6) + ::m::q}\
8920    {stooop::record invoked from top level}\
8921    {stooop::report invoked from top level:}\
8922    {- ::A(4) - top level + top level}\
8923    {stooop::report invoked from top level:}\
8924    {- ::A(4) - top level + top level}\
8925    {- ::A(5) - top level + ::q}\
8926    {stooop::report invoked from top level:}\
8927    {- ::A(4) - top level + top level}\
8928    {- ::A(5) - top level + ::q}\
8929    {- ::A(6) - top level + ::m::q}\
8930]
8931
8932test stooop-95 {
8933    objects checking from namespace body and namespace procedure
8934} {
8935    set interpreter [interp create]
8936    $interpreter eval {
8937        # reset any existing environment variables:
8938        foreach name [array names env STOOOP*] {unset env($name)}
8939        set env(STOOOPCHECKOBJECTS) 1
8940    }
8941    $interpreter eval "source $source; namespace import stooop::*"
8942    # alias puts to be able to collect standard output data:
8943    proc appendResult {string} {lappend ::result $string}
8944    $interpreter alias puts appendResult
8945    set result {}
8946    $interpreter eval {
8947        class a {
8948            proc a {this} {}
8949            proc ~a {this} {}
8950        }
8951        namespace eval n {
8952            proc p {} {
8953                new a
8954            }
8955            namespace eval m {
8956                proc q {} {
8957                    new a
8958                }
8959            }
8960        }
8961        stooop::record
8962        namespace eval n {
8963            new a
8964        }
8965        stooop::report
8966        n::p
8967        stooop::report
8968        namespace eval n::m {
8969            new a
8970        }
8971        stooop::report
8972        n::m::q
8973        stooop::report
8974        delete 1 2 3 4
8975    }
8976    interp delete $interpreter
8977    set result
8978} [list\
8979    {stooop::record invoked from top level}\
8980    {stooop::report invoked from top level:}\
8981    {+ ::a(1) + namespace ::n}\
8982    {stooop::report invoked from top level:}\
8983    {+ ::a(1) + namespace ::n}\
8984    {+ ::a(2) + ::n::p}\
8985    {stooop::report invoked from top level:}\
8986    {+ ::a(1) + namespace ::n}\
8987    {+ ::a(2) + ::n::p}\
8988    {+ ::a(3) + namespace ::n::m}\
8989    {stooop::report invoked from top level:}\
8990    {+ ::a(1) + namespace ::n}\
8991    {+ ::a(2) + ::n::p}\
8992    {+ ::a(3) + namespace ::n::m}\
8993    {+ ::a(4) + ::n::m::q}\
8994]
8995
8996test stooop-96 {
8997    objects checking from within derived class constructor
8998} {
8999    set interpreter [interp create]
9000    $interpreter eval {
9001        # reset any existing environment variables:
9002        foreach name [array names env STOOOP*] {unset env($name)}
9003        set env(STOOOPCHECKOBJECTS) 1
9004    }
9005    $interpreter eval "source $source; namespace import stooop::*"
9006    # alias puts to be able to collect standard output data:
9007    proc appendResult {string} {lappend ::result $string}
9008    $interpreter alias puts appendResult
9009    set result {}
9010    $interpreter eval {
9011        class a {
9012            proc a {this i} {}
9013            proc ~a {this} {}
9014        }
9015        class b {
9016            proc b {this} a {[new c]} {}
9017            proc ~b {this} {}
9018        }
9019        class c {
9020            proc c {this} {}
9021            proc ~c {this} {}
9022        }
9023        stooop::record
9024        new b
9025        stooop::report
9026
9027        class A {
9028            class a {
9029                proc a {this i} {}
9030                proc ~a {this} {}
9031            }
9032            class b {
9033                proc b {this} a {[new c]} {}
9034                proc ~b {this} {}
9035            }
9036            class c {
9037                proc c {this} {}
9038                proc ~c {this} {}
9039            }
9040            stooop::record
9041            new b
9042            stooop::report
9043        }
9044
9045    }
9046    interp delete $interpreter
9047    set result
9048} [list\
9049    {stooop::record invoked from top level}\
9050    {stooop::report invoked from top level:}\
9051    {+ ::b(1) + top level}\
9052    {+ ::c(2) + ::b::b}\
9053    {stooop::record invoked from namespace ::A}\
9054    {stooop::report invoked from namespace ::A:}\
9055    {+ ::A::b(3) + namespace ::A}\
9056    {+ ::c(4) + ::A::b::b}\
9057]
9058
9059test stooop-97 {
9060    objects checking with debugging procedures invocation from namespace body
9061    and namespace procedure
9062} {
9063    set interpreter [interp create]
9064    $interpreter eval {
9065        # reset any existing environment variables:
9066        foreach name [array names env STOOOP*] {unset env($name)}
9067        set env(STOOOPCHECKOBJECTS) 1
9068    }
9069    $interpreter eval "source $source; namespace import stooop::*"
9070    # alias puts to be able to collect standard output data:
9071    proc appendResult {string} {lappend ::result $string}
9072    $interpreter alias puts appendResult
9073    set result {}
9074    $interpreter eval {
9075        class a {
9076            proc a {this} {}
9077            proc ~a {this} {}
9078        }
9079        namespace eval n {
9080            proc p {} {
9081                stooop::record
9082                new a
9083                stooop::report
9084            }
9085            namespace eval m {
9086                proc q {} {
9087                    stooop::record
9088                    new a
9089                    stooop::report
9090                }
9091            }
9092        }
9093        n::p
9094        n::m::q
9095        namespace eval n {
9096            stooop::record
9097            new a
9098            stooop::report
9099        }
9100
9101    }
9102    interp delete $interpreter
9103    set result
9104} [list\
9105    {stooop::record invoked from ::n::p}\
9106    {stooop::report invoked from ::n::p:}\
9107    {+ ::a(1) + ::n::p}\
9108    {stooop::record invoked from ::n::m::q}\
9109    {stooop::report invoked from ::n::m::q:}\
9110    {+ ::a(2) + ::n::m::q}\
9111    {stooop::record invoked from namespace ::n}\
9112    {stooop::report invoked from namespace ::n:}\
9113    {+ ::a(3) + namespace ::n}\
9114]
9115
9116test stooop-98 {
9117    objects checking with missing and extra objects
9118} {
9119    set interpreter [interp create]
9120    $interpreter eval {
9121        # reset any existing environment variables:
9122        foreach name [array names env STOOOP*] {unset env($name)}
9123        set env(STOOOPCHECKOBJECTS) 1
9124    }
9125    $interpreter eval "source $source; namespace import stooop::*"
9126    # alias puts to be able to collect standard output data:
9127    proc appendResult {string} {lappend ::result $string}
9128    $interpreter alias puts appendResult
9129    set result {}
9130    $interpreter eval {
9131        class a {
9132            proc a {this} {}
9133            proc ~a {this} {}
9134        }
9135        stooop::record
9136        set o [new a]
9137        stooop::report
9138        stooop::record
9139        delete $o
9140        stooop::report
9141
9142    }
9143    interp delete $interpreter
9144    set result
9145} [list\
9146    {stooop::record invoked from top level}\
9147    {stooop::report invoked from top level:}\
9148    {+ ::a(1) + top level}\
9149    {stooop::record invoked from top level}\
9150    {stooop::report invoked from top level:}\
9151    {- ::a(1) - top level + top level}\
9152]
9153
9154test stooop-99 {
9155} {
9156    set interpreter [interp create]
9157    $interpreter eval {
9158        # reset any existing environment variables:
9159        foreach name [array names env STOOOP*] {unset env($name)}
9160        set env(STOOOPCHECKOBJECTS) 1
9161    }
9162    $interpreter eval "source $source; namespace import stooop::*"
9163    # alias puts to be able to collect standard output data:
9164    proc appendResult {string} {lappend ::result $string}
9165    $interpreter alias puts appendResult
9166    set result {}
9167    $interpreter eval {
9168        class a {}
9169        proc a::a {this} {}
9170        proc a::~a {this} {}
9171        proc p {} {
9172            new a
9173        }
9174        namespace eval n {
9175            proc p {} {
9176                new a
9177            }
9178        }
9179        stooop::printObjects
9180        new a
9181        stooop::printObjects
9182        p
9183        stooop::printObjects
9184        n::p
9185        stooop::printObjects
9186        delete 1
9187        stooop::printObjects
9188        delete 2
9189        stooop::printObjects
9190        delete 3
9191        stooop::printObjects
9192
9193        class A {
9194            proc A {this} {}
9195            proc ~A {this} {}
9196        }
9197        proc q {} {
9198            new A
9199        }
9200        namespace eval m {
9201            proc q {} {
9202                new A
9203            }
9204        }
9205        stooop::printObjects
9206        new A
9207        stooop::printObjects
9208        q
9209        stooop::printObjects
9210        m::q
9211        stooop::printObjects
9212        delete 4
9213        stooop::printObjects
9214        delete 5
9215        stooop::printObjects
9216        delete 6
9217        stooop::printObjects
9218
9219    }
9220    interp delete $interpreter
9221    set result
9222} [list\
9223    {stooop::printObjects invoked from top level:}\
9224    {stooop::printObjects invoked from top level:}\
9225    {::a(1) + top level}\
9226    {stooop::printObjects invoked from top level:}\
9227    {::a(1) + top level}\
9228    {::a(2) + ::p}\
9229    {stooop::printObjects invoked from top level:}\
9230    {::a(1) + top level}\
9231    {::a(2) + ::p}\
9232    {::a(3) + ::n::p}\
9233    {stooop::printObjects invoked from top level:}\
9234    {::a(2) + ::p}\
9235    {::a(3) + ::n::p}\
9236    {stooop::printObjects invoked from top level:}\
9237    {::a(3) + ::n::p}\
9238    {stooop::printObjects invoked from top level:}\
9239    {stooop::printObjects invoked from top level:}\
9240    {stooop::printObjects invoked from top level:}\
9241    {::A(4) + top level}\
9242    {stooop::printObjects invoked from top level:}\
9243    {::A(4) + top level}\
9244    {::A(5) + ::q}\
9245    {stooop::printObjects invoked from top level:}\
9246    {::A(4) + top level}\
9247    {::A(5) + ::q}\
9248    {::A(6) + ::m::q}\
9249    {stooop::printObjects invoked from top level:}\
9250    {::A(5) + ::q}\
9251    {::A(6) + ::m::q}\
9252    {stooop::printObjects invoked from top level:}\
9253    {::A(6) + ::m::q}\
9254    {stooop::printObjects invoked from top level:}\
9255]
9256
9257test stooop-100 {
9258    objects checking pattern matching
9259} {
9260    set interpreter [interp create]
9261    $interpreter eval {
9262        # reset any existing environment variables:
9263        foreach name [array names env STOOOP*] {unset env($name)}
9264        set env(STOOOPCHECKOBJECTS) 1
9265    }
9266    $interpreter eval "source $source; namespace import stooop::*"
9267    # alias puts to be able to collect standard output data:
9268    proc appendResult {string} {lappend ::result $string}
9269    $interpreter alias puts appendResult
9270    set result {}
9271    $interpreter eval {
9272        class aa {
9273            proc aa {this} {}
9274            proc ~aa {this} {}
9275        }
9276        class ab {
9277            proc ab {this} {}
9278            proc ~ab {this} {}
9279        }
9280        class bb {
9281            proc bb {this} {}
9282            proc ~bb {this} {}
9283        }
9284        stooop::record
9285        new aa
9286        new ab
9287        new bb
9288        stooop::printObjects ::a*
9289        stooop::printObjects ::*b
9290        stooop::report ::a*
9291        stooop::report ::*b
9292        stooop::record
9293        delete 1 2 3
9294        stooop::report ::a*
9295        stooop::report ::*b
9296
9297    }
9298    interp delete $interpreter
9299    set result
9300} [list\
9301    {stooop::record invoked from top level}\
9302    {stooop::printObjects invoked from top level:}\
9303    {::aa(1) + top level}\
9304    {::ab(2) + top level}\
9305    {stooop::printObjects invoked from top level:}\
9306    {::ab(2) + top level}\
9307    {::bb(3) + top level}\
9308    {stooop::report invoked from top level:}\
9309    {+ ::aa(1) + top level}\
9310    {+ ::ab(2) + top level}\
9311    {stooop::report invoked from top level:}\
9312    {+ ::ab(2) + top level}\
9313    {+ ::bb(3) + top level}\
9314    {stooop::record invoked from top level}\
9315    {stooop::report invoked from top level:}\
9316    {- ::aa(1) - top level + top level}\
9317    {- ::ab(2) - top level + top level}\
9318    {stooop::report invoked from top level:}\
9319    {- ::ab(2) - top level + top level}\
9320    {- ::bb(3) - top level + top level}\
9321]
9322
9323test stooop-101 {
9324    check that new lines within base class constructors arguments work without
9325    spacing
9326} {
9327    set interpreter [interp create]
9328    $interpreter eval "source $source; namespace import stooop::*"
9329    $interpreter eval $dumpArraysCode
9330    set result [$interpreter eval {
9331        class a {}
9332        proc a::a {this p q} {
9333            set ($this,m) $p
9334            set ($this,n) $q
9335        }
9336        class b {}
9337        proc b::b {this p q r} a {
9338        $p
9339        $q
9340        } {
9341            set ($this,o) $r
9342        }
9343        new b {x y} z {1 2}
9344        eval lappend ::result [dumpArrays a:: b::]
9345
9346        set ::result
9347    }]
9348    interp delete $interpreter
9349    set result
9350} [list\
9351    {a::(1,_derived) = ::b}\
9352    {a::(1,m) = x y}\
9353    {a::(1,n) = z}\
9354    {b::(1,o) = 1 2}\
9355]
9356
9357test stooop-102 {
9358    check that new lines within base class constructors arguments work without
9359    spacing, with a DOS formatted file
9360} {
9361    set interpreter [interp create]
9362    $interpreter eval "source $source; namespace import stooop::*"
9363    $interpreter eval $dumpArraysCode
9364    set result [$interpreter eval {
9365        class a {}
9366        proc a::a {this p q} {
9367            set ($this,m) $p
9368            set ($this,n) $q
9369        }
9370        class b {}
9371        proc b::b {this p q r} a {
9372        $p
9373        $q
9374        } {
9375            set ($this,o) $r
9376        }
9377        new b {x y} z {1 2}
9378        eval lappend ::result [dumpArrays a:: b::]
9379
9380        set ::result
9381    }]
9382    interp delete $interpreter
9383    set result
9384} [list\
9385    {a::(1,_derived) = ::b}\
9386    {a::(1,m) = x y}\
9387    {a::(1,n) = z}\
9388    {b::(1,o) = 1 2}\
9389]
9390
9391# -------------------------------------------------------------------------
9392
9393testsuiteCleanup
9394return
9395
9396# Local variables:
9397# mode: tcl
9398# End:
9399