diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2023-11-15 15:37:43 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2023-11-15 15:37:43 (GMT) |
commit | bb74d876c9a0891895000182060b2e612850a4a3 (patch) | |
tree | f6af350c893ec2f1a0cb79a1992bbb8c7bb70dde /tests | |
parent | 626503545bf984b3a4d1cf8f052544fa8b5b89e1 (diff) | |
parent | da8146f9dd5831b776f3369cd9e4d15ca8698f45 (diff) | |
download | tcl-bb74d876c9a0891895000182060b2e612850a4a3.zip tcl-bb74d876c9a0891895000182060b2e612850a4a3.tar.gz tcl-bb74d876c9a0891895000182060b2e612850a4a3.tar.bz2 |
Remnants from TIP 567's implementation
Diffstat (limited to 'tests')
-rw-r--r-- | tests/oo.test | 69 | ||||
-rw-r--r-- | tests/ooUtil.test | 23 |
2 files changed, 68 insertions, 24 deletions
diff --git a/tests/oo.test b/tests/oo.test index 291060d..cf8b710 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1685,9 +1685,7 @@ test oo-11.5 {OO: cleanup} { return done } done -test oo-11.6.1 { - OO: cleanup of when an class is mixed into itself -} -constraints memory -body { +test oo-11.6.1 {OO: cleanup of when an class is mixed into itself} -constraints memory -body { leaktest { interp create interp1 oo::class create obj1 @@ -1695,13 +1693,8 @@ test oo-11.6.1 { rename obj1 {} interp delete interp1 } -} -result 0 -cleanup { -} - -test oo-11.6.2 { - OO: cleanup ReleaseClassContents() where class is mixed into one of its - instances -} -constraints memory -body { +} -result 0 +test oo-11.6.2 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -constraints memory -body { leaktest { interp create interp1 interp1 eval { @@ -1712,13 +1705,8 @@ test oo-11.6.2 { } interp delete interp1 } -} -result 0 -cleanup { -} - -test oo-11.6.3 { - OO: cleanup ReleaseClassContents() where class is mixed into one of its - instances -} -constraints memory -body { +} -result 0 +test oo-11.6.3 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -constraints memory -body { leaktest { interp create interp1 interp1 eval { @@ -1731,13 +1719,8 @@ test oo-11.6.3 { } interp delete interp1 } -} -result 0 -cleanup { -} - -test oo-11.6.4 { - OO: cleanup ReleaseClassContents() where class is mixed into one of its - instances -} -body { +} -result 0 +test oo-11.6.4 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -body { oo::class create obj1 ::oo::define obj1 {self mixin [self]} @@ -2218,6 +2201,31 @@ test oo-14.8 {OO: class mixin order - Bug 1998221} -setup { } [cls new] test } -result {mix cls} +test oo-14.9 {OO: class mixins must be unique in list} -setup { + oo::class create parent +} -body { + oo::class create A {superclass parent} + oo::class create B { + superclass parent + mixin A + } + oo::define B mixin -append A +} -returnCodes error -cleanup { + parent destroy +} -result {class should only be a direct mixin once} +test oo-14.10 {OO: instance mixins must be unique in list} -setup { + oo::class create parent +} -body { + oo::class create A {superclass parent} + oo::class create B { + superclass parent + constructor {} {oo::objdefine [self] mixin A} + } + B create obj + oo::objdefine obj {mixin -append A} +} -returnCodes error -cleanup { + parent destroy +} -result {class should only be a direct mixin once} test oo-15.1 {OO: object cloning} { oo::class create Aclass @@ -4198,6 +4206,19 @@ test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup { rename $s {} }] -result \ {unknown method "-grill": must be -append, -appendifnew, -clear, -prepend, -remove, -set, contents or ops} +test oo-33.5 {TIP 567: slots -appendifnew} -setup [SampleSlotSetup { + set s [SampleSlot new] +}] -body { + list \ + [$s -clear + $s contents] \ + [$s -append p q r + $s contents] \ + [$s -appendifnew q s r t p + $s contents] +} -cleanup [SampleSlotCleanup { + rename $s {} +}] -result {{} {p q r} {p q r s t}} test oo-34.1 {TIP 380: slots - presence} -setup { set obj [oo::object new] diff --git a/tests/ooUtil.test b/tests/ooUtil.test index f41c668..9e1de8f 100644 --- a/tests/ooUtil.test +++ b/tests/ooUtil.test @@ -527,6 +527,29 @@ test ooUtil-7.2 {TIP 478: link removed when [my] disappears} -setup { parent destroy } -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}} +# Tests a very weird combination of things (with a key problem locus in +# MixinClassDelegates) that TIP 567 fixes +test ooUtil-8.1 {TIP 567: call oo::define twice from metaclass constructor} -setup { + oo::class create parent +} -body { + ::oo::class create A { + superclass parent + } + ::oo::class create B { + superclass ::oo::class parent + constructor {{definitionScript ""}} { + next $definitionScript + next {superclass ::A} + } + } + B create C { + superclass A + } + C create instance +} -cleanup { + parent destroy +} -result ::instance + # Tests that verify issues detected with the tcllib version of the code test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup { oo::class create animal {} |