#! /bin/env tclsh
package require {ycl ns}
namespace import [yclprefix]::ns::normalize
package require {ycl list}
namespace import [yclprefix]::list::sl
package require {ycl vso vso}
namespace import [yclprefix]::vso::vso
proc suite_main {} {
foreach varname {cleanup1 setup1} {
variable $varname
}
package require {ycl test}
[yclprefix]::test::init
test basic {} -setup $setup1 -body {
proc p1 {arg1 arg2 arg3 arg4} {
return [list $arg1 $arg2 $arg3 $arg4]
}
[vso vso1] init
catch {vso1 datum p1 hi} cres copts
if {[string is list -strict $cres]
&& [lindex $cres 0] eq {unknown class}} {
lappend res [lindex $cres 0]
lappend res [lindex $cres 1]
} else {
dict incr copts level -1
return -options $copts $cres
}
lappend res [vso1 class class1 {}]
lappend res [vso1 route tproc {class1 class1} p1]
proc p2 {} {
list i am p2
}
namespace eval ns1 {
variable v1 val1
}
namespace eval ns2 {
variable v1 val2
}
lappend res [vso1 query tproc {} {class1 class1}]
vso1 router router1 tproc
lappend res [vso1 datum ns1 class1]
vso1 datum ns2 class1
catch [list router1 ns8 [normalize ns2] uno dos] cres copts
lappend res [lindex $cres 0]
router1 [normalize ns1] [normalize ns2] uno dos
set res
} -cleanup $cleanup1 -result [sl {
{unknown class}
hi
{}
[list {class1 class1} [namespace current]::p1]
[normalize p1]
[list [normalize ns1] class1]
{no route to}
}]
test class {} -setup $setup1 -body {
[vso vso1] init
vso1 class class1 {}
vso1 class class2 {}
vso1 class class2 class1
} -cleanup $cleanup1 -result [sl {
class1 {}
}]
test noroute {} -setup $setup1 -body {
[vso vso1] init
vso1 class class1 {}
vso1 router router1 p1
namespace eval ns1 {
proc p1 args {
return $args
}
}
catch {router1 one two} cres copts
lappend res $cres
} -cleanup $cleanup1 -result [sl {
{{no route to} p1}
}]
test load {} -setup $setup1 -body {
[vso vso1] init
[vso vso2] init
vso1 class class1 {}
vso1 class class1a {}
vso1 class class1a class1
vso2 class class2 {}
vso2 class class2a {}
vso2 class class2a class2
vso1 load vso2
vso2 class class1 {}
vso2 class class1 class2a
vso1 load vso2
namespace eval ns1 {
proc p1 {arg1 arg2} {
return hello
}
proc p2 {arg1 arg2 arg3} {
return [list $arg1 $arg2 $arg3]
}
}
vso1 route p1 {class2a class2a} ns1::p1
vso1 router router1 p1
namespace eval ns2 {}
vso1 datum ns2 class1
lappend res [router1 [namespace current]::ns2 [namespace current]::ns2]
vso1 route p1 {class2 class2} ns1::p2 goop
vso1 router router1 p1
variable var1 val1
variable var2 val2
vso1 datum [namespace current]::var1 class1
vso1 datum [namespace current]::var2 class2
lappend res [router1 [namespace current]::var1 [namespace current]::var2]
} -cleanup $cleanup1 -result [sl {
hello
[list goop [namespace current]::var1 [namespace current]::var2]
}]
test targetlist {} -setup $setup1 -body {
[vso vso1] init
vso1 class class1 {}
vso1 route p1 {class1 class1} [list ns1::p1 a]
vso1 router tproc p1
namespace eval ns1 {
variable v1 val1
proc {p1 a} args {
return [list hey {*}$args]
}
}
namespace eval ns2 {}
vso1 datum ns2 class1
tproc [namespace current]::ns2 [namespace current]::ns2
} -cleanup $cleanup1 -result [sl {
hey [namespace current]::ns2 [namespace current]::ns2
}]
cleanupTests
}
variable cleanup1 {
apply [list {} {
foreach item {p1 p2 router1 router2 vso1 vso2} {
catch {rename $item {}}
}
foreach item {cres copts var1 var2} {
catch {unset $item}
}
foreach item {ns1} {
catch {namespace delete $item}
}
} [namespace current]]
}
variable setup1 {
variable res {}
}