summaryrefslogtreecommitdiffstats
path: root/tests/oo.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2018-06-28 10:40:37 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2018-06-28 10:40:37 (GMT)
commit4c24e60418bdb662ac652345798230eeff89ce0b (patch)
tree55ca3c26b9804d9b5685689e1ce905bc36176ea9 /tests/oo.test
parent8219fb26323aa59d5e46299099e965049a0cb654 (diff)
downloadtcl-4c24e60418bdb662ac652345798230eeff89ce0b.zip
tcl-4c24e60418bdb662ac652345798230eeff89ce0b.tar.gz
tcl-4c24e60418bdb662ac652345798230eeff89ce0b.tar.bz2
Split out TIP 478 tests into their own file.
Diffstat (limited to 'tests/oo.test')
-rw-r--r--tests/oo.test264
1 files changed, 0 insertions, 264 deletions
diff --git a/tests/oo.test b/tests/oo.test
index 1e694c1..7e0f12e 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -4845,270 +4845,6 @@ test oo-40.3 {TIP 500: private and unexport} -setup {
} -cleanup {
cls destroy
} -result {{} {} foo {} foo {}}
-
-test oo-41.1 {TIP 478: classmethod} -setup {
- oo::class create parent
-} -body {
- oo::class create ActiveRecord {
- superclass parent
- classmethod find args {
- return "[self] called with arguments: $args"
- }
- }
- oo::class create Table {
- superclass ActiveRecord
- }
- Table find foo bar
-} -cleanup {
- parent destroy
-} -result {::Table called with arguments: foo bar}
-test oo-41.2 {TIP 478: classmethod in namespace} -setup {
- namespace eval ::testns {}
-} -body {
- namespace eval ::testns {
- oo::class create ActiveRecord {
- classmethod find args {
- return "[self] called with arguments: $args"
- }
- }
- oo::class create Table {
- superclass ActiveRecord
- }
- }
- testns::Table find foo bar
-} -cleanup {
- namespace delete ::testns
-} -result {::testns::Table called with arguments: foo bar}
-test oo-41.3 {TIP 478: classmethod must not interfere with constructor signatures} -setup {
- oo::class create parent
-} -body {
- oo::class create TestClass {
- superclass oo::class parent
- self method create {name ignore body} {
- next $name $body
- }
- }
- TestClass create okay {} {}
-} -cleanup {
- parent destroy
-} -result {::okay}
-test oo-41.4 {TIP 478: classmethod with several inheritance levels} -setup {
- oo::class create parent
-} -body {
- oo::class create ActiveRecord {
- superclass parent
- classmethod find args {
- return "[self] called with arguments: $args"
- }
- }
- oo::class create Table {
- superclass ActiveRecord
- }
- oo::class create SubTable {
- superclass Table
- }
- SubTable find foo bar
-} -cleanup {
- parent destroy
-} -result {::SubTable called with arguments: foo bar}
-test oo-41.5 {TIP 478: classmethod and instances} -setup {
- oo::class create parent
-} -body {
- oo::class create ActiveRecord {
- superclass parent
- classmethod find args {
- return "[self] called with arguments: $args"
- }
- }
- oo::class create Table {
- superclass ActiveRecord
- }
- set t [Table new]
- $t find 1 2 3
-} -cleanup {
- parent destroy
-} -result {::ActiveRecord called with arguments: 1 2 3}
-test oo-41.6 {TIP 478: classmethod and instances} -setup {
- oo::class create parent
-} -body {
- oo::class create ActiveRecord {
- superclass parent
- classmethod find args {
- return "[self] called with arguments: $args"
- }
- }
- oo::class create Table {
- superclass ActiveRecord
- unexport find
- }
- set t [Table new]
- $t find 1 2 3
-} -returnCodes error -cleanup {
- parent destroy
-} -match glob -result {unknown method "find": must be *}
-
-test oo-42.1 {TIP 478: callback generation} -setup {
- oo::class create parent
-} -body {
- oo::class create c {
- superclass parent
- method CallMe {} { return ok,[self] }
- method makeCall {} {
- return [callback CallMe]
- }
- }
- c create ::context
- set cb [context makeCall]
- {*}$cb
-} -cleanup {
- parent destroy
-} -result {ok,::context}
-test oo-42.2 {TIP 478: callback generation} -setup {
- oo::class create parent
-} -body {
- oo::class create c {
- superclass parent
- method CallMe {a b c} { return ok,[self],$a,$b,$c }
- method makeCall {b} {
- return [callback CallMe 123 $b]
- }
- }
- c create ::context
- set cb [context makeCall "a b c"]
- {*}$cb PQR
-} -cleanup {
- parent destroy
-} -result {ok,::context,123,a b c,PQR}
-test oo-42.3 {TIP 478: callback generation, alternate name} -setup {
- oo::class create parent
-} -body {
- oo::class create c {
- superclass parent
- method CallMe {} { return ok,[self] }
- method makeCall {} {
- return [mymethod CallMe]
- }
- }
- c create ::context
- set cb [context makeCall]
- {*}$cb
-} -cleanup {
- parent destroy
-} -result {ok,::context}
-test oo-42.4 {TIP 478: callback generation, alternate name} -setup {
- oo::class create parent
-} -body {
- oo::class create c {
- superclass parent
- method CallMe {a b c} { return ok,[self],$a,$b,$c }
- method makeCall {b} {
- return [mymethod CallMe 123 $b]
- }
- }
- c create ::context
- set cb [context makeCall "a b c"]
- {*}$cb PQR
-} -cleanup {
- parent destroy
-} -result {ok,::context,123,a b c,PQR}
-test oo-42.5 {TIP 478: callbacks and method lifetime} -setup {
- oo::class create parent
-} -body {
- oo::class create c {
- superclass parent
- method makeCall {b} {
- return [callback CallMe 123 $b]
- }
- }
- c create ::context
- set cb [context makeCall "a b c"]
- set result [list [catch {{*}$cb PQR} msg] $msg]
- oo::objdefine context {
- method CallMe {a b c} { return ok,[self],$a,$b,$c }
- }
- lappend result [{*}$cb PQR]
-} -cleanup {
- parent destroy
-} -result {1 {unknown method "CallMe": must be <cloned>, destroy, eval, makeCall, unknown, variable or varname} {ok,::context,123,a b c,PQR}}
-test oo-42.6 {TIP 478: callback use case} -setup {
- oo::class create parent
- unset -nocomplain x
-} -body {
- oo::class create c {
- superclass parent
- variable count
- constructor {var} {
- set count 0
- upvar 1 $var v
- trace add variable v write [callback TraceCallback]
- }
- method count {} {return $count}
- method TraceCallback {name1 name2 op} {
- incr count
- }
- }
- set o [c new x]
- for {set x 0} {$x < 5} {incr x} {}
- $o count
-} -cleanup {
- unset -nocomplain x
- parent destroy
-} -result 6
-
-test oo-43.1 {TIP 478: class initialisation} -setup {
- oo::class create parent
-} -body {
- oo::class create ::cls {
- superclass parent
- initialise {
- proc foobar {} {return ok}
- }
- method calls {} {
- list [catch foobar msg] $msg \
- [namespace eval [info object namespace [self class]] foobar]
- }
- }
- [cls new] calls
-} -cleanup {
- parent destroy
-} -result {1 {invalid command name "foobar"} ok}
-
-test oo-44.1 {TIP 478: singleton} -setup {
- oo::class create parent
-} -body {
- oo::singleton create xyz {
- superclass parent
- }
- set x [xyz new]
- set y [xyz new]
- set z [xyz new]
- set code [catch {$x destroy} msg]
- set p [xyz new]
- lappend code $msg [catch {rename $x ""}]
- set q [xyz new]
- string map [list $x ONE $q TWO] [list {*}$code $x $y $z $p $q [xyz new]]
-} -cleanup {
- parent destroy
-} -result {1 {object "ONE" has no visible methods} 0 ONE ONE ONE ONE TWO TWO}
-
-test oo-45.1 {TIP 478: abstract} -setup {
- oo::class create parent
-} -body {
- oo::abstract create xyz {
- superclass parent
- method foo {} {return 123}
- }
- oo::class create pqr {
- superclass xyz
- method bar {} {return 456}
- }
- set codes [list [catch {xyz new}] [catch {xyz create x}] [catch {xyz createWithNamespace x y}]]
- set x [pqr new]
- set y [pqr create ::y]
- lappend codes [$x foo] [$x bar] $y
-} -cleanup {
- parent destroy
-} -result {1 1 1 123 456 ::y}
cleanupTests
return