#! /bin/env tclsh
proc suite_main {} {
interp alias {} f {} file
package require {ycl test}
[yclprefix]::test::init
package require {ycl context}
namespace import [yclprefix]::context::context
package require {ycl proc}
namespace import [yclprefix]::proc::nsproc
package require {ycl parser}
namespace import [yclprefix]::parser::parser
variable parser [yclprefix]::parser
test first {} -body {
variable config [context]
context options
options var config $config
variable myparser [parser]
options var parser $myparser
options eval {
namespace import [yclprefix]::proc::nsproc
variable cns [namespace current]
proc start {ctxt} {
return [list \
[list $ctxt optOne] \
[list $ctxt optTwo]
]
}
$cns method [namespace current]::start
nsproc optOne {ctxt args} parser {
if {[llength $args] == 0} return
lassign $args val
set match 0
set states {}
if {[string match -one $val]} {
set match [$parser var ACCEPT]
lappend states [list $ctxt optval hello]
}
return [dict create match $match states $states]
}
$cns method [namespace current]::optOne
nsproc optTwo {ctxt args} parser {
if {[llength $args] == 0} return
lassign $args val
set match [$parser var FAIL]
set states [list]
if {[string match -two $val]} {
set match [$parser var ACCEPT]
lappend states [list $ctxt optval bloop]
}
return [dict create match $match states $states]
}
$cns method [namespace current]::optTwo
nsproc optval {ctxt var args} {parser config} {
if {[llength $args] == 0} {
return -code error "no value supplied for $var"
}
lassign $args val
$config var $var $val
return [dict create match [$parser var ACCEPT] states [$ctxt start]]
}
$cns method [namespace current]::optval
}
variable states [options start]
variable options [list -one doober -two beans]
variable result [$myparser parse options states]
set testres [list]
lappend testres [$config $ hello]
lappend testres [$config $ bloop]
} -result [list doober beans]
cleanupTests
}