# -*- 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
