# -*- tcl -*-
## (c) 2017-present Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Execution core for testing the marpa runtime engines with various
## SLIF-specified grammars demonstrating various features and possible
## behaviours. This is similiar to parser-core, one stage further.
## Configured by the caller with methods for
## - overall initialization and finalization
## - parser creation and destruction
## - Result selection
#
## The methods expected to exist are
#
## * label :: return string to name the tests
## * initialize :: global setup, for the suite
## * finalize :: global cleanup, for the suite
## * input :: input selection by label / base directory
## * result :: result selection by label / base directory
## The name of the parser class is stored in the `gen` config, under
## key `cl`.
# # ## ### ##### ######## ############# #####################
kt check Tcl 8.5
kt check tcltest 2
kt require support debug
kt require support debug::caller
kt require support oo::util
kt require support TclOO
kt require support fileutil ;# cat
# # ## ### ##### ######## ############# #####################
## Local shorthands
proc stash {k} {
global rtdebug
if {![info exists rtdebug] || !$rtdebug} return
set dst [top]/[label]_${k}-stash
file delete -force $dst
file mkdir $dst
set cl [gen cget cl]
file copy [td]/${cl}.tcl $dst/
# RTC specific. Not for Tcl.
catch {
file copy [td]/OUT_${cl}_LOG $dst/
file copy [td]/OUT_${cl} $dst/
}
return
}
# # ## ### ##### ######## ############# #####################
## No method sequence checking for the parser.
## Methods can be called in any order.
# # ## ### ##### ######## ############# #####################
kt source support/ast.tcl
kt source support/dirs.tcl
kt source support/grammars.tcl
kt source support/textutils.tcl
# # ## ### ##### ######## ############# #####################
## Setup dynamic parts of the testsuite
## Currently only importing the `bootstrap/marpa-tcl-slif`
exec [td]/grammars/setup.sh
# # ## ### ##### ######## ############# #####################
initialize
# # ## ### ##### ######## ############# #####################
## Helper command for inspection of event handling
proc record {p type enames args} {
# For testing we just record the information about the event for
# matching against expectations.
if {[catch {
lappend ::recording ___________________________(([info level 0]))
lappend ::recording {*}[$p match view]
# Move input so that the lexer resumes reading with the
# character after the lexeme. Written as is with absolutes so
# that it works for all events (discard, pre-, post-lexeme) we
# are testing without requiring conditionals on the exact
# trigger location.
$p match from [$p match start] [$p match length]
lappend ::recording "@resume = [$p match location]"
# The input now points to the last character of the lexeme,
# and on resume the lexer advances to the next character to
# start processing from.
set symbols [$p match symbols]
foreach s $symbols { lappend ::recording "^sym = >>$s<<" }
if {$type in {after before}} {
# Retrieve and return the symbols and their sem values. A
# check that both directions are working.
set semvalues [$p match sv]
foreach s $semvalues { lappend ::recording "^sv = >>$s<<" }
foreach v $semvalues s $symbols { $p match alternate $s $v }
foreach v [$p match sv] s [$p match symbols] {
lappend ::recording ">>$s<< ~~ >>$v<<"
}
} else {
# discard and non-lexeme events do not come with sem
# values.
lappend ::recording *[list [catch { $p match sv } msg] $msg]
}
}]} {
lappend ::recording $::errorInfo
}
return
}
# # ## ### ##### ######## ############# #####################
## Actual processing
test-grammar-file-format ID rt_example
test-grammar-map rt_example --> k id rte base {
if {![file exists $base/events]} continue
test marpa-[label]-runtime-process-2.[ID $k]---${id} "[label] :: process $id" -setup {
gen single-setup $rte rte$k
# Debugging - Keep the generated parser and related files for
# post-mortem review.
stash $k
set recording {}
PARSE on-event record
} -body {
catch {
PARSE process [fget [input $base]]
join $recording \n
} msg
set msg ;# set ::errorInfo
} -cleanup {
gen single-cleanup
unset msg recording
} -result [string trimright [fget $base/events]]
}
test-grammar-map rt_example --> k id rte base {
if {[file exists $base/events]} continue
test marpa-[label]-runtime-process-2.[ID $k]---${id} "[label] :: process $id" -setup {
gen single-setup $rte rte$k
# Debugging - Keep the generated parser and related files for
# post-mortem review.
stash $k
} -body {
catch {
ast-format [PARSE process [fget [input $base]]]
} msg
set msg ;# set ::errorInfo
} -cleanup {
gen single-cleanup
unset msg
} -result [string trimright [fget [result $base]]]
}
# # ## ### ##### ######## ############# #####################
rename ID {}
rename record {}
# # ## ### ##### ######## ############# #####################
finalize
# # ## ### ##### ######## ############# #####################
## Oneshot test cases not fitting into the above loop.
## I.e. custom operation
test marpa-[label]-runtime-process-3.0-multishot "[label] :: reset for multi-use" -setup {
# Demonstrate multiple calls. They are working due to the implicit
# parser reset before the next run. Without the reset the parser
# is in a state where it will not accept the input from the second
# call.
gen single-setup [td]/grammars/runtime/multi-shot/grammar RESETTABLE
set msg ""
} -body {
append msg [ast-format [PARSE process "alpha"]]
append msg [ast-format [PARSE process "bet"]]
set msg ;# set ::errorInfo
} -cleanup {
gen single-cleanup
unset msg
} -result [fget [td]/grammars/runtime/multi-shot/expected]
# # ## ### ##### ######## ############# #####################
rename label {}
rename result {}
rename initialize {}
rename finalize {}
return