diff options
Diffstat (limited to 'tcllib/modules/grammar_fa/tests/faop_trim.test')
-rw-r--r-- | tcllib/modules/grammar_fa/tests/faop_trim.test | 209 |
1 files changed, 209 insertions, 0 deletions
diff --git a/tcllib/modules/grammar_fa/tests/faop_trim.test b/tcllib/modules/grammar_fa/tests/faop_trim.test new file mode 100644 index 0000000..7fd880b --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_trim.test @@ -0,0 +1,209 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_trim.test,v 1.7 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +if {![::tcltest::testConstraint runtotal]} { + ::tcltest::cleanupTests + return +} + +# ------------------------------------------------------------------------- + +test faop-trim-${setimpl}-1.0 {trim, error} { + catch {grammar::fa::op::trim} res + set res +} {wrong # args: should be "grammar::fa::op::trim fa ?what?"} + + +test faop-trim-${setimpl}-1.1 {trim, error} { + catch {grammar::fa::op::trim a foo} res + set res +} {Expected !reachable, !useful, !reachable&!useful, !(reachable|useful), !reachable|!useful, or !(reachable&useful), got "foo"} + + +test faop-trim-${setimpl}-1.2 {trim, error} { + catch {grammar::fa::op::trim a} res + set res +} {invalid command name "a"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +if 0 { + 00 x + 01 x- + 02 xy + 03 xy- + 04 xy-= + 05 xyz/-= + 06 xyz|-= + 07 xyz+-=_ + 08 xyz&-=_ + 09 xyz!-= + 10 xyz!-e +} + +foreach {n code} { + 00 x + 01 x- + 02 xe + 03 xy + 04 xy- + 05 xye + 06 xyee + 07 xye- + 08 xy-- + 09 xy-= + 10 xyz/ee + 11 xyz/e- + 12 xyz/-- + 13 xyz/-= + 14 xyz|ee + 15 xyz|e- + 16 xyz|-- + 17 xyz|-= + 18 xyz+eee + 19 xyz+ee- + 20 xyz+e-- + 21 xyz+e-= + 22 xyz+--- + 23 xyz+--= + 24 xyz+-=_ + 25 xyz&eee + 26 xyz&ee- + 27 xyz&e-- + 28 xyz&e-= + 29 xyz&--- + 30 xyz&--= + 31 xyz&-=_ + 32 xyz!ee + 33 xyz!e- + 34 xyz!-- + 35 xyz!-= + 36 xyz!-e +} { + if {[string match xyz* $code]} { + set sets {{} x y z {x y} {x z} {y z} {x y z}} + set max 2 + } elseif {[string match xy* $code]} { + set sets {{} x y {x y}} + set max 1 + } elseif {[string match x* $code]} { + set sets {{} x} + set max 0 + } else { + set sets {{}} + set max 4 + } + + # Pre-loop, generate the relevant combinations of input. + + set states [string range $code 0 $max] + set combinations {} + + foreach st $sets { + lappend combinations !reachable $st {} + lappend combinations !useful {} $st + } + foreach method { + !reachable&!useful !(reachable|useful) + !reachable|!useful !(reachable&useful) + } { + foreach st $sets { + foreach fin $sets { + lappend combinations $method $st $fin + } + } + } + + foreach {method st fin} $combinations { + set key $n.$code.([join $st {}],[join $fin {}]).$method + + test faop-trim-${setimpl}-2.$key {trim} { + grammar::fa a + gen $code + a start set $st + a final set $fin + + switch -exact -- $method { + !reachable {set kept [a reachable_states]} + !useful {set kept [a useful_states]} + !reachable&!useful - + !(reachable|useful) { + set kept [struct::set union [a reachable_states] [a useful_states]] + } + !reachable|!useful - + !(reachable&useful) { + set kept [struct::set intersect [a reachable_states] [a useful_states]] + } + } + set kept [join [lsort $kept] {}] + + grammar::fa::op::trim a $method + set res [expr {$kept eq [join [lsort [a states]] {}]}] + a destroy + set res + } 1 ; # {} + + test faop-trim-${setimpl}-3.$key {second trim is null operation} { + grammar::fa a + gen $code + a start set $st + a final set $fin + grammar::fa::op::trim a $method + set res [a serialize] + grammar::fa::op::trim a $method + set res [validate_serial $res a] + a destroy + set res + } ok ; # {} + + + test faop-trim-${setimpl}-3.$key {trim, as method} { + grammar::fa a + gen $code + a start set $st + a final set $fin + + switch -exact -- $method { + !reachable {set kept [a reachable_states]} + !useful {set kept [a useful_states]} + !reachable&!useful - + !(reachable|useful) { + set kept [struct::set union [a reachable_states] [a useful_states]] + } + !reachable|!useful - + !(reachable&useful) { + set kept [struct::set intersect [a reachable_states] [a useful_states]] + } + } + set kept [join [lsort $kept] {}] + + a trim $method + set res [expr {$kept eq [join [lsort [a states]] {}]}] + a destroy + set res + } 1 ; # {} + + test faop-trim-${setimpl}-4.$key {second trim is null operation, for method} { + grammar::fa a + gen $code + a start set $st + a final set $fin + a trim $method + set res [a serialize] + a trim $method + set res [validate_serial $res a] + a destroy + set res + } ok ; # {} + } +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests |