summaryrefslogtreecommitdiffstats
path: root/tests/oo.test
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-08-14 18:44:51 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-08-14 18:44:51 (GMT)
commit1f563ae9a011345574fb277fe6e8eb7f58916981 (patch)
tree91e5021d194cf249b14156bcd8d1560dce949c2c /tests/oo.test
parent6f7f64c938f98f268b7e606cf668c40ca66e98c9 (diff)
parent2b3657769b1d0b9ae6e10113b1d3c038b4967899 (diff)
downloadtcl-1f563ae9a011345574fb277fe6e8eb7f58916981.zip
tcl-1f563ae9a011345574fb277fe6e8eb7f58916981.tar.gz
tcl-1f563ae9a011345574fb277fe6e8eb7f58916981.tar.bz2
merge trunkbug_3610404
Diffstat (limited to 'tests/oo.test')
-rw-r--r--tests/oo.test36
1 files changed, 36 insertions, 0 deletions
diff --git a/tests/oo.test b/tests/oo.test
index 84e6236..e0e0791 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3437,6 +3437,42 @@ test oo-34.8 {TIP 380: slots - presence} {
test oo-34.9 {TIP 380: slots - presence} {
getMethods oo::objdefine::variable
} {{-append -clear -set} {Get Set}}
+
+test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+ oo::class create fruit {
+ method eat {} {}
+ }
+ set result {}
+} -body {
+ lappend result [fruit create ::apple] [info class superclasses fruit]
+ oo::define fruit superclass
+ lappend result [info class superclasses fruit] \
+ [info object class apple oo::object] \
+ [info class call fruit destroy] \
+ [catch { apple }]
+} -cleanup {
+ unset -nocomplain result
+ fruit destroy
+} -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
+test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+ oo::class create fruitMetaclass {
+ superclass oo::class
+ method eat {} {}
+ }
+ set result {}
+} -body {
+ lappend result [fruitMetaclass create ::appleClass] \
+ [appleClass create orange] \
+ [info class superclasses fruitMetaclass]
+ oo::define fruitMetaclass superclass
+ lappend result [info class superclasses fruitMetaclass] \
+ [info object class appleClass oo::class] \
+ [catch { orange }] [info object class orange] \
+ [appleClass create pear]
+} -cleanup {
+ unset -nocomplain result
+ fruitMetaclass destroy
+} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
cleanupTests
return