Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

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