diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2018-06-28 10:40:37 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2018-06-28 10:40:37 (GMT) |
commit | 4c24e60418bdb662ac652345798230eeff89ce0b (patch) | |
tree | 55ca3c26b9804d9b5685689e1ce905bc36176ea9 /tests/oo.test | |
parent | 8219fb26323aa59d5e46299099e965049a0cb654 (diff) | |
download | tcl-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.test | 264 |
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 |