summaryrefslogtreecommitdiffstats
path: root/tests/oo.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-10-31 22:08:32 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-10-31 22:08:32 (GMT)
commitea04b9849eb076f206c65efacd0a6a3aba6f4325 (patch)
tree48e83fa4c090195326480154283f0888f703a276 /tests/oo.test
parent031a9bda7717f94ece3cbe7bca2b8a89de61e340 (diff)
downloadtcl-ea04b9849eb076f206c65efacd0a6a3aba6f4325.zip
tcl-ea04b9849eb076f206c65efacd0a6a3aba6f4325.tar.gz
tcl-ea04b9849eb076f206c65efacd0a6a3aba6f4325.tar.bz2
Fix [Bug 2200824] and make class constructor error handling much more robust.
Diffstat (limited to 'tests/oo.test')
-rw-r--r--tests/oo.test51
1 files changed, 50 insertions, 1 deletions
diff --git a/tests/oo.test b/tests/oo.test
index 2df1d4d..ff2f79f 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -7,7 +7,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: oo.test,v 1.15 2008/10/10 13:04:09 dkf Exp $
+# RCS: @(#) $Id: oo.test,v 1.16 2008/10/31 22:08:32 dkf Exp $
package require TclOO 0.4 ;# Must match value in configure.in
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -594,6 +594,25 @@ test oo-7.8 {OO: next at the end of the method chain} -setup {
}
lappend result [catch {[foo2 new] bar} msg] $msg
} -result {foo2 foo 1 {no next method implementation}}
+test oo-7.9 {OO: defining inheritance in namespaces} -setup {
+ set ::result {}
+ oo::class create ::master
+ namespace eval ::foo {
+ oo::class create mixin {superclass ::master}
+ }
+} -cleanup {
+ ::master destroy
+ namespace delete ::foo
+} -body {
+ namespace eval ::foo {
+ oo::class create bar {superclass master}
+ oo::class create boo
+ oo::define boo {superclass bar}
+ oo::define boo {mixin mixin}
+ oo::class create spong {superclass boo}
+ return
+ }
+} -result {}
test oo-8.1 {OO: global must work in methods} {
oo::object create foo
@@ -1324,6 +1343,36 @@ test oo-18.3 {OO: define command support} {
(in definition script for object "::foo" line 1)
invoked from within
"oo::class create foo {error bar}"}}
+test oo-18.3a {OO: define command support} {
+ list [catch {oo::class create foo {
+ error bar
+}} msg] $msg $errorInfo
+} {1 bar {bar
+ while executing
+"error bar"
+ (in definition script for object "::foo" line 2)
+ invoked from within
+"oo::class create foo {
+ error bar
+}"}}
+test oo-18.3b {OO: define command support} {
+ list [catch {oo::class create foo {
+ eval eval error bar
+}} msg] $msg $errorInfo
+} {1 bar {bar
+ while executing
+"error bar"
+ ("eval" body line 1)
+ invoked from within
+"eval error bar"
+ ("eval" body line 1)
+ invoked from within
+"eval eval error bar"
+ (in definition script for object "::foo" line 2)
+ invoked from within
+"oo::class create foo {
+ eval eval error bar
+}"}}
test oo-18.4 {OO: more error traces from the guts} -setup {
oo::object create obj
} -body {