diff options
Diffstat (limited to 'tcllib/modules/grammar_fa')
50 files changed, 11850 insertions, 0 deletions
diff --git a/tcllib/modules/grammar_fa/ChangeLog b/tcllib/modules/grammar_fa/ChangeLog new file mode 100644 index 0000000..44d50fb --- /dev/null +++ b/tcllib/modules/grammar_fa/ChangeLog @@ -0,0 +1,368 @@ +2013-11-06 Andreas Kupries <andreask@activestate.com> + + * fa.tcl: Extended the range of acceptable snit beyond 1.3-2 to + * pkgIndex.tcl: beyond 2. Bumped version to 0.5. Testsuite update + defered. Requires more work to update the wrong#args messages. + +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2009-10-27 Andreas Kupries <andreask@activestate.com> + + * fa.man: Noted that the implementation could be simplified by + * fa.tcl: using snit's hierarchical methods. The changed methods + * pkgIndex.tcl: are 'start', 'final', 'symbol', and 'state'. + * tests/fa_final.test: Updated the testsuite, the error messages + * tests/fa_state.test: changed across branches of Tcl. Bumped + * tests/fa_symbol.test: version to 0.4 (Due to us bumping the + required snit to 1.3+). + +2009-02-13 Andreas Kupries <andreask@activestate.com> + + * fa.tcl: Fixed [SF Tcllib Bug 2595296], renaming of states + * fa.man: having loop transitions. Bumped version to 0.3.1. + * pkgIndex.tcl: Extended testsuite. + * tests/fa_state.test: + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2008-03-14 Andreas Kupries <andreask@activestate.com> + + * faop.tcl (::grammar::fa::op::cons): Fixed bad return code, + * pkgIndex.tcl: reported in [SF Tcllib Bug 1826418], by Erik + * faop.man: Leunissen. Bumped to version 0.4.1. + +2007-12-03 Andreas Kupries <andreask@activestate.com> + + * tests/faop_regex.test: Added examples for to(Tcl)Regexp provided + by Lars Hellstroem <lars_h@users.sourceforge.net>, see [Tcllib SF + Bug 1841979]. + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-08-22 Andreas Kupries <andreask@activestate.com> + + * faop.tcl: Extended the package with commands to convert finite + * faop.man: automatons back to regular expressions, simplify + * pkgIndex.tcl: regular expressions, and translate regular + * tests/faop_regexp.test: expressions to Tcl syntax. Extended the + documentation and testsuite. This fixes [SF Tcllib RFE 1735601], + submitted by Lars Hellstroem <lars_h@users.sourceforge.net>. He + submitted the code used for this as well. Documentation however + by myself, based on his comments in the original code (dtx + format). Version of the package bumped to 0.4. + +2007-08-21 Andreas Kupries <andreask@activestate.com> + + * faop.man: Extend fromRegex and helper commands to accept zero + * faop.tcl: arguments for "|" (Choice) and "." (Sequence), to + * pkgIndex.tcl: represent empty language and epsilon + language. Documentation extended. Version of package fa::op + bumped to 0.3. This implements [SF Tcllib Bug 1759532], an RFE + submitted by Lars Hellstroem <lars_h@users.sourceforge.net>. + +2007-08-14 Andreas Kupries <andreask@activestate.com> + + * tests/fa_symbols_at.test: Added proper documentation for the + * fa.tcl: methods symbols@ and symbols@set. Extended method + * fa.man: symbols@ to allow querying of symbols between two + * pkgIndex.tcl: states, extended documentation, and updated + testsuite. Bumped package version to 0.3. + +2007-06-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * faop.tcl: Replaced deprecated {expand} syntax in comments with + {*}. + +2007-04-11 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * dacceptor.test: Added the switching of struct::set + * dexec.test: implementations to the testsuite. + * fa.test: + * faop.test: + * tests/da_accept.test: + * tests/da_cons.test: + * tests/de_cons.test: + * tests/de_exec.test: + * tests/fa_cons.test: + * tests/fa_ec.test: + * tests/fa_final.test: + * tests/fa_is.test: + * tests/fa_is_complete.test: + * tests/fa_is_deterministic.test: + * tests/fa_is_epsfree.test: + * tests/fa_is_useful.test: + * tests/fa_next.test: + * tests/fa_reach.test: + * tests/fa_serial.test: + * tests/fa_start.test: + * tests/fa_state.test: + * tests/fa_states.test: + * tests/fa_symbol.test: + * tests/fa_symbols.test: + * tests/fa_symbols_at.test: + * tests/fa_useful.test: + * tests/faop_complete.test: + * tests/faop_concat.test: + * tests/faop_determinize.test: + * tests/faop_difference.test: + * tests/faop_intersect.test: + * tests/faop_kleene.test: + * tests/faop_minimize.test: + * tests/faop_optional.test: + * tests/faop_regex.test: + * tests/faop_remeps.test: + * tests/faop_reverse.test: + * tests/faop_trim.test: + * tests/faop_union.test: + +2007-04-03 Andreas Kupries <andreask@activestate.com> + + * dexec.tcl: Accepted [Tcllib RFE 1692954] and the associated + * dexec.man: patch [Tcllib Patch 1693491], by Bogdan + * pkgIndex.tcl: <rftghost@users.sourceforge.net>. Bumped version + * test/de_exec.test: number to 0.2. New API: State introspection, + additional callback invokation for state transitions. Updated + testsuite to accept the additional callbacks in the activity + traces. + +2007-03-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * dacceptor.man: Fixed all warnings due to use of now deprecated + * dexec.man: commands. Added a section about how to give feedback. + * fa.man: + * faop.man: + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-09-19 Andreas Kupries <andreask@activestate.com> + + * faop.man: Bumped versions to 0.2 + * faop.tcl: + * fa.man: + * fa.tcl: + * pkgIndex.tcl: + +2006-06-15 Andreas Kupries <andreask@activestate.com> + + * fa.tcl: Reworked the internal of the container and + * faop.tcl: operations packages to break their circularity. + * fa.test: The user of the operations packages now has to + * faop.test: specify a command to construct containers. The + * dexec.test: uses the ops package and sets its own class + * dacceptor.text: command as constructor. + * fa.man: + * faop.man: + +2006-01-28 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * tests/fa_symbols_at.test: Fixed use of duplicate test names. + * tests/fa_symbol.test: + * tests/faop_remeps.test: + * tests/faop_reverse.test: + +2006-01-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * dacceptor.test: More boilerplate simplified via use of test support. + * dexec.test: + * fa.test: + * faop.test: + + * tests/faop_trim.test: Replaced old 'queryconstraint' with proper + * tests/fa_serial.test: 'testConstraint' call. + * tests/fa_is_useful.test: + * tests/fa_is_deterministic.test: + * tests/da_cons.test: + * tests/de_cons.test: + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * dacceptor.test: Hooked into the new common test support code. + * dexec.test: + * fa.test: + * faop.test: + +2006-01-10 Andreas Kupries <andreask@activestate.com> + + * dacceptor.test: Fixed [SF Tcllib Bug 1316040]. Uncluttering test + * dexec.test: output. + * fa.test: + * faop.test: + * tests/da_accept.test: + * tests/de_exec.test: + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-09-20 Andreas Kupries <akupries@shaw.ca> + + * tests/fa_final.test: Fixed problems of testsuite with + * tests/fa_next.test: Tcl 8.5, caused by changes to the + * tests/fa_start.test: proc error messages. + * tests/fa_state.test: + * tests/fa_symbol.test: + +2004-11-22 Andreas Kupries <andreask@activestate.com> + + * pkgIndex.tcl: Fixed usage of wrong file for package 'dacceptor'. + +2004-11-11 Andreas Kupries <andreask@activestate.com> + + * fa.man: Removed duplicate description of method + startstates. Fixed typos (wrong term, missing word). + +2004-10-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.7 ======================== + * + +2004-08-05 Andreas Kupries <andreask@activestate.com> + + * tests/fa_is_deterministic.test: + * tests/fa_is_useful.test: + * tests/da_cons.test: Introduced constraint 'runtotal'. + * tests/de_cons.test: Skip the most timeconsuming tests + * tests/fa_serial.test: if the constraint is off (default). + * tests/faop_trim.test: Reduces #tests from 58143 to 2410. + (fa_serial, faop_trim are the biggest hitters). + + * ../../all.tcl: Added command 'queryConstraint' for portability. + +2004-07-27 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * tests/da_cons.test: Updated tests to changed error message of snit. + * tests/de_cons.test: + + * tests/faop_difference.test: Fixed problem with missing object + * tests/faop_intersect.test: destruction uncovered by the new + checks in snit which cause it to avoid overwriting an existing + command. + +2004-07-09 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * faop.man: Inserted the correct package names into the + * fa.man: manpage headers. + * dexec.man: + * dacceptor.man: + +2004-05-29 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * dacceptor.test: Adapted to changes in the struct package. + * dexec.test: Now importing only the needed structures + * fa.test: (list, set operations). Updated all test + * faop.test: suites in the same way. Updated all manpages + * dacceptor.tcl: to contain the correct package requirements + * dexec.tcl: as well. + * fa.tcl: + * faop.tcl: + * dacceptor.man: + * dexec.man: + * fa.man: + * faop.man: + +2004-04-11 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * dacceptor.man: Slight renaming of a section for better + understanding. + + * dexec.tcl: New package, execution of deterministic + * dexec.man: finite automatons. Executors can do only this, + * dexec.test: and cannot be manipulated. Added reference + * fa.man: to this package to the FA documenation. + * tests/de_cons.test: + * tests/de_exec.test: + +2004-04-09 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * dacceptor.tcl: New package, deterministic acceptors + * dacceptor.man: out of deterministic finite automaton. + * dacceptor.test: Acceptors do only this check, and cannot + * fa.man: be manipulated. Added reference to this + package to the FA documenation. + * tests/da_cons.test: + * tests/da_accept.test: + + * fa.tcl: Added fromRegex constructor operation. Updated + * fa.man: the documentation, and testsuite. Typo fixes in + * fa.test: documentation as well. + +2004-04-08 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * faop.tcl: Complement requires deterministic input for a correct + * faop.man: result. Fixed. Updated documentation as well. Typo + fixes in doc. + +2004-04-05 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * test_support.tcl: Renamed to tests.support. Prevents the + * fa.test: installation of this internal file. + * faop.test: Updated the test suites. + +2004-04-04 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * All files: Bugfixes in basic FA support. Updated tests, updated + documentation. Completed implementation of more comlex FA + operations, their documentation, and their tests. Test suite is + now definitely in overkill, taking 13 minutes to run :P + +2004-03-25 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * tests/fa_state.test + * tests/fa_is_complete.test + * tests/fa_is_cons.test + * fa.tcl: Fixed definition of 'is complete' for FAs without + symbols. Updated tests. Fixed deletion of states, added test for + the fixed case. Aded construction from serialization. Updated + tests. Added cache for epsilon closures. + + * fa.man: Removed the remnants of the documentation for 'state + priority'. Added the missing documentation for all 'is' commands + beyond 'deterministic'. + +2004-03-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * New module: Grammar operations, Finite Automatons. + diff --git a/tcllib/modules/grammar_fa/dacceptor.man b/tcllib/modules/grammar_fa/dacceptor.man new file mode 100644 index 0000000..6407ce5 --- /dev/null +++ b/tcllib/modules/grammar_fa/dacceptor.man @@ -0,0 +1,102 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin grammar::fa::dacceptor n 0.1.1] +[keywords acceptance] +[keywords acceptor] +[keywords automaton] +[keywords {finite automaton}] +[keywords grammar] +[keywords parsing] +[keywords {regular expression}] +[keywords {regular grammar}] +[keywords {regular languages}] +[keywords state] +[keywords transducer] +[copyright {2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[moddesc {Finite automaton operations and usage}] +[titledesc {Create and use deterministic acceptors}] +[category {Grammars and finite automata}] +[require Tcl 8.4] +[require snit] +[require struct::set] +[require grammar::fa::dacceptor [opt 0.1.1]] +[description] +[para] + +This package provides a class for acceptors constructed from +deterministic [term {finite automatons}] (DFA). Acceptors are objects +which can be given a string of symbols and tell if the DFA they are +constructed from would [term accept] that string. + +For the actual creation of the DFAs the acceptors are based on we have +the packages [package grammar::fa] and [package grammar::fa::op]. + +[para] + +[section API] + +The package exports the API described here. + +[list_begin definitions] + +[call [cmd ::grammar::fa::dacceptor] [arg daName] [arg fa] [opt "[option -any] [arg any]"]] + +Creates a new deterministic acceptor with an associated global Tcl command +whose name is [arg daName]. This command may be used to invoke various +operations on the acceptor. It has the following general form: + +[list_begin definitions] + +[call [cmd daName] [arg option] [opt [arg "arg arg ..."]]] + +[arg Option] and the [arg arg]s determine the exact behavior of the +command. See section [sectref {ACCEPTOR METHODS}] for more explanations. + +[para] + +The acceptor will be based on the deterministic finite automaton +stored in the object [arg fa]. It will keep a copy of the relevant +data of the FA in its own storage, in a form easy to use for its +purposes. This also means that changes made to the [arg fa] after the +construction of the acceptor [emph {will not}] influence the acceptor. + +[para] + +If [arg any] has been specified, then the acceptor will convert all +symbols in the input which are unknown to the base FA to that symbol +before proceeding with the processing. + +[list_end] +[list_end] + +[section {ACCEPTOR METHODS}] +[para] + +All acceptors provide the following methods for their manipulation: + +[list_begin definitions] + +[call [arg daName] [method destroy]] + +Destroys the automaton, including its storage space and associated +command. + +[call [arg daName] [method accept?] [arg symbols]] + +Takes the list of [arg symbols] and checks if the FA the acceptor is +based on would accept it. The result is a boolean value. [const True] +is returned if the symbols are accepted, and [const False] +otherwise. Note that bogus symbols in the input are either translated +to the [arg any] symbol (if specified), or cause the acceptance test +to simply fail. No errors will be thrown. The method will process only +just that prefix of the input which is enough to fully determine +(non-)acceptance. + +[list_end] + +[para] + +[section EXAMPLES] + +[vset CATEGORY grammar_fa] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/grammar_fa/dacceptor.tcl b/tcllib/modules/grammar_fa/dacceptor.tcl new file mode 100644 index 0000000..479db0c --- /dev/null +++ b/tcllib/modules/grammar_fa/dacceptor.tcl @@ -0,0 +1,166 @@ +# -*- tcl -*- +# Grammar / Finite Automatons / Acceptance checker, DFA only + +# ### ### ### ######### ######### ######### +## Package description + +## A class whose instances take a FA and are able to check strings of +## symbols for acceptance. This class is restricted to deterministic +## FAs. The FA can be either a reference to some external FA container +## object, or a copy of such. The latter makes the acceptor impervious +## to changes in the original definition. + +# ### ### ### ######### ######### ######### +## Requisites + +package require snit ; # Tcllib | OO system used +package require struct::set ; # Tcllib | Extended set operations. + +# ### ### ### ######### ######### ######### +## Implementation + +snit::type ::grammar::fa::dacceptor { + # ### ### ### ######### ######### ######### + ## Type API. + + # ### ### ### ######### ######### ######### + ## Instance API. + + #constructor {fa args} {} + #destructor {} + + method accept? {symbolstring} {} + + option -any {} + + # ### ### ### ######### ######### ######### + ## Internal data structures. + + ## We take the relevant information from the FA specified during + ## construction, i.e. start state, final states, and transition + ## table in form for direct indexing and keep it local. No need to + ## access or even the full FA. We require a deterministic one, and + ## will complete it, if necessary. + + variable start ; # Name of start state. + variable final ; # Array, existence = state is final. + variable trans ; # Transition array: state x symbol -> state + variable sym ; # Symbol set (as array), for checking existence. + variable any ; # Symbol to map any unknown symbol to. If not + # ; # specified (eq "") then unknown symbols will cause non- + # ; # acceptance. + variable stop ; # Stop state, causing immediate non-acceptance when entered. + + # ### ### ### ######### ######### ######### + ## Instance API Implementation. + + constructor {fa args} { + set any {} + $self configurelist $args + + if {![$fa is deterministic]} { + return -code error "Source FA is not deterministic" + } + if {($any ne "") && ![$fa symbol exists $any]} { + return -code error "Chosen any symbol \"$any\" does not exist" + } + + if {![$fa is complete]} { + set istmp 1 + set tmp [grammar::fa ${selfns}::fa = $fa] + set before [$tmp states] + $tmp complete + # Our sink is a stop state. + set stop [struct::set difference [$tmp states] $before] + } else { + set istmp 0 + set tmp $fa + # We don't know if there is a sink, so no quickstop. + set stop {} + } + + set start [lindex [$tmp startstates] 0] + foreach s [$tmp finalstates] {set final($s) .} + foreach s [set syms [$tmp symbols]] {set sym($s) .} + + foreach s [$tmp states] { + foreach sy $syms { + set trans($s,$sy) [lindex [$tmp next $s $sy] 0] + } + } + + if {$istmp} {$tmp destroy} + return + } + + #destructor {} + + onconfigure -any {value} { + set options(-any) $value + set any $value + return + } + + # --- --- --- --------- --------- --------- + + method accept? {symbolstring} { + set state $start + + ## puts "\n====================== ($symbolstring)" + + if {$any eq ""} { + # No any mapping of unknown symbols. + + foreach sy $symbolstring { + if {![info exists sym($sy)]} { + # Bad symbol in input. String is not accepted, + # abort immediately. + ## puts " \[$state\] -- Unknown symbol ($sy)" + return 0 + } + + ## puts " \[$state\] --($sy)--> " + + set state $trans($state,$sy) + # state == "" cannot happen, as our FA is complete. + if {$state eq $stop} { + # This is a known sink, we can stop processing input now. + ## puts " \[$state\] FULL STOP" + return 0 + } + } + + } else { + # Mapping of unknown symbols to any. + + foreach sy $symbolstring { + if {![info exists sym($sy)]} {set sy $any} + ## puts " \[$state\] --($sy)--> " + set state $trans($state,$sy) + # state == "" cannot happen, as our FA is complete. + if {$state eq $stop} { + # This is a known sink, we can stop processing input now. + ## puts " \[$state\] FULL STOP" + return 0 + } + } + } + + ## puts " \[$state\][expr {[info exists final($state)] ? " ACCEPT" : ""}]" + + return [info exists final($state)] + } + + # ### ### ### ######### ######### ######### + ## Type API implementation. + + # ### ### ### ######### ######### ######### + ## Type Internals. + + # ### ### ### ######### ######### ######### +} + +# ### ### ### ######### ######### ######### +## Package Management + +package provide grammar::fa::dacceptor 0.1.1 diff --git a/tcllib/modules/grammar_fa/dacceptor.test b/tcllib/modules/grammar_fa/dacceptor.test new file mode 100644 index 0000000..e12898b --- /dev/null +++ b/tcllib/modules/grammar_fa/dacceptor.test @@ -0,0 +1,45 @@ +# -*- tcl -*- +# daccept.test: tests for the grammar::fa::dacceptor - DFA acceptor class +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: dacceptor.test,v 1.10 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 1.0 + +support { + useAccel [useTcllibC] struct/sets.tcl struct::set + TestAccelInit struct::set + + use snit/snit.tcl snit ; # 1.1 always, even when Tcl 8.5 runs the testsuite. + use struct/list.tcl struct::list + + useLocal faop.tcl grammar::fa::op + useLocalKeep fa.tcl grammar::fa + + useLocalFile tests/Xsupport +} +testing { + useLocal dacceptor.tcl grammar::fa::dacceptor +} + +# ------------------------------------------------------------------------- + +set class ::grammar::fa::dacceptor + +# ------------------------------------------------------------------------- + +TestAccelDo struct::set setimpl { + TestFiles tests/da_*.test +} + +# ------------------------------------------------------------------------- +TestAccelExit struct::set +testsuiteCleanup diff --git a/tcllib/modules/grammar_fa/dexec.man b/tcllib/modules/grammar_fa/dexec.man new file mode 100644 index 0000000..fac0074 --- /dev/null +++ b/tcllib/modules/grammar_fa/dexec.man @@ -0,0 +1,183 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin grammar::fa::dexec n 0.2] +[keywords automaton] +[keywords execution] +[keywords {finite automaton}] +[keywords grammar] +[keywords parsing] +[keywords {regular expression}] +[keywords {regular grammar}] +[keywords {regular languages}] +[keywords running] +[keywords state] +[keywords transducer] +[copyright {2004 Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[copyright {2007 Bogdan <rftghost@users.sourceforge.net>}] +[moddesc {Finite automaton operations and usage}] +[titledesc {Execute deterministic finite automatons}] +[category {Grammars and finite automata}] +[require Tcl 8.4] +[require snit] +[require grammar::fa::dexec [opt 0.2]] +[description] +[para] + +This package provides a class for executors constructed from +deterministic [term {finite automatons}] (DFA). Executors are objects +which are given a string of symbols in a piecemal fashion, perform +state transitions and report back when they enter a final state, or +find an error in the input. + +For the actual creation of the DFAs the executors are based on we have +the packages [package grammar::fa] and [package grammar::fa::op]. + +[para] + +The objects follow a push model. Symbols are pushed into the executor, +and when something important happens, i.e. error occurs, a state transition, +or a final state is entered this will be reported via the callback +specified via the option [option -command]. Note that conversion of +this into a pull model where the environment retrieves messages from +the object and the object uses a callback to ask for more symbols is +a trivial thing. + +[para] + +[emph {Side note}]: + +The acceptor objects provided by [package grammar::fa::dacceptor] +could have been implemented on top of the executors provided here, but +were not, to get a bit more performance (we avoid a number of method +calls and the time required for their dispatch). + +[para] + +[section API] + +The package exports the API described here. + +[list_begin definitions] + +[call [cmd ::grammar::fa::dexec] [arg daName] [arg fa] [opt "[option -any] [arg any]"] [opt "[option -command] [arg cmdprefix]"]] + +Creates a new deterministic executor with an associated global Tcl +command whose name is [arg daName]. This command may be used to invoke +various operations on the executor. It has the following general form: + +[list_begin definitions] + +[call [cmd daName] [arg option] [opt [arg "arg arg ..."]]] + +[arg Option] and the [arg arg]s determine the exact behavior of the +command. See section [sectref {EXECUTOR METHODS}] for more +explanations. + +[para] + +The executor will be based on the deterministic finite automaton +stored in the object [arg fa]. It will keep a copy of the relevant +data of the FA in its own storage, in a form easy to use for its +purposes. This also means that changes made to the [arg fa] after the +construction of the executor [emph {will not}] influence the executor. + +[para] + +If [arg any] has been specified, then the executor will convert all +symbols in the input which are unknown to the base FA to that symbol +before proceeding with the processing. + +[list_end] +[list_end] + +[section {EXECUTOR METHODS}] +[para] + +All executors provide the following methods for their manipulation: + +[list_begin definitions] + +[call [arg daName] [method destroy]] + +Destroys the automaton, including its storage space and associated +command. + +[call [arg daName] [method put] [arg symbol]] + +Takes the current state of the executor and the [arg symbol] and +performs the appropriate state transition. Reports any errors +encountered via the command callback, as well as entering a final +state of the underlying FA. + +[para] + +When an error is reported all further invokations of [method put] will +do nothing, until the error condition has been cleared via an +invokation of method [method reset]. + +[call [arg daName] [method reset]] + +Unconditionally sets the executor into the start state of the +underlying FA. This also clears any error condition [method put] may +have encountered. + +[call [arg daName] [method state]] + +Returns the current state of the underlying FA. This allow for +introspection without the need to pass data from the callback command. + +[list_end] + +[section {EXECUTOR CALLBACK}] + +The callback command [arg cmdprefix] given to an executor via the +option [option -command] will be executed by the object at the global +level, using the syntax described below. Note that [arg cmdprefix] is +not simply the name of a command, but a full command prefix. In other +words it may contain additional fixed argument words beyond the +command word. + +[list_begin definitions] + +[call [arg cmdprefix] [method error] [arg code] [arg message]] + +The executor has encountered an error, and [arg message] contains a +human-readable text explaining the nature of the problem. + +The [arg code] on the other hand is a fixed machine-readable text. +The following error codes can be generated by executor objects. + +[list_begin definitions] +[def [const BADSYM]] + +An unknown symbol was found in the input. This can happen if and only +if no [option -any] symbol was specified. + +[def [const BADTRANS]] + +The underlying FA has no transition for the current combination of +input symbol and state. In other words, the executor was not able to +compute a new state for this combination. + +[list_end] + +[call [arg cmdprefix] [method final] [arg stateid]] + +The executor has entered the final state [arg stateid]. + +[call [arg cmdprefix] [method reset]] + +The executor was reset. + +[call [arg cmdprefix] [method state] [arg stateid]] + +The FA changed state due to a transition. [arg stateid] is the new state. + +[list_end] + +[para] + +[section EXAMPLES] + +[vset CATEGORY grammar_fa] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/grammar_fa/dexec.tcl b/tcllib/modules/grammar_fa/dexec.tcl new file mode 100644 index 0000000..022ec18 --- /dev/null +++ b/tcllib/modules/grammar_fa/dexec.tcl @@ -0,0 +1,188 @@ +# -*- tcl -*- +# Grammar / Finite Automatons / Executor, DFA only + +# ### ### ### ######### ######### ######### +## Package description + +## Instances take a DFA, keep a current state and update it in +## reaction incoming symbols. Notable events are reported via +## callback. Currently notable: Reset, reached a final state, +# reached an error. + +## From the above description it should be clear that this class is +## run in a push fashion. If not the last sentence has made this +## explicit, right ? Right! + +# ### ### ### ######### ######### ######### +## Requisites + +package require snit ; # Tcllib | OO system used + +# ### ### ### ######### ######### ######### +## Implementation + +snit::type ::grammar::fa::dexec { + # ### ### ### ######### ######### ######### + ## Type API. + + # ### ### ### ######### ######### ######### + ## Instance API. + + #constructor {fa args} {} + #destructor {} + + method reset {} {} + method put {sy} {} + method state {} {} + + option -command {} + option -any {} + + # ### ### ### ######### ######### ######### + ## Internal data structures. + + ## We take the relevant information from the FA specified during + ## construction, i.e. start state, final states, and transition + ## table in form for direct indexing and keep it local. No need to + ## access or even the full FA. We require a deterministic one, and + ## will complete it, if necessary. + + variable start ; # Name of start state. + variable final ; # Array, existence = state is final. + variable trans ; # Transition array: state x symbol -> state + variable sym ; # Symbol set (as array), for checking existence. + variable cmd ; # Command to call for various events. Required. + variable any ; # Symbol to map any unknown symbol to. If not + # ; # specified (eq "") then unknown symbols will cause non- + # ; # acceptance. + variable curr ; # State the underlying DFA is currently in. + variable inerr ; # Boolean flag. Set if an error was reached. + + + # ### ### ### ######### ######### ######### + ## Instance API Implementation. + + constructor {fa args} { + set any {} + set cmd {} + $self configurelist $args + + if {![$fa is deterministic]} { + return -code error "Source FA is not deterministic" + } + if {($any ne "") && ![$fa symbol exists $any]} { + return -code error "Chosen any symbol \"$any\" does not exist" + } + if {![llength $cmd]} { + return -code error "Command callback missing" + } + + # In contrast to the acceptor we do not complete the FA. We + # will later report BADTRANS errors instead if a non-existing + # transition is attempted. For the acceptor it made sense as + # it made the accept/!accept decision easier. However here for + # the generic execution it is unreasonable interference with + # whatever higher levels might wish to do when encountering + # this. + + set start [lindex [$fa startstates] 0] + foreach s [$fa finalstates] {set final($s) .} + foreach s [set syms [$fa symbols]] {set sym($s) .} + + foreach s [$fa states] { + foreach sy [$fa symbols@ $s] { + set trans($s,$sy) [lindex [$fa next $s $sy] 0] + } + } + + $self reset + return + } + + #destructor {} + + onconfigure -command {value} { + set options(-command) $value + set cmd $value + return + } + + onconfigure -any {value} { + set options(-any) $value + set any $value + return + } + + # --- --- --- --------- --------- --------- + + method reset {} { + set curr $start + set inerr 0 + ## puts -nonewline " \[$curr\]" ; flush stdout + + uplevel #0 [linsert $cmd end \ + reset] + return + } + + method state {} { + return $curr + } + + method put {sy} { + if {$inerr} return + ## puts " --($sy)-->" + + if {![info exists sym($sy)]} { + if {$any eq ""} { + # No any mapping of unknown symbols, report as error + ## puts " BAD SYMBOL" + + set inerr 1 + uplevel #0 [linsert $cmd end \ + error BADSYM "Bad symbol \"$sy\""] + return + } else { + # Mapping of unknown symbols to any. + set sy $any + } + } + + if {[catch { + set new $trans($curr,$sy) + }]} { + ## puts " NO DESTINATION" + set inerr 1 + uplevel #0 [linsert $cmd end \ + error BADTRANS "Bad transition (\"$curr\" \"$sy\"), no destination"] + return + } + set curr $new + + uplevel #0 [linsert $cmd end \ + state $curr] + + ## puts -nonewline " \[$curr\]" ; flush stdout + + if {[info exists final($curr)]} { + ## puts -nonewline " FINAL" ; flush stdout + + uplevel #0 [linsert $cmd end \ + final $curr] + } + return + } + + # ### ### ### ######### ######### ######### + ## Type API implementation. + + # ### ### ### ######### ######### ######### + ## Type Internals. + + # ### ### ### ######### ######### ######### +} + +# ### ### ### ######### ######### ######### +## Package Management + +package provide grammar::fa::dexec 0.2 diff --git a/tcllib/modules/grammar_fa/dexec.test b/tcllib/modules/grammar_fa/dexec.test new file mode 100644 index 0000000..463203c --- /dev/null +++ b/tcllib/modules/grammar_fa/dexec.test @@ -0,0 +1,45 @@ +# -*- tcl -*- +# dexec.test: tests for the grammar::fa::dexec - DFA executor class +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: dexec.test,v 1.10 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 1.0 + +support { + useAccel [useTcllibC] struct/sets.tcl struct::set + TestAccelInit struct::set + + use snit/snit.tcl snit ; # 1.1 always, even when Tcl 8.5 runs the testsuite. + use struct/list.tcl struct::list + + useLocal faop.tcl grammar::fa::op + useLocalKeep fa.tcl grammar::fa + + useLocalFile tests/Xsupport +} +testing { + useLocal dexec.tcl grammar::fa::dexec +} + +# ------------------------------------------------------------------------- + +set class ::grammar::fa::dexec + +# ------------------------------------------------------------------------- + +TestAccelDo struct::set setimpl { + TestFiles tests/de_*.test +} + +# ------------------------------------------------------------------------- +TestAccelExit struct::set +testsuiteCleanup diff --git a/tcllib/modules/grammar_fa/fa.man b/tcllib/modules/grammar_fa/fa.man new file mode 100644 index 0000000..fa341a3 --- /dev/null +++ b/tcllib/modules/grammar_fa/fa.man @@ -0,0 +1,652 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin grammar::fa n 0.4] +[keywords automaton] +[keywords {finite automaton}] +[keywords grammar] +[keywords parsing] +[keywords {regular expression}] +[keywords {regular grammar}] +[keywords {regular languages}] +[keywords state] +[keywords transducer] +[copyright {2004-2009 Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[moddesc {Finite automaton operations and usage}] +[titledesc {Create and manipulate finite automatons}] +[category {Grammars and finite automata}] +[require Tcl 8.4] +[require snit 1.3] +[require struct::list] +[require struct::set] +[require grammar::fa::op [opt 0.2]] +[require grammar::fa [opt 0.4]] +[description] +[para] + +This package provides a container class for +[term {finite automatons}] (Short: FA). + +It allows the incremental definition of the automaton, its +manipulation and querying of the definition. + +While the package provides complex operations on the automaton +(via package [package grammar::fa::op]), it does not have the +ability to execute a definition for a stream of symbols. + +Use the packages +[package grammar::fa::dacceptor] and +[package grammar::fa::dexec] for that. + +Another package related to this is [package grammar::fa::compiler]. It +turns a FA into an executor class which has the definition of the FA +hardwired into it. The output of this package is configurable to suit +a large number of different implementation languages and paradigms. + +[para] + +For more information about what a finite automaton is see section +[sectref {FINITE AUTOMATONS}]. + +[section API] + +The package exports the API described here. + +[list_begin definitions] + +[call [cmd ::grammar::fa] [arg faName] [opt "[const =]|[const :=]|[const <--]|[const as]|[const deserialize] [arg src]|[const fromRegex] [arg re] [opt [arg over]]"]] + +Creates a new finite automaton with an associated global Tcl command +whose name is [arg faName]. This command may be used to invoke various +operations on the automaton. It has the following general form: + +[list_begin definitions] + +[call [cmd faName] [arg option] [opt [arg "arg arg ..."]]] + +[arg Option] and the [arg arg]s determine the exact behavior of the +command. See section [sectref {FA METHODS}] for more explanations. The +new automaton will be empty if no [arg src] is specified. Otherwise +it will contain a copy of the definition contained in the [arg src]. + +The [arg src] has to be a FA object reference for all operators except +[const deserialize] and [const fromRegex]. The [const deserialize] +operator requires [arg src] to be the serialization of a FA instead, +and [const fromRegex] takes a regular expression in the form a of a +syntax tree. See [cmd ::grammar::fa::op::fromRegex] for more detail on +that. + +[list_end] +[list_end] + +[section {FA METHODS}] +[para] + +All automatons provide the following methods for their manipulation: + +[list_begin definitions] + +[call [arg faName] [method destroy]] + +Destroys the automaton, including its storage space and associated +command. + +[call [arg faName] [method clear]] + +Clears out the definition of the automaton contained in [arg faName], +but does [emph not] destroy the object. + +[call [arg faName] [method =] [arg srcFA]] + +Assigns the contents of the automaton contained +in [arg srcFA] to [arg faName], overwriting any +existing definition. + +This is the assignment operator for automatons. It copies the +automaton contained in the FA object [arg srcFA] over the automaton +definition in [arg faName]. The old contents of [arg faName] are +deleted by this operation. + +[para] + +This operation is in effect equivalent to +[para] +[example_begin] + [arg faName] [method deserialize] [lb][arg srcFA] [method serialize][rb] +[example_end] + +[call [arg faName] [method -->] [arg dstFA]] + +This is the reverse assignment operator for automatons. It copies the +automation contained in the object [arg faName] over the automaton +definition in the object [arg dstFA]. + +The old contents of [arg dstFA] are deleted by this operation. + +[para] + +This operation is in effect equivalent to +[para] +[example_begin] + [arg dstFA] [method deserialize] [lb][arg faName] [method serialize][rb] +[example_end] + +[call [arg faName] [method serialize]] + +This method serializes the automaton stored in [arg faName]. In other +words it returns a tcl [emph value] completely describing that +automaton. + +This allows, for example, the transfer of automatons over arbitrary +channels, persistence, etc. + +This method is also the basis for both the copy constructor and the +assignment operator. + +[para] + +The result of this method has to be semantically identical over all +implementations of the [package grammar::fa] interface. This is what +will enable us to copy automatons between different implementations of +the same interface. + +[para] + +The result is a list of three elements with the following structure: + +[list_begin enumerated] +[enum] +The constant string [const grammar::fa]. + +[enum] +A list containing the names of all known input symbols. The order of +elements in this list is not relevant. + +[enum] +The last item in the list is a dictionary, however the order of the +keys is important as well. The keys are the states of the serialized +FA, and their order is the order in which to create the states when +deserializing. This is relevant to preserve the order relationship +between states. + +[para] + +The value of each dictionary entry is a list of three elements +describing the state in more detail. + +[list_begin enumerated] +[enum] +A boolean flag. If its value is [const true] then the state is a +start state, otherwise it is not. + +[enum] +A boolean flag. If its value is [const true] then the state is a +final state, otherwise it is not. + +[enum] +The last element is a dictionary describing the transitions for the +state. The keys are symbols (or the empty string), and the values are +sets of successor states. + +[list_end] +[list_end] +[para] + +Assuming the following FA (which describes the life of a truck driver +in a very simple way :) + +[para] +[example { + Drive -- yellow --> Brake -- red --> (Stop) -- red/yellow --> Attention -- green --> Drive + (...) is the start state. +}] +[para] + +a possible serialization is + +[para] +[example { + grammar::fa \\ + {yellow red green red/yellow} \\ + {Drive {0 0 {yellow Brake}} \\ + Brake {0 0 {red Stop}} \\ + Stop {1 0 {red/yellow Attention}} \\ + Attention {0 0 {green Drive}}} +}] +[para] + +A possible one, because I did not care about creation order here + +[call [arg faName] [method deserialize] [arg serialization]] + +This is the complement to [method serialize]. It replaces the +automaton definition in [arg faName] with the automaton described by +the [arg serialization] value. The old contents of [arg faName] are +deleted by this operation. + +[call [arg faName] [method states]] + +Returns the set of all states known to [arg faName]. + +[call [arg faName] [method state] [method add] [arg s1] [opt "[arg s2] ..."]] + +Adds the states [arg s1], [arg s2], et cetera to the FA definition in +[arg faName]. The operation will fail any of the new states is already +declared. + +[call [arg faName] [method state] [method delete] [arg s1] [opt "[arg s2] ..."]] + +Deletes the state [arg s1], [arg s2], et cetera, and all associated +information from the FA definition in [arg faName]. The latter means +that the information about in- or outbound transitions is deleted as +well. If the deleted state was a start or final state then this +information is invalidated as well. The operation will fail if the +state [arg s] is not known to the FA. + +[call [arg faName] [method state] [method exists] [arg s]] + +A predicate. It tests whether the state [arg s] is known to the FA in +[arg faName]. + +The result is a boolean value. It will be set to [const true] if the +state [arg s] is known, and [const false] otherwise. + +[call [arg faName] [method state] [method rename] [arg s] [arg snew]] + +Renames the state [arg s] to [arg snew]. Fails if [arg s] is not a +known state. Also fails if [arg snew] is already known as a state. + +[call [arg faName] [method startstates]] + +Returns the set of states which are marked as [term start] states, +also known as [term initial] states. + +See [sectref {FINITE AUTOMATONS}] for explanations what this means. + +[call [arg faName] [method start] [method add] [arg s1] [opt "[arg s2] ..."]] + +Mark the states [arg s1], [arg s2], et cetera in the FA [arg faName] +as [term start] (aka [term initial]). + +[call [arg faName] [method start] [method remove] [arg s1] [opt "[arg s2] ..."]] + +Mark the states [arg s1], [arg s2], et cetera in the FA [arg faName] +as [term {not start}] (aka [term {not accepting}]). + +[call [arg faName] [method start?] [arg s]] + +A predicate. It tests if the state [arg s] in the FA [arg faName] is +[term start] or not. + +The result is a boolean value. It will be set to [const true] if the +state [arg s] is [term start], and [const false] otherwise. + +[call [arg faName] [method start?set] [arg stateset]] + +A predicate. It tests if the set of states [arg stateset] contains at +least one start state. They operation will fail if the set contains an +element which is not a known state. + +The result is a boolean value. It will be set to [const true] if a +start state is present in [arg stateset], and [const false] otherwise. + +[call [arg faName] [method finalstates]] + +Returns the set of states which are marked as [term final] states, +also known as [term accepting] states. + +See [sectref {FINITE AUTOMATONS}] for explanations what this means. + +[call [arg faName] [method final] [method add] [arg s1] [opt "[arg s2] ..."]] + +Mark the states [arg s1], [arg s2], et cetera in the FA [arg faName] +as [term final] (aka [term accepting]). + +[call [arg faName] [method final] [method remove] [arg s1] [opt "[arg s2] ..."]] + +Mark the states [arg s1], [arg s2], et cetera in the FA [arg faName] +as [term {not final}] (aka [term {not accepting}]). + +[call [arg faName] [method final?] [arg s]] + +A predicate. It tests if the state [arg s] in the FA [arg faName] is +[term final] or not. + +The result is a boolean value. It will be set to [const true] if the +state [arg s] is [term final], and [const false] otherwise. + +[call [arg faName] [method final?set] [arg stateset]] + +A predicate. It tests if the set of states [arg stateset] contains at +least one final state. They operation will fail if the set contains an +element which is not a known state. + +The result is a boolean value. It will be set to [const true] if a +final state is present in [arg stateset], and [const false] otherwise. + +[call [arg faName] [method symbols]] + +Returns the set of all symbols known to the FA [arg faName]. + +[call [arg faName] [method symbols@] [arg s] [opt [arg d]]] + +Returns the set of all symbols for which the state [arg s] has transitions. +If the empty symbol is present then [arg s] has epsilon transitions. If two +states are specified the result is the set of symbols which have transitions +from [arg s] to [arg t]. This set may be empty if there are no transitions +between the two specified states. + +[call [arg faName] [method symbols@set] [arg stateset]] + +Returns the set of all symbols for which at least one state in the set +of states [arg stateset] has transitions. + +In other words, the union of [lb][arg faName] [method symbols@] [var s][rb] +for all states [var s] in [arg stateset]. + +If the empty symbol is present then at least one state contained in +[arg stateset] has epsilon transitions. + +[call [arg faName] [method symbol] [method add] [arg sym1] [opt "[arg sym2] ..."]] + +Adds the symbols [arg sym1], [arg sym2], et cetera to the FA +definition in [arg faName]. The operation will fail any of the symbols +is already declared. The empty string is not allowed as a value for the symbols. + +[call [arg faName] [method symbol] [method delete] [arg sym1] [opt "[arg sym2] ..."]] + +Deletes the symbols [arg sym1], [arg sym2] et cetera, and all +associated information from the FA definition in [arg faName]. The +latter means that all transitions using the symbols are deleted as +well. The operation will fail if any of the symbols is not known to +the FA. + +[call [arg faName] [method symbol] [method rename] [arg sym] [arg newsym]] + +Renames the symbol [arg sym] to [arg newsym]. Fails if [arg sym] is +not a known symbol. Also fails if [arg newsym] is already known as a +symbol. + +[call [arg faName] [method symbol] [method exists] [arg sym]] + +A predicate. It tests whether the symbol [arg sym] is known to the FA +in [arg faName]. + +The result is a boolean value. It will be set to [const true] if the +symbol [arg sym] is known, and [const false] otherwise. + +[call [arg faName] [method next ] [arg s] [arg sym] [opt "[const -->] [arg next]"]] + +Define or query transition information. + +[para] + +If [arg next] is specified, then the method will add a transition from +the state [arg s] to the [term successor] state [arg next] labeled with +the symbol [arg sym] to the FA contained in [arg faName]. The +operation will fail if [arg s], or [arg next] are not known states, or +if [arg sym] is not a known symbol. An exception to the latter is that +[arg sym] is allowed to be the empty string. In that case the new +transition is an [term {epsilon transition}] which will not consume +input when traversed. The operation will also fail if the combination +of ([arg s], [arg sym], and [arg next]) is already present in the FA. + +[para] + +If [arg next] was not specified, then the method will return +the set of states which can be reached from [arg s] through +a single transition labeled with symbol [arg sym]. + +[call [arg faName] [method !next] [arg s] [arg sym] [opt "[const -->] [arg next]"]] + +Remove one or more transitions from the Fa in [arg faName]. +[para] + +If [arg next] was specified then the single transition from the state +[arg s] to the state [arg next] labeled with the symbol [arg sym] is +removed from the FA. Otherwise [emph all] transitions originating in +state [arg s] and labeled with the symbol [arg sym] will be removed. + +[para] + +The operation will fail if [arg s] and/or [arg next] are not known as +states. It will also fail if a non-empty [arg sym] is not known as +symbol. The empty string is acceptable, and allows the removal of +epsilon transitions. + +[call [arg faName] [method nextset] [arg stateset] [arg sym]] + +Returns the set of states which can be reached by a single transition +originating in a state in the set [arg stateset] and labeled with the +symbol [arg sym]. + +[para] + +In other words, this is the union of +[lb][arg faName] next [var s] [arg symbol][rb] +for all states [var s] in [arg stateset]. + +[call [arg faName] [method is] [method deterministic]] + +A predicate. It tests whether the FA in [arg faName] is a +deterministic FA or not. + +The result is a boolean value. It will be set to [const true] if the +FA is deterministic, and [const false] otherwise. + +[call [arg faName] [method is] [method complete]] + +A predicate. It tests whether the FA in [arg faName] is a complete FA +or not. A FA is complete if it has at least one transition per state +and symbol. This also means that a FA without symbols, or states is +also complete. + +The result is a boolean value. It will be set to [const true] if the +FA is deterministic, and [const false] otherwise. + +[para] + +Note: When a FA has epsilon-transitions transitions over a symbol for +a state S can be indirect, i.e. not attached directly to S, but to a +state in the epsilon-closure of S. The symbols for such indirect +transitions count when computing completeness. + +[call [arg faName] [method is] [method useful]] + +A predicate. It tests whether the FA in [arg faName] is an useful FA +or not. A FA is useful if all states are [term reachable] +and [term useful]. + +The result is a boolean value. It will be set to [const true] if the +FA is deterministic, and [const false] otherwise. + +[call [arg faName] [method is] [method epsilon-free]] + +A predicate. It tests whether the FA in [arg faName] is an +epsilon-free FA or not. A FA is epsilon-free if it has no epsilon +transitions. This definition means that all deterministic FAs are +epsilon-free as well, and epsilon-freeness is a necessary +pre-condition for deterministic'ness. + +The result is a boolean value. It will be set to [const true] if the +FA is deterministic, and [const false] otherwise. + +[call [arg faName] [method reachable_states]] + +Returns the set of states which are reachable from a start state by +one or more transitions. + +[call [arg faName] [method unreachable_states]] + +Returns the set of states which are not reachable from any start state +by any number of transitions. This is + +[para] +[example { + [faName states] - [faName reachable_states] +}] + +[call [arg faName] [method reachable] [arg s]] + +A predicate. It tests whether the state [arg s] in the FA [arg faName] +can be reached from a start state by one or more transitions. + +The result is a boolean value. It will be set to [const true] if the +state can be reached, and [const false] otherwise. + +[call [arg faName] [method useful_states]] + +Returns the set of states which are able to reach a final state by +one or more transitions. + +[call [arg faName] [method unuseful_states]] + +Returns the set of states which are not able to reach a final state by +any number of transitions. This is + +[para] +[example { + [faName states] - [faName useful_states] +}] + +[call [arg faName] [method useful] [arg s]] + +A predicate. It tests whether the state [arg s] in the FA [arg faName] +is able to reach a final state by one or more transitions. + +The result is a boolean value. It will be set to [const true] if the +state is useful, and [const false] otherwise. + +[call [arg faName] [method epsilon_closure] [arg s]] + +Returns the set of states which are reachable from the state [arg s] +in the FA [arg faName] by one or more epsilon transitions, i.e +transitions over the empty symbol, transitions which do not consume +input. This is called the [term {epsilon closure}] of [arg s]. + +[call [arg faName] [method reverse]] +[call [arg faName] [method complete]] +[call [arg faName] [method remove_eps]] +[call [arg faName] [method trim] [opt [arg what]]] +[call [arg faName] [method determinize] [opt [arg mapvar]]] +[call [arg faName] [method minimize] [opt [arg mapvar]]] + +[call [arg faName] [method complement]] +[call [arg faName] [method kleene]] +[call [arg faName] [method optional]] +[call [arg faName] [method union] [arg fa] [opt [arg mapvar]]] +[call [arg faName] [method intersect] [arg fa] [opt [arg mapvar]]] +[call [arg faName] [method difference] [arg fa] [opt [arg mapvar]]] +[call [arg faName] [method concatenate] [arg fa] [opt [arg mapvar]]] + +[call [arg faName] [method fromRegex] [arg regex] [opt [arg over]]] + +These methods provide more complex operations on the FA. Please see +the same-named commands in the package [package grammar::fa::op] for +descriptions of what they do. + +[list_end] + +[para] + +[section EXAMPLES] +[para] + +[section {FINITE AUTOMATONS}] +[para] + +For the mathematically inclined, a FA is a 5-tuple (S,Sy,St,Fi,T) where + +[list_begin itemized] +[item] +S is a set of [term {states}], + +[item] +Sy a set of [term {input symbols}], + +[item] +St is a subset of S, the set of [term start] states, also known as +[term initial] states. + +[item] +Fi is a subset of S, the set of [term final] states, also known as +[term accepting]. + +[item] +T is a function from S x (Sy + epsilon) to {S}, the [term {transition function}]. + +Here [const epsilon] denotes the empty input symbol and is distinct +from all symbols in Sy; and {S} is the set of subsets of S. In other +words, T maps a combination of State and Input (which can be empty) to +a set of [term {successor states}]. + +[list_end] +[para] + +In computer theory a FA is most often shown as a graph where the nodes +represent the states, and the edges between the nodes encode the +transition function: For all n in S' = T (s, sy) we have one edge +between the nodes representing s and n resp., labeled with sy. The +start and accepting states are encoded through distinct visual +markers, i.e. they are attributes of the nodes. + +[para] + +FA's are used to process streams of symbols over Sy. + +[para] + +A specific FA is said to [term accept] a finite stream sy_1 sy_2 +... sy_n if there is a path in the graph of the FA beginning at a +state in St and ending at a state in Fi whose edges have the labels +sy_1, sy_2, etc. to sy_n. + +The set of all strings accepted by the FA is the [term language] of +the FA. One important equivalence is that the set of languages which +can be accepted by an FA is the set of [term {regular languages}]. + +[para] + +Another important concept is that of deterministic FAs. A FA is said +to be [term deterministic] if for each string of input symbols there +is exactly one path in the graph of the FA beginning at the start +state and whose edges are labeled with the symbols in the string. + +While it might seem that non-deterministic FAs to have more power of +recognition, this is not so. For each non-deterministic FA we can +construct a deterministic FA which accepts the same language (--> +Thompson's subset construction). + +[para] + +While one of the premier applications of FAs is in [term parsing], +especially in the [term lexer] stage (where symbols == characters), +this is not the only possibility by far. + +[para] + +Quite a lot of processes can be modeled as a FA, albeit with a +possibly large set of states. For these the notion of accepting states +is often less or not relevant at all. What is needed instead is the +ability to act to state changes in the FA, i.e. to generate some +output in response to the input. + +This transforms a FA into a [term {finite transducer}], which has an +additional set OSy of [term {output symbols}] and also an additional +[term {output function}] O which maps from "S x (Sy + epsilon)" to +"(Osy + epsilon)", i.e a combination of state and input, possibly +empty to an output symbol, or nothing. + +[para] + +For the graph representation this means that edges are additional +labeled with the output symbol to write when this edge is traversed +while matching input. Note that for an application "writing an output +symbol" can also be "executing some code". + +[para] + +Transducers are not handled by this package. They will get their own +package in the future. + +[vset CATEGORY grammar_fa] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/grammar_fa/fa.tcl b/tcllib/modules/grammar_fa/fa.tcl new file mode 100644 index 0000000..8e116d0 --- /dev/null +++ b/tcllib/modules/grammar_fa/fa.tcl @@ -0,0 +1,1242 @@ +# -*- tcl -*- +# (c) 2004-2013 Andreas Kupries +# Grammar / Finite Automatons / Container + +# ### ### ### ######### ######### ######### +## Package description + +## A class whose instances hold all the information describing a +## single finite automaton (states, symbols, start state, set of +## accepting states, transition function), and operations to define, +## manipulate, and query this information. + +# ### ### ### ######### ######### ######### +## Requisites + +package require Tcl 8.4 +if {[package vcompare [package present Tcl] 8.5] >= 0} { + # Tcl 8.5+, extended package version numbers. + # Require 1.3 and beyond, regardless of major version number. + package require snit 1.3- ; # OO system in use (Using hierarchical methods) +} else { + # Tcl 8.4, emulate, ask for 2.x first, then 1.3+. + if {[catch { + package require snit 2 ; # OO system in use (Using hierarchical methods) + }]} { + package require snit 1.3 ; # OO system in use (Using hierarchical methods) + } +} + +package require grammar::fa::op ; # Heavy FA operations. +package require struct::list ; # Extended list operations. +package require struct::set ; # Extended set operations. + +# ### ### ### ######### ######### ######### +## Implementation + +snit::type ::grammar::fa { + # ### ### ### ######### ######### ######### + ## Type API. A number of operations on FAs + + # ### ### ### ######### ######### ######### + ## Instance API + + #constructor {args} {} + #destructor {} + + method = {b} {} + method --> {b} {} + + method serialize {} {} + method deserialize {value} {} + method deserialize_merge {value} {} + + method states {} {} + #method state {cmd s args} {} + + method startstates {} {} + method start? {s} {} + method start?set {states} {} + #method start {cmd args} {} + + method finalstates {} {} + method final? {s} {} + method final?set {states} {} + #method final {cmd args} {} + + method symbols {} {} + method symbols@ {state} {} + method symbols@set {states} {} + #method symbol {cmd sym} {} + + method next {s sym args} {} + method !next {s sym args} {} + method nextset {states sym} {} + + method is {cmd} {} + + method reachable_states {} {} + method unreachable_states {} {} + method reachable {s} {} + + method useful_states {} {} + method unuseful_states {} {} + method useful {s} {} + + method epsilon_closure {s} {} + + method clear {} {} + + # ### ### ### ######### ######### ######### + ## Instance API. Complex FA operations. + ## The heavy lifting is done by the operations package. + + method reverse {} {op::reverse $self} + method complete {{sink {}}} {op::complete $self $sink} + method remove_eps {} {op::remove_eps $self} + method trim {{what !reachable|!useful}} {op::trim $self $what} + method complement {} {op::complement $self} + method kleene {} {op::kleene $self} + method optional {} {op::optional $self} + method fromRegex {regex {over {}}} {op::fromRegex $self $regex $over} + + method determinize {{mapvar {}}} { + if {$mapvar ne ""} {upvar 1 $mapvar map} + op::determinize $self map + } + + method minimize {{mapvar {}}} { + if {$mapvar ne ""} {upvar 1 $mapvar map} + op::minimize $self map + } + + method union {fa {mapvar {}}} { + if {$mapvar ne ""} {upvar 1 $mapvar map} + op::union $self $fa map + } + + method intersect {fa {mapvar {}}} { + if {$mapvar ne ""} {upvar 1 $mapvar map} + op::intersect $self $fa map + } + + method difference {fa {mapvar {}}} { + if {$mapvar ne ""} {upvar 1 $mapvar map} + op::difference $self $fa map + } + + method concatenate {fa {mapvar {}}} { + if {$mapvar ne ""} {upvar 1 $mapvar map} + op::concatenate $self $fa map + } + + # ### ### ### ######### ######### ######### + ## Internal data structures. + + ## State information: + ## - Order : Defined for all states, values provide creation order. + ## - Start : Defined for states which are "start" (Input processing begins in). + ## - Final : Defined for states which are "final" ("accept" input). + ## - Transinv : Inverse transitions. Per state the set of (state,sym)'s + ## which have transitions into the state. Defined only for + ## states which have inbound transitions. + ## + ## Transinv is maintained to make state deletion easier: Direct + ## access to the states and transitions which are inbound, for + ## their deletion. + + variable order ; # Map : State -> Order of creation + variable final ; # Map : State -> . Exists <=> Is a final State + variable start ; # Map : State -> . Exists <=> Is a start State + variable transinv ; # Map : State -> {(State, Sym)} + + ## Global information: + ## - Scount : Counter for creation order of states. + + variable scount 0 ; # Counter for orderering states. + + ## Symbol information: + ## - Symbol : Defined for all symbols, values irrelevant. + + variable symbol ; # Map : Symbol -> . Exists = Symbol declared. + + ## Transition data: + ## - TransN : Dynamically created instance variables. Transition tables + ## for single states. Defined only for states which have + ## transitions. + ## - Transym : List of states having transitions on that symbol. + + ## Transym is maintained for symbol deletion. Direct access to the transitions + ## we have to delete as well. + + ## selfns::trans_$order(state) : Per state map : symbol -> list of destinations. + variable transym ; # Map : Sym -> {State} + + ## Derived information: + ## - Reach : Cache for set of states reachable from start. + ## - Reachvalid : Boolean flag. True iff the reach cache contains valid data + ## - Useful : Cache for set of states able to reach final. + ## - Usefulvalid : Boolean flag. True iff the useful cache contains valid data + ## - Nondete : Set of states which are non-deterministic, because they have + # epsilon-transitions. + # - EC : Cache of epsilon-closures + + variable reach {} ; # Set of states reachable from 'start'. + variable reachvalid 0 ; # Boolean flag, if 'reach' is valid. + + variable useful {} ; # Set of states able to reach 'final'. + variable usefulvalid 0 ; # Boolean flag, if 'useful' is valid. + + variable nondete {} ; # Set of non-deterministic states, by epsilon/non-epsilon. + variable nondets ; # Per non-det state the set of symbols it is non-det in. + + variable ec ; # Cache of epsilon-closures for states. + + + # ### ### ### ######### ######### ######### + ## Instance API Implementation. + + constructor {args} { + set alen [llength $args] + if {($alen != 2) && ($alen != 0) && ($alen != 3)} { + return -code error "wrong#args: $self ?=|:=|<--|as|deserialize a'|fromRegex re ?over??" + } + + array set order {} ; set nondete {} + array set start {} ; set scount 0 + array set final {} ; set reach {} + array set symbol {} ; set reachvalid 0 + array set transym {} ; set useful {} + array set transinv {} ; set usefulvalid 0 + array set nondets {} + array set ec {} + + if {$alen == 0} return + + foreach {cmd object} $args break + switch -exact -- $cmd { + = - := - <-- - as { + if {$alen != 2} { + return -code error "wrong#args: $self ?=|:=|<--|as|deserialize a'|fromRegex re ?over??" + } + $self = $object + } + deserialize { + if {$alen != 2} { + return -code error "wrong#args: $self ?=|:=|<--|as|deserialize a'|fromRegex re ?over??" + } + # Object is actually a value, the deserialization to use. + $self deserialize $object + } + fromRegex { + # Object is actually a value, the regular expression to use. + if {$alen == 2} { + $self fromRegex $object + } else { + $self fromRegex $object [lindex $args 2] + } + } + default { + return -code error "bad assignment: $self ?=|:=|<--|as|deserialize a'|fromRegex re ?over??" + } + } + return + } + + # destructor {} + + # --- --- --- --------- --------- --------- + + method = {b} { + $self deserialize [$b serialize] + } + + method --> {b} { + $b deserialize [$self serialize] + } + + # --- --- --- --------- --------- --------- + + method serialize {} { + set ord {} + foreach {s n} [array get order] { + lappend ord [list $s $n] + } + set states {} ; # Dictionary + foreach item [lsort -index 1 -integer -increasing $ord] { + set s [lindex $item 0] + set sdata {} + + # Dict data per state : + + lappend sdata [info exists start($s)] + lappend sdata [info exists final($s)] + + # Transitions from the state. + + upvar #0 ${selfns}::trans_$order($s) jump + + if {![info exists jump]} { + lappend sdata {} + } else { + lappend sdata [array get jump] + } + + # ---------------------- + lappend states $s $sdata + } + + return [::list \ + grammar::fa \ + [array names symbol] \ + $states \ + ] + } + + method deserialize {value} { + $self CheckSerialization $value st states acc tr newsymbols + $self clear + + foreach s $states {set order($s) [incr scount]} + foreach sym $newsymbols {set symbol($sym) .} + foreach s $acc {set final($s) .} + foreach s $st {set start($s) .} + + foreach {sa sym se} $tr {$self Next $sa $sym $se} + return + } + + method deserialize_merge {value} { + $self CheckSerialization $value st states acc tr newsymbols + + foreach s $states {set order($s) [incr scount]} + foreach sym $newsymbols {set symbol($sym) .} + foreach s $acc {set final($s) .} + foreach s $st {set start($s) .} + + foreach {sa sym se} $tr {$self Next $sa $sym $se} + return + } + + # --- --- --- --------- --------- --------- + + method states {} { + return [array names order] + } + + method {state add} {s args} { + set args [linsert $args 0 $s] + foreach s $args { + if {[info exists order($s)]} { + return -code error "State \"$s\" is already known" + } + } + foreach s $args {set order($s) [incr scount]} + return + } + + method {state delete} {s args} { + set args [linsert $args 0 $s] + $self StateCheckSet $args + + foreach s $args { + unset -nocomplain start($s) ; # Start/Initial indicator + unset -nocomplain final($s) ; # Final/Accept indicator + + # Remove all inbound transitions. + if {[info exists transinv($s)]} { + set src $transinv($s) + unset transinv($s) + + foreach srcitem $src { + struct::list assign $srcitem sin sym + $self !Next $sin $sym $s + } + } + + # We remove transition data only after the inbound + # ones. Otherwise we screw up the removal of + # looping transitions. We have to consider the + # backpointers to us in transinv as well. + + upvar #0 ${selfns}::trans_$order($s) jump + if {[info exists jump]} { + foreach sym [array names jump] { + $self !Transym $s $sym + foreach nexts $jump($sym) { + $self !Transinv $s $sym $nexts + } + } + + unset ${selfns}::trans_$order($s) ; # Transitions from s + } + unset order($s) ; # State ordering + + # Removal of a state may break the automaton into + # disconnected pieces. This means that the set of + # reachable and useful states may change, and the + # cache cannot be used from now on. + + $self InvalidateReach + $self InvalidateUseful + } + return + } + + method {state rename} {s snew} { + $self StateCheck $s + if {[info exists order($snew)]} { + return -code error "State \"$snew\" is already known" + } + + set o $order($s) + unset order($s) ; # State ordering + set order($snew) $o + + # Start/Initial indicator + if {[info exists start($s)]} { + set start($snew) $start($s) + unset start($s) + } + # Final/Accept indicator + if {[info exists final($s)]} { + set final($snew) $final($s) + unset final($s) + } + # Update all inbound transitions. + if {[info exists transinv($s)]} { + set transinv($snew) $transinv($s) + unset transinv($s) + + # We have to perform a bit more here. We have to + # go through the inbound transitions and change the + # listed destination state to the new name. + + foreach srcitem $transinv($snew) { + struct::list assign $srcitem sin sym + # For loops access the 'order' array under the + # new name, the old entry is already gone. See + # above. See bug SF 2595296. + if {$sin eq $s} { + set sin $snew + } + upvar #0 ${selfns}::trans_$order($sin) jump + upvar 0 jump($sym) destinations + set pos [lsearch -exact $destinations $s] + set destinations [lreplace $destinations $pos $pos $snew] + } + } + + # Another place to change are the back pointers from + # all the states we have transitions to, i.e. transinv + # for all outbound states. + + upvar #0 ${selfns}::trans_$o jump + if {[info exists jump]} { + foreach sym [array names jump] { + foreach sout $jump($sym) { + upvar 0 transinv($sout) backpointer + set pos [lsearch -exact $backpointer [list $s $sym]] + set backpointer [lreplace $backpointer $pos $pos [list $snew $sym]] + } + + # And also to update: Transym information for the symbol. + upvar 0 transym($sym) users + set pos [lsearch -exact $users $s] + set users [lreplace $users $pos $pos $snew] + } + } + + # Changing the name of a state does not change the + # reachables / useful states per se. We just may have + # to replace the name in the caches as well. + + # - Invalidation will do the same, at the expense of a + # - larger computation later. + + $self InvalidateReach + $self InvalidateUseful + return + } + + method {state exists} {s} { + return [info exists order($s)] + } + + # --- --- --- --------- --------- --------- + + method startstates {} { + return [array names start] + } + + method start? {s} { + $self StateCheck $s + return [info exists start($s)] + } + + method start?set {states} { + $self StateCheckSet $states + foreach s $states { + if {[info exists start($s)]} {return 1} + } + return 0 + } + + # Note: Adding or removing start states does not change + # usefulness, only reachability + + method {start add} {state args} { + set args [linsert $args 0 $state] + $self StateCheckSet $args + foreach s $args {set start($s) .} + $self InvalidateReach + return + } + + method {start set} {states} { + $self StateCheckSet $states + array unset start + foreach s $states {set start($s) .} + $self InvalidateReach + return + } + + method {start remove} {state args} { + set args [linsert $args 0 $state] + $self StateCheckSet $args + foreach s $args { + unset -nocomplain start($s) + } + $self InvalidateReach + return + } + + method {start clear} {} { + array unset start + $self InvalidateReach + return + } + + # --- --- --- --------- --------- --------- + + method finalstates {} { + return [array names final] + } + + method final? {s} { + $self StateCheck $s + return [info exists final($s)] + } + + method final?set {states} { + $self StateCheckSet $states + foreach s $states { + if {[info exists final($s)]} {return 1} + } + return 0 + } + + # Note: Adding or removing final states does not change + # reachability, only usefulness + + method {final add} {state args} { + set args [linsert $args 0 $state] + $self StateCheckSet $args + foreach s $args {set final($s) .} + $self InvalidateUseful + return + } + + method {final set} {states} { + $self StateCheckSet $states + array unset final + foreach s $states {set final($s) .} + $self InvalidateReach + return + } + + method {final remove} {state args} { + set args [linsert $args 0 $state] + $self StateCheckSet $args + foreach s $args { + unset -nocomplain final($s) + } + $self InvalidateUseful + return + } + + method {final clear} {} { + array unset final + $self InvalidateReach + return + } + + # --- --- --- --------- --------- --------- + + method symbols {} { + return [array names symbol] + } + + method symbols@ {s {t {}}} { + $self StateCheck $s + if {$t ne ""} { $self StateCheck $t} + upvar #0 ${selfns}::trans_$order($s) jump + if {![info exists jump]} {return {}} + if {$t eq ""} { + # No destination, all symbols. + return [array names jump] + } + # Specific destination, locate the symbols going there. + set result {} + foreach sym [array names jump] { + if {[lsearch -exact $jump($sym) $t] < 0} continue + lappend result $sym + } + return [lsort -uniq $result] + } + + method symbols@set {states} { + # Union (fa symbol@ s, f.a. s in states) + + $self StateCheckSet $states + set result {} + foreach s $states { + upvar #0 ${selfns}::trans_$order($s) jump + if {![info exists jump]} continue + foreach sym [array names jump] { + lappend result $sym + } + } + return [lsort -uniq $result] + } + + method {symbol add} {sym args} { + set args [linsert $args 0 $sym] + foreach sym $args { + if {$sym eq ""} { + return -code error "Cannot add illegal empty symbol \"\"" + } + if {[info exists symbol($sym)]} { + return -code error "Symbol \"$sym\" is already known" + } + } + foreach sym $args {set symbol($sym) .} + return + } + + method {symbol delete} {sym args} { + set args [linsert $args 0 $sym] + $self SymbolCheckSetNE $args + foreach sym $args { + unset symbol($sym) + + # Delete all transitions using the removed symbol. + + if {[info exists transym($sym)]} { + foreach s $transym($sym) { + $self !Next $s $sym + } + } + } + return + } + + method {symbol rename} {sym newsym} { + $self SymbolCheckNE $sym + if {$newsym eq ""} { + return -code error "Cannot add illegal empty symbol \"\"" + } + if {[info exists symbol($newsym)]} { + return -code error "Symbol \"$newsym\" is already known" + } + + unset symbol($sym) + set symbol($newsym) . + + if {[info exists transym($sym)]} { + set transym($newsym) [set states $transym($sym)] + unset transym($sym) + + foreach s $states { + # Update the jump tables for each of the states + # using this symbol, and the reverse tables as + # well. + + upvar #0 ${selfns}::trans_$order($s) jump + set jump($newsym) [set destinations $jump($sym)] + unset jump($sym) + + foreach sd $destinations { + upvar 0 transinv($sd) backpointer + set pos [lsearch -exact $backpointer [list $s $sym]] + set backpointer [lreplace $backpointer $pos $pos [list $s $newsym]] + } + } + } + return + } + + method {symbol exists} {sym} { + return [info exists symbol($sym)] + } + + # --- --- --- --------- --------- --------- + + method next {s sym args} { + ## Split into checking and functionality ... + + set alen [llength $args] + if {($alen != 2) && ($alen != 0)} { + return -code error "wrong#args: [list $self] next s sym ?--> s'?" + } + $self StateCheck $s + $self SymbolCheck $sym + + if {($alen == 2) && [set cmd [lindex $args 0]] ne "-->"} { + return -code error "Expected -->, got \"$cmd\"" + } + + if {$alen == 0} { + # Query transition table. + upvar #0 ${selfns}::trans_$order($s) jump + if {![info exists jump($sym)]} {return {}} + return $jump($sym) + } + + set nexts [lindex $args 1] + $self StateCheck $nexts + + upvar #0 ${selfns}::trans_$order($s) jump + if {[info exists jump($sym)] && [struct::set contains $jump($sym) $nexts]} { + return -code error "Transition \"($s, ($sym)) --> $nexts\" is already known" + } + + $self Next $s $sym $nexts + return + } + + method !next {s sym args} { + set alen [llength $args] + if {($alen != 2) && ($alen != 0)} { + return -code error "wrong#args: [list $self] !next s sym ?--> s'?" + } + $self StateCheck $s + $self SymbolCheck $sym + + if {$alen == 2} { + if {[lindex $args 0] ne "-->"} { + return -code error "Expected -->, got \"[lindex $args 0]\"" + } + set nexts [lindex $args 1] + $self StateCheck $nexts + $self !Next $s $sym $nexts + } else { + $self !Next $s $sym + } + } + + method nextset {states sym} { + $self SymbolCheck $sym + $self StateCheckSet $states + + set result {} + foreach s $states { + upvar #0 ${selfns}::trans_$order($s) jump + if {![info exists jump($sym)]} continue + struct::set add result $jump($sym) + } + return $result + } + + # --- --- --- --------- --------- --------- + + method is {cmd} { + switch -exact -- $cmd { + complete { + # The FA is complete if Trans(State, Sym) != {} for all + # states and symbols (Not counting epsilon transitions). + # Without symbols the FA is deemed complete. Note: + # States with epsilon transitions can use symbols + # indirectly! Need their closures for exact + # computation. + + set nsymbols [llength [array names symbol]] + if {$nsymbols == 0} {return 1} + foreach s [array names order] { + upvar #0 ${selfns}::trans_$order($s) jump + if {![info exists jump]} {return 0} + set njsym [array size jump] + if {[info exists jump()]} { + set njsym [llength [$self symbols@set [$self epsilon_closure $s]]] + incr njsym -1 + } + if {$njsym != $nsymbols} {return 0} + } + return 1 + } + deterministic { + # The FA is deterministic if it has on start state, no + # epsilon transitions, and the transition function is + # State x Symbol -> State, and not + # State x Symbol -> P(State). + + return [expr { + ([array size start] == 1) && + ![llength $nondete] && + ![array size nondets] + }] ;#{} + } + epsilon-free { + # FA is epsion-free if there are no states having epsilon transitions. + return [expr {![llength $nondete]}] + } + useful { + # The FA is useful if and only if we have states and + # all states are reachable and useful. + + set states [$self states] + return [expr { + [struct::set size $states] && + [struct::set equal $states [$self reachable_states]] && + [struct::set equal $states [$self useful_states]] + }] ;# {} + } + } + return -code error "Expected complete, deterministic, epsilon-free, or useful, got \"$cmd\"" + } + + # --- --- --- --------- --------- --------- + + method reachable_states {} { + if {$reachvalid} {return $reach} + if {![array size start]} { + set reach {} + } else { + # Basic algorithm like for epsilon_closure, except that we + # process all transitions, not only epsilons, and that + # the initial state is fixed to start. + + set reach [array names start] + set pending $reach + array set visited {} + while {[llength $pending]} { + set s [struct::list shift pending] + if {[info exists visited($s)]} continue + set visited($s) . + upvar #0 ${selfns}::trans_$order($s) jump + if {![info exists jump]} continue + if {![array size jump]} continue + foreach sym [array names jump] { + struct::set add reach $jump($sym) + struct::set add pending $jump($sym) + } + } + } + set reachvalid 1 + return $reach + } + + method unreachable_states {} { + # unreachable = states - reachables + return [struct::set difference \ + [$self states] [$self reachable_states]] + } + + method reachable {s} { + $self StateCheck $s + return [struct::set contains [$self reachable_states] $s] + } + + # --- --- --- --------- --------- --------- + + method useful_states {} { + if {$usefulvalid} {return $useful} + + # A state is useful if a final state + # can be reached from it. + + if {![array size final]} { + set useful {} + } else { + # Basic algorithm like for epsilon_closure, except that we + # process all transitions, not only epsilons, and that + # the initial set of states is fixed to final. + + set useful [array names final] + array set known [array get final] + set pending $useful + array set visited {} + while {[llength $pending]} { + set s [struct::list shift pending] + if {[info exists visited($s)]} continue + set visited($s) . + + # All predecessors are useful, and have to be visited as well. + # We get the predecessors from the transinv structure. + + if {![info exists transinv($s)]} continue + foreach before $transinv($s) { + set before [lindex $before 0] + if {[info exists visited($before)]} continue + lappend pending $before + if {[info exists known($before)]} continue + lappend useful $before + set known($before) . + } + } + } + set usefulvalid 1 + return $useful + } + + method unuseful_states {} { + # unuseful = states - useful + return [struct::set difference \ + [$self states] [$self useful_states]] + } + + method useful {s} { + $self StateCheck $s + return [struct::set contains [$self useful_states] $s] + } + + # --- --- --- --------- --------- --------- + + method epsilon_closure {s} { + # Iterative graph traversal. Keeps a set of states to look at, + # and adds to them everything it can reach from the current + # state via epsilon-transitions. Loops are handled through the + # visited array to weed out all the states already processed. + + $self StateCheck $s + + # Prefer cached information + if {[info exists ec($s)]} { + return $ec($s) + } + + set closure [list $s] + set pending [list $s] + array set visited {} + while {[llength $pending]} { + set t [struct::list shift pending] + if {[info exists visited($t)]} continue + set visited($t) . + upvar #0 ${selfns}::trans_$order($t) jump + if {![info exists jump()]} continue + struct::set add closure $jump() + struct::set add pending $jump() + } + set ec($s) $closure + return $closure + } + + # --- --- --- --------- --------- --------- + + method clear {} { + array unset order ; set nondete {} + array unset start ; set scount 0 + array unset final ; set reach {} + array unset symbol ; set reachvalid 0 + array unset transym ; set useful {} + array unset transinv ; set usefulvalid 0 + array unset nondets + array unset ec + + # Locate all 'trans_' arrays and remove them as well. + + foreach v [info vars ${selfns}::trans_*] { + unset $v + } + return + } + + # ### ### ### ######### ######### ######### + ## Instance Internals. + + method StateCheck {s} { + if {![info exists order($s)]} { + return -code error "Illegal state \"$s\"" + } + } + + method StateCheckSet {states} { + foreach s $states { + if {![info exists order($s)]} { + return -code error "Illegal state \"$s\"" + } + } + } + + method SymbolCheck {sym} { + if {$sym eq ""} return + if {![info exists symbol($sym)]} { + return -code error "Illegal symbol \"$sym\"" + } + } + + method SymbolCheckNE {sym} { + if {($sym eq "") || ![info exists symbol($sym)]} { + return -code error "Illegal symbol \"$sym\"" + } + } + + if 0 { + # Unused. Activate when needed. + method SymbolCheckSet {symbols} { + foreach sym $symbols { + if {$sym eq ""} continue + if {![info exists symbol($sym)]} { + return -code error "Illegal symbol \"$sym\"" + } + } + } + } + + method SymbolCheckSetNE {symbols} { + foreach sym $symbols { + if {($sym eq "") || ![info exists symbol($sym)]} { + return -code error "Illegal symbol \"$sym\"" + } + } + } + + method Next {s sym nexts} { + # Modify transition table. May update the set of + # non-deterministic states. Invalidates reachable + # cache, as states may become reachable. Updates + # the transym and transinv mappings. + + upvar #0 ${selfns}::trans_$order($s) jump + + $self InvalidateReach + $self InvalidateUseful + # Clear closure cache when epsilons change. + if {$sym eq ""} {array unset ec} + + if {[info exists transym($sym)]} { + struct::set include transym($sym) $s + } else { + set transym($sym) [list $s] + } + + if {[info exists transinv($nexts)]} { + struct::set include transinv($nexts) [list $s $sym] + } else { + set transinv($nexts) [list [list $s $sym]] + } + + if {![info exists jump($sym)]} { + set jump($sym) [list $nexts] + } else { + struct::set include jump($sym) $nexts + } + $self NonDeterministic $s $sym + return + } + + method !Next {s sym args} { + upvar #0 ${selfns}::trans_$order($s) jump + # Anything to do at all ? + if {![info exists jump($sym)]} return + $self InvalidateReach + $self InvalidateUseful + # Clear closure cache when epsilons change. + if {$sym eq ""} {array unset ec} + + if {![llength $args]} { + # Unset all transitions for (s, sym) + # Update transym and transinv mappings as well, if existing. + + $self !Transym $s $sym + foreach nexts $jump($sym) { + $self !Transinv $s $sym $nexts + } + + unset jump($sym) + } else { + # Remove the single transition (s, sym) -> nexts + set nexts [lindex $args 0] + + struct::set exclude jump($sym) $nexts + $self !Transinv $s $sym $nexts + + if {![struct::set size $jump($sym)]} { + $self !Transym $s $sym + unset jump($sym) + if {![array size jump]} { + unset jump + } + } + } + + $self NonDeterministic $s $sym + return + } + + method !Transym {s sym} { + struct::set exclude transym($sym) $s + if {![struct::set size $transym($sym)]} { + unset transym($sym) + } + } + + method !Transinv {s sym nexts} { + if {[info exists transinv($nexts)]} { + struct::set exclude transinv($nexts) [list $s $sym] + if {![struct::set size $transinv($nexts)]} { + unset transinv($nexts) + } + } + } + + method InvalidateReach {} { + set reachvalid 0 + set reach {} + return + } + + method InvalidateUseful {} { + set usefulvalid 0 + set useful {} + return + } + + method NonDeterministic {s sym} { + upvar #0 ${selfns}::trans_$order($s) jump + + # Epsilon rule, whole state check. Epslion present <=> Not a DFA. + + if {[info exists jump()]} { + struct::set include nondete $s + } else { + struct::set exclude nondete $s + } + + # Non-determinism over a symbol. + + upvar #0 ${selfns}::trans_$order($s) jump + + if {[info exists jump($sym)] && [struct::set size $jump($sym)] > 1} { + if {![info exists nondets($s)]} { + set nondets($s) [list $sym] + } else { + struct::set include nondets($s) $sym + } + return + } else { + if {![info exists nondets($s)]} return + struct::set exclude nondets($s) $sym + if {![struct::set size $nondets($s)]} { + unset nondets($s) + } + } + return + } + + method CheckSerialization {value startst states acc trans syms} { + # value is list/3 ('grammar::fa' symbols states) + # !("" in symbols) + # states is ordered dict (key is state, value is statedata) + # statedata is list/3 (start final trans|"") + # start is boolean + # final is boolean + # trans is dict (key in symbols, value is destinations) + # destinations is set of states + + upvar 1 $startst startstates \ + $states sts \ + $acc a \ + $trans t \ + $syms symbols + + set prefix "error in serialization:" + if {[llength $value] != 3} { + return -code error "$prefix list length not 3" + } + + struct::list assign $value stype symbols statedata + + if {$stype ne "grammar::fa"} { + return -code error "$prefix unknown type \"$stype\"" + } + if {[struct::set contains $symbols ""]} { + return -code error "$prefix empty symbol is not legal" + } + + if {[llength $statedata] % 2 == 1} { + return -code error "$prefix state data is not a dictionary" + } + array set _states $statedata + if {[llength $statedata] != (2*[array size _states])} { + return -code error "$prefix state data contains duplicate states" + } + set startstates {} + set sts {} + set p {} + set a {} + set e {} + set l {} + set m {} + set t {} + foreach {k v} $statedata { + lappend sts $k + if {[llength $v] != 3} { + return -code error "$prefix state list length not 3" + } + + struct::list assign $v begin accept trans + + if {![string is boolean -strict $begin]} { + return -code error "$prefix expected boolean for start, got \"$begin\"" + } + if {$begin} {lappend startstates $k} + if {![string is boolean -strict $accept]} { + return -code error "$prefix expected boolean for final, got \"$accept\"" + } + if {$accept} {lappend a $k} + + if {[llength $trans] % 2 == 1} { + return -code error "$prefix transition data is not a dictionary" + } + array set _trans $trans + if {[llength $trans] != (2*[array size _trans])} { + return -code error "$prefix transition data contains duplicate symbols" + } + unset _trans + + foreach {sym destinations} $trans { + # destinations = list of state + if {($sym ne "") && ![struct::set contains $symbols $sym]} { + return -code error "$prefix illegal symbol \"$sym\" in transition" + } + foreach dest $destinations { + if {![info exists _states($dest)]} { + return -code error "$prefix illegal destination state \"$dest\"" + } + lappend t $k $sym $dest + } + } + } + return + } + + # ### ### ### ######### ######### ######### + ## Type API implementation. + + # ### ### ### ######### ######### ######### + ## Type Internals. + + # ### ### ### ######### ######### ######### +} + +# ### ### ### ######### ######### ######### +## Initialization. Specify the container constructor command to use by +## the operations package. + +::grammar::fa::op::constructor ::grammar::fa + +# ### ### ### ######### ######### ######### +## Package Management + +package provide grammar::fa 0.5 diff --git a/tcllib/modules/grammar_fa/fa.test b/tcllib/modules/grammar_fa/fa.test new file mode 100644 index 0000000..b64a4a3 --- /dev/null +++ b/tcllib/modules/grammar_fa/fa.test @@ -0,0 +1,44 @@ +# -*- tcl -*- +# fa.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa.test,v 1.12 2009/10/27 21:17:23 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 1.0 +snitErrors + +support { + useAccel [useTcllibC] struct/sets.tcl struct::set + TestAccelInit struct::set + + use snit/snit.tcl snit ; # 1.1 always, even when Tcl 8.5 runs the testsuite. + use struct/list.tcl struct::list + + useLocalFile tests/Xsupport + useLocal faop.tcl grammar::fa::op +} +testing { + useLocalKeep fa.tcl grammar::fa +} + +# ------------------------------------------------------------------------- + +set class ::grammar::fa + +# ------------------------------------------------------------------------- + +TestAccelDo struct::set setimpl { + TestFiles tests/fa_*.test +} + +# ------------------------------------------------------------------------- +TestAccelExit struct::set +testsuiteCleanup diff --git a/tcllib/modules/grammar_fa/faop.man b/tcllib/modules/grammar_fa/faop.man new file mode 100644 index 0000000..f087391 --- /dev/null +++ b/tcllib/modules/grammar_fa/faop.man @@ -0,0 +1,480 @@ +[comment {-*- tcl -*- doctools manpage}] +[manpage_begin grammar::fa::op n 0.4] +[keywords automaton] +[keywords {finite automaton}] +[keywords grammar] +[keywords parsing] +[keywords {regular expression}] +[keywords {regular grammar}] +[keywords {regular languages}] +[keywords state] +[keywords transducer] +[copyright {2004-2008 Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[moddesc {Finite automaton operations and usage}] +[titledesc {Operations on finite automatons}] +[category {Grammars and finite automata}] +[require Tcl 8.4] +[require snit] +[require struct::list] +[require struct::set] +[require grammar::fa::op [opt 0.4.1]] +[description] +[para] + +This package provides a number of complex operations on finite +automatons (Short: FA), + +as provided by the package [package grammar::fa]. + +The package does not provide the ability to create and/or manipulate +such FAs, nor the ability to execute a FA for a stream of symbols. + +Use the packages [package grammar::fa] +and [package grammar::fa::interpreter] for that. + +Another package related to this is [package grammar::fa::compiler] +which turns a FA into an executor class which has the definition of +the FA hardwired into it. + +[para] + +For more information about what a finite automaton is see section +[emph {FINITE AUTOMATONS}] in package [package grammar::fa]. + +[section API] + +The package exports the API described here. All commands modify their +first argument. I.e. whatever FA they compute is stored back into +it. Some of the operations will construct an automaton whose states +are all new, but related to the states in the source +automaton(s). These operations take variable names as optional +arguments where they will store mappings which describe the +relationship(s). + +The operations can be loosely partitioned into structural and language +operations. The latter are defined in terms of the language the +automaton(s) accept, whereas the former are defined in terms of the +structural properties of the involved automaton(s). Some operations +are both. + +[emph {Structure operations}] + +[list_begin definitions] + +[call [cmd ::grammar::fa::op::constructor] [arg cmd]] + +This command has to be called by the user of the package before any other +operations is performed, to establish a command which can be used to +construct a FA container object. If this is not done several operations +will fail as they are unable to construct internal and transient containers +to hold state and/or partial results. + +[para] + +Any container class using this package for complex operations should set +its own class command as the constructor. See package [package grammar::fa] +for an example. + +[call [cmd ::grammar::fa::op::reverse] [arg fa]] + +Reverses the [arg fa]. This is done by reversing the direction of all +transitions and swapping the sets of [term start] and [term final] +states. The language of [arg fa] changes unpredictably. + +[call [cmd ::grammar::fa::op::complete] [arg fa] [opt [arg sink]]] + +Completes the [arg fa] [term complete], but nothing is done if the +[arg fa] is already [term complete]. This implies that only the first +in a series of multiple consecutive complete operations on [arg fa] +will perform anything. The remainder will be null operations. + +[para] + +The language of [arg fa] is unchanged by this operation. + +[para] + +This is done by adding a single new state, the [term sink], and +transitions from all other states to that sink for all symbols they +have no transitions for. The sink itself is made complete by adding +loop transitions for all symbols. + +[para] + +Note: When a FA has epsilon-transitions transitions over a symbol for +a state S can be indirect, i.e. not attached directly to S, but to a +state in the epsilon-closure of S. The symbols for such indirect +transitions count when computing completeness of a state. In other +words, these indirectly reached symbols are [emph not] missing. + +[para] + +The argument [arg sink] provides the name for the new state and most +not be present in the [arg fa] if specified. If the name is not +specified the command will name the state "sink[var n]", where [var n] +is set so that there are no collisions with existing states. + +[para] + +Note that the sink state is [term {not useful}] by definition. In +other words, while the FA becomes complete, it is also +[term {not useful}] in the strict sense as it has a state from which +no final state can be reached. + +[call [cmd ::grammar::fa::op::remove_eps] [arg fa]] + +Removes all epsilon-transitions from the [arg fa] in such a manner the +the language of [arg fa] is unchanged. However nothing is done if the +[arg fa] is already [term epsilon-free]. + +This implies that only the first in a series of multiple consecutive +complete operations on [arg fa] will perform anything. The remainder +will be null operations. + +[para] + +[emph Note:] This operation may cause states to become unreachable or +not useful. These states are not removed by this operation. + +Use [cmd ::grammar::fa::op::trim] for that instead. + +[call [cmd ::grammar::fa::op::trim] [arg fa] [opt [arg what]]] + +Removes unwanted baggage from [arg fa]. + +The legal values for [arg what] are listed below. The command defaults +to [const !reachable|!useful] if no specific argument was given. + +[list_begin definitions] +[def [const !reachable]] +Removes all states which are not reachable from a start state. + +[def [const !useful]] +Removes all states which are unable to reach a final state. + +[def [const !reachable&!useful]] +[def [const !(reachable|useful)]] +Removes all states which are not reachable from a start state and are +unable to reach a final state. + +[def [const !reachable|!useful]] +[def [const !(reachable&useful)]] +Removes all states which are not reachable from a start state or are +unable to reach a final state. + +[list_end] +[para] + +[call [cmd ::grammar::fa::op::determinize] [arg fa] [opt [arg mapvar]]] + +Makes the [arg fa] deterministic without changing the language +accepted by the [arg fa]. However nothing is done if the [arg fa] is +already [term deterministic]. This implies that only the first in a +series of multiple consecutive complete operations on [arg fa] will +perform anything. The remainder will be null operations. + +[para] + +The command will store a dictionary describing the relationship +between the new states of the resulting dfa and the states of the +input nfa in [arg mapvar], if it has been specified. Keys of the +dictionary are the handles for the states of the resulting dfa, values +are sets of states from the input nfa. + +[para] + +[emph Note]: An empty dictionary signals that the command was able to +make the [arg fa] deterministic without performing a full subset +construction, just by removing states and shuffling transitions around +(As part of making the FA epsilon-free). + +[para] + +[emph Note]: The algorithm fails to make the FA deterministic in the +technical sense if the FA has no start state(s), because determinism +requires the FA to have exactly one start states. + +In that situation we make a best effort; and the missing start state +will be the only condition preventing the generated result from being +[term deterministic]. + +It should also be noted that in this case the possibilities for +trimming states from the FA are also severely reduced as we cannot +declare states unreachable. + +[call [cmd ::grammar::fa::op::minimize] [arg fa] [opt [arg mapvar]]] + +Creates a FA which accepts the same language as [arg fa], but has a +minimal number of states. Uses Brzozowski's method to accomplish this. + +[para] + +The command will store a dictionary describing the relationship +between the new states of the resulting minimal fa and the states of +the input fa in [arg mapvar], if it has been specified. Keys of the +dictionary are the handles for the states of the resulting minimal fa, +values are sets of states from the input fa. + +[para] + +[emph Note]: An empty dictionary signals that the command was able to +minimize the [arg fa] without having to compute new states. This +should happen if and only if the input FA was already minimal. + +[para] + +[emph Note]: If the algorithm has no start or final states to work +with then the result might be technically minimal, but have a very +unexpected structure. + +It should also be noted that in this case the possibilities for +trimming states from the FA are also severely reduced as we cannot +declare states unreachable. + +[list_end] + +[emph {Language operations}] + +All operations in this section require that all input FAs have at +least one start and at least one final state. Otherwise the language of +the FAs will not be defined, making the operation senseless (as it +operates on the languages of the FAs in a defined manner). + +[list_begin definitions] + +[call [cmd ::grammar::fa::op::complement] [arg fa]] + +Complements [arg fa]. This is possible if and only if [arg fa] is +[term complete] and [term deterministic]. The resulting FA accepts the +complementary language of [arg fa]. In other words, all inputs not +accepted by the input are accepted by the result, and vice versa. + +[para] + +The result will have all states and transitions of the input, and +different final states. + +[call [cmd ::grammar::fa::op::kleene] [arg fa]] + +Applies Kleene's closure to [arg fa]. + +The resulting FA accepts all strings [var S] for which we can find a +natural number [var n] (0 inclusive) and strings [var A1] ... [var An] +in the language of [arg fa] such that [var S] is the concatenation of +[var A1] ... [var An]. + +In other words, the language of the result is the infinite union over +finite length concatenations over the language of [arg fa]. + +[para] + +The result will have all states and transitions of the input, and new +start and final states. + +[call [cmd ::grammar::fa::op::optional] [arg fa]] + +Makes the [arg fa] optional. In other words it computes the FA which +accepts the language of [arg fa] and the empty the word (epsilon) as +well. + +[para] + +The result will have all states and transitions of the input, and new +start and final states. + +[call [cmd ::grammar::fa::op::union] [arg fa] [arg fb] [opt [arg mapvar]]] + +Combines the FAs [arg fa] and [arg fb] such that the resulting FA +accepts the union of the languages of the two FAs. + +[para] + +The result will have all states and transitions of the two input FAs, +and new start and final states. All states of [arg fb] which exist in +[arg fa] as well will be renamed, and the [arg mapvar] will contain a +mapping from the old states of [arg fb] to the new ones, if present. + +[para] + +It should be noted that the result will be non-deterministic, even if +the inputs are deterministic. + +[call [cmd ::grammar::fa::op::intersect] [arg fa] [arg fb] [opt [arg mapvar]]] + +Combines the FAs [arg fa] and [arg fb] such that the resulting FA +accepts the intersection of the languages of the two FAs. In other +words, the result will accept a word if and only if the word is +accepted by both [arg fa] and [arg fb]. The result will be useful, but +not necessarily deterministic or minimal. + +[para] + +The command will store a dictionary describing the relationship +between the new states of the resulting fa and the pairs of states of +the input FAs in [arg mapvar], if it has been specified. Keys of the +dictionary are the handles for the states of the resulting fa, values +are pairs of states from the input FAs. Pairs are represented by +lists. The first element in each pair will be a state in [arg fa], the +second element will be drawn from [arg fb]. + +[call [cmd ::grammar::fa::op::difference] [arg fa] [arg fb] [opt [arg mapvar]]] + +Combines the FAs [arg fa] and [arg fb] such that the resulting FA +accepts the difference of the languages of the two FAs. In other +words, the result will accept a word if and only if the word is +accepted by [arg fa], but not by [arg fb]. This can also be expressed +as the intersection of [arg fa] with the complement of [arg fb]. The +result will be useful, but not necessarily deterministic or minimal. + +[para] + +The command will store a dictionary describing the relationship +between the new states of the resulting fa and the pairs of states of +the input FAs in [arg mapvar], if it has been specified. Keys of the +dictionary are the handles for the states of the resulting fa, values +are pairs of states from the input FAs. Pairs are represented by +lists. The first element in each pair will be a state in [arg fa], the +second element will be drawn from [arg fb]. + +[call [cmd ::grammar::fa::op::concatenate] [arg fa] [arg fb] [opt [arg mapvar]]] + +Combines the FAs [arg fa] and [arg fb] such that the resulting FA +accepts the cross-product of the languages of the two FAs. I.e. a word +W will be accepted by the result if there are two words A and B +accepted by [arg fa], and [arg fb] resp. and W is the concatenation of +A and B. + +[para] + +The result FA will be non-deterministic. + +[call [cmd ::grammar::fa::op::fromRegex] [arg fa] [arg regex] [opt [arg over]]] + +Generates a non-deterministic FA which accepts the same language as +the regular expression [arg regex]. If the [arg over] is specified it +is treated as the set of symbols the regular expression and the +automaton are defined over. The command will compute the set from the +"S" constructors in [arg regex] when [arg over] was not +specified. This set is important if and only if the complement +operator "!" is used in [arg regex] as the complementary language of +an FA is quite different for different sets of symbols. + +[para] + +The regular expression is represented by a nested list, which forms +a syntax tree. The following structures are legal: + +[list_begin definitions] + +[def "{S x}"] + +Atomic regular expression. Everything else is constructed from +these. Accepts the [const S]ymbol "x". + +[def "{. A1 A2 ...}"] + +Concatenation operator. Accepts the concatenation of the regular +expressions [var A1], [var A2], etc. + +[para] + +[emph Note] that this operator accepts zero or more arguments. With zero +arguments the represented language is [term epsilon], the empty word. + +[def "{| A1 A2 ...}"] + +Choice operator, also called "Alternative". Accepts all input accepted +by at least one of the regular expressions [var A1], [var A2], etc. In +other words, the union of [var A1], [var A2]. + +[para] + +[emph Note] that this operator accepts zero or more arguments. With zero +arguments the represented language is the [term empty] language, +the language without words. + +[def "{& A1 A2 ...}"] + +Intersection operator, logical and. Accepts all input accepted which +is accepted by all of the regular expressions [var A1], [var A2], +etc. In other words, the intersection of [var A1], [var A2]. + +[def "{? A}"] + +Optionality operator. Accepts the empty word and anything from the +regular expression [var A]. + +[def "{* A}"] + +Kleene closure. Accepts the empty word and any finite concatenation of +words accepted by the regular expression [var A]. + +[def "{+ A}"] + +Positive Kleene closure. Accepts any finite concatenation of words +accepted by the regular expression [var A], but not the empty word. + +[def "{! A}"] + +Complement operator. Accepts any word not accepted by the regular +expression [var A]. Note that the complement depends on the set of +symbol the result should run over. See the discussion of the argument +[arg over] before. + +[list_end] + +[call [cmd ::grammar::fa::op::toRegexp] [arg fa]] + +This command generates and returns a regular expression which accepts +the same language as the finite automaton [arg fa]. The regular +expression is in the format as described above, for +[cmd ::grammar::fa::op::fromRegex]. + +[call [cmd ::grammar::fa::op::toRegexp2] [arg fa]] + +This command has the same functionality as [cmd ::grammar::fa::op::toRegexp], +but uses a different algorithm to simplify the generated regular expressions. + +[call [cmd ::grammar::fa::op::toTclRegexp] [arg regexp] [arg symdict]] + +This command generates and returns a regular expression in Tcl syntax for the +regular expression [arg regexp], if that is possible. [arg regexp] is in the +same format as expected by [cmd ::grammar::fa::op::fromRegex]. + +[para] + +The command will fail and throw an error if [arg regexp] contains +complementation and intersection operations. + +[para] + +The argument [arg symdict] is a dictionary mapping symbol names to +pairs of [term {syntactic type}] and Tcl-regexp. If a symbol +occurring in the [arg regexp] is not listed in this dictionary then +single-character symbols are considered to designate themselves +whereas multiple-character symbols are considered to be a character +class name. + +[call [cmd ::grammar::fa::op::simplifyRegexp] [arg regexp]] + +This command simplifies a regular expression by applying the following +algorithm first to the main expression and then recursively to all +sub-expressions: + +[list_begin enum] +[enum] Convert the expression into a finite automaton. +[enum] Minimize the automaton. +[enum] Convert the automaton back to a regular expression. +[enum] Choose the shorter of original expression and expression from +the previous step. +[list_end] + +[list_end] + +[para] + +[section EXAMPLES] + +[vset CATEGORY grammar_fa] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/grammar_fa/faop.tcl b/tcllib/modules/grammar_fa/faop.tcl new file mode 100644 index 0000000..5c0804e --- /dev/null +++ b/tcllib/modules/grammar_fa/faop.tcl @@ -0,0 +1,1618 @@ +# -*- tcl -*- +# Grammar / FA / Operations + +# ### ### ### ######### ######### ######### +## Package description + +# ### ### ### ######### ######### ######### +## Requisites + +package require struct::list ; # Extended list operations. +package require struct::set ; # Extended set operations. + +# ### ### ### ######### ######### ######### +## Implementation + +namespace eval ::grammar::fa::op { + + # ### ### ### ######### ######### ######### + ## API. Structure / Language / Compilation + + proc reverse {fa} {} + proc complete {fa {sink {}}} {} + proc remove_eps {fa} {} + proc trim {fa {what !reachable|!useful}} {} + proc determinize {fa {mapvar {}} {idstart 0}} {} + proc minimize {fa {mapvar {}}} {} + + proc complement {fa} {} + proc kleene {fa} {} + proc optional {fa} {} + proc union {fa fb {mapvar {}}} {} + proc intersect {fa fb {mapvar {}} {idstart 0}} {} + proc difference {fa fb {mapvar {}}} {} + proc concatenate {fa fb {mapvar {}}} {} + + proc fromRegex {fa regex {over {}}} {} + + proc toRegexp {fa} {} + proc toRegexp2 {fa} {} + + proc simplifyRegexp {rex} {} + proc toTclRegexp {rex symdict} {} + + # ### ### ### ######### ######### ######### + + namespace export reverse complete remove_eps trim \ + determinize minimize complement kleene \ + optional union intersect difference \ + concatenate fromRegex toRegexp toRegexp2 \ + simplifyRegexp toTclRegexp + + # ### ### ### ######### ######### ######### + ## Internal data structures. + + variable cons {} + + # ### ### ### ######### ######### ######### +} + +# ### ### ### ######### ######### ######### +## API implementation. Structure + +proc ::grammar::fa::op::reverse {fa} { + # Reversal means that all transitions change their direction + # and start and final states are swapped. + + # Note that reversed FA might not be deterministic, even if the FA + # itself was. + + # One loop is not enough for this. If we reverse the + # transitions for a state immediately we may modify a state + # which has not been processed yet. And when we come to this + # state we reverse already reversed transitions, creating a + # complete mess. Thus two loops, one to collect the current + # transitions (and also remove them), and a second to insert + # the reversed transitions. + + set tmp [$fa finalstates] + $fa final set [$fa startstates] + $fa start set $tmp + + # FUTURE : Method to retrieve all transitions + # FUTURE : Method to delete all transitions + + set trans {} + foreach s [$fa states] { + foreach sym [$fa symbols@ $s] { + lappend trans $s $sym [$fa next $s $sym] + $fa !next $s $sym + } + } + foreach {s sym destinations} $trans { + foreach d $destinations { + $fa next $d $sym --> $s + } + } + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::complete {fa {sink {}}} { + if {[$fa is complete]} return + + # We have an incomplete FA. + + if {$sink eq ""} { + set sink [FindNewState $fa sink] + } elseif {[$fa state exists $sink]} { + return -code error "The chosen sink state exists already" + } + $fa state add $sink + + # Add transitions to it from all states which are not + # complete. The sink state itself loops on all inputs. IOW it is a + # non-useful state. + + set symbols [$fa symbols] + foreach sym $symbols { + $fa next $sink $sym --> $sink + } + + if {[$fa is epsilon-free]} { + foreach s [$fa states] { + foreach missing [struct::set difference \ + $symbols \ + [$fa symbols@ $s]] { + $fa next $s $missing --> $sink + } + } + } else { + # For an FA with epsilon-transitions we cannot simply look at + # the direct transitions to find the used symbols. We have to + # determine this for the epsilon-closure of the state in + # question. Oh, and we have to defer actually adding the + # transitions after we have picked them all, or otherwise the + # newly added transitions throw the symbol calculations for + # epsilon closures off. + + set new {} + foreach s [$fa states] { + foreach missing [struct::set difference \ + $symbols \ + [$fa symbols@set [$fa epsilon_closure $s]]] { + lappend new $s $missing + } + } + + foreach {s missing} $new { + $fa next $s $missing --> $sink + } + } + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::remove_eps {fa} { + # We eliminate all epsilon transitions by duplicating a number + # of regular transitions, which we get through the epsilon + # closure of the states having epsilon transitions. We do + # nothing if the FA is epsilon free to begin with. + + if {[$fa is epsilon-free]} return + + # Note: Epsilon transitions touching start and final states + # propagate the start markers forward and final markers + # backward. We do this first by propagating start markers twice, + # once with a reversed FA. This also gives us some + # epsilon-closures as well. + + foreach n {1 2} { + foreach s [$fa startstates] { + foreach e [$fa epsilon_closure $s] { + $fa start add $e + } + } + reverse $fa + } + + # Now duplicate all transitions which are followed or preceeded by + # epsilon transitions of any number greater than zero. + + # Note: The closure computations done by the FA are cached in the + # FA, so doing it multiple times is no big penalty. + + # FUTURE : Retrieve all transitions on one command. + + # FUTURE : Different algorithm ... + # Retrieve non-eps transitions for all states ... + # Iterate this list. Compute e-closures for endpoints, cache + # them. Duplicate the transition if needed, in that case add it to + # the end of the list, for possible more duplication (may touch + # different e-closures). Stop when the list is empty again. + + set changed 1 + while {$changed} { + set changed 0 + foreach s [$fa states] { + foreach sym [$fa symbols@ $s] { + set dest [$fa next $s $sym] + if {$sym eq ""} { + # Epsilon transitions. + + # Get the closure, and duplicate all transitions for all + # non-empty symbols as transitions of the original state. + # This may lead to parallel transitions between states, hence + # the catch. It prevents the generated error from stopping the + # action, and no actual parallel transitions are created. + + set clos [$fa epsilon_closure $s] + foreach csym [$fa symbols@set $clos] { + if {$csym eq ""} continue + foreach d [$fa nextset $clos $csym] { + if {![catch {$fa next $s $csym --> $d} msg]} { + set changed 1 + } + } + } + } else { + # Regular transition. Go through all destination + # states, compute their closures and replicate the + # transition if the closure contains more than the + # destination itself, to all states in the closure. + + foreach d $dest { + set clos [$fa epsilon_closure $d] + if {[llength $clos] > 1} { + foreach e $clos { + if {![catch {$fa next $s $sym --> $e}]} { + set changed 1 + } + } + } + } + } + } + } + } + + # At last, drop the epsilons for all states. Only now is this + # possible because otherwise we might compute bad epsilon + # closures in the previous loop. + + foreach s [$fa states] { + $fa !next $s "" + } + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::trim {fa {what !reachable|!useful}} { + # Remove various unwanted pices from the FA. + + switch -exact -- $what { + !reachable { + set remove [$fa unreachable_states] + } + !useful { + set remove [$fa unuseful_states] + } + !reachable&!useful - + !(reachable|useful) { + set remove [struct::set intersect [$fa unreachable_states] [$fa unuseful_states]] + } + !reachable|!useful - + !(reachable&useful) { + set remove [struct::set union [$fa unreachable_states] [$fa unuseful_states]] + } + default { + return -code error "Expected !reachable, !useful, !reachable&!useful, !(reachable|useful), !reachable|!useful, or !(reachable&useful), got \"$what\"" + } + } + + foreach s $remove { + $fa state delete $s + } + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::determinize {fa {mapvar {}} {idstart 0}} { + # We do the operation in several stages instead of jumping + # directly in the subset construction. Basically we try the less + # expensive operations first to see if they are enough. It does + # help that they will us also bring nearer to the ultimate goal + # even if they are not enough. + + set hasmap 0 + if {$mapvar ne ""} { + upvar 1 $mapvar map ; set hasmap 1 + } + + # First, is the input already deterministic ? + # There is nothing to do in that case. + + if {[$fa is deterministic]} { + if {$hasmap} {set map {}} + return + } + + # Second, trim unreachable and unuseables. We are done if only + # they carried the non-determinism. Otherwise we might have made + # the FA smaller and was less time consuming to convert. + + if {[llength [$fa startstates]]} {trim $fa !reachable} + if {[llength [$fa finalstates]]} {trim $fa !useful} + if {[$fa is deterministic]} { + if {$hasmap} {set map {}} + return + } + + # Third, remove any epsilon transitions, and stop if that was + # enough. Of course, weed out again states which have become + # irrelevant. The removal of the epsilons will at least ensure + # that the subset construction won't have to deal with + # closures. I.e. simpler. + + remove_eps $fa + if {[llength [$fa startstates]]} {trim $fa !reachable} + if {[llength [$fa finalstates]]} {trim $fa !useful} + if {[$fa is deterministic]} { + if {$hasmap} {set map {}} + return + } + + # Fourth. There is no way to avoid the subset construction. + # Dive in. This is the only part of the algorithm which requires + # us to keep a map. We construct the dfa in a transient container + # and copy the result back to fa when completed. + + array set subsets {} + set id $idstart + set pending {} + set dfa [[cons] %AUTO%] + # FUTURE : $dfa symbol set [$fa symbols] + foreach sym [$fa symbols] {$dfa symbol add $sym} + + # If we have start states we can initialize the algorithm with + # their set. Otherwise we have to the single-element sets of all + # states as the beginning. + + set starts [$fa startstates] + if {[llength $starts] > 0} { + # Make the set of start states the initial stae of the result. + + set starts [lsort $starts] ; # Sort to get canonical form. + $dfa state add $id + $dfa start add $id + + # The start may also be a final state + if {[$fa final?set $starts]} { + $dfa final add $id + } + + set subsets(dfa,$starts) $id + set subsets(nfa,$id) $starts + + lappend pending $id + incr id + } else { + # Convert all states of the input into sets (of one element) + # in the output. Do not forget to mark all final states we + # come by. No start states, otherwise we wouldn't be here. + + foreach s [$fa states] { + set nfaset [list $s] + + $dfa state add $id + if {[$fa final? $s]} { + $dfa final add $id + } + + set subsets(dfa,$nfaset) $id + set subsets(nfa,$id) $nfaset + lappend pending $id + incr id + } + } + + while {[llength $pending]} { + set dfastate [struct::list shift pending] + + # We have to compute the transition function for this dfa state. + + set nfaset $subsets(nfa,$dfastate) + + foreach sym [$fa symbols@set $nfaset] { + set nfanext [lsort [$fa nextset $nfaset $sym]] + + if {![info exists subsets(dfa,$nfanext)]} { + # Unknown destination. Add it as a new state. + + $dfa state add $id + if {[$fa final?set $nfanext]} { + $dfa final add $id + } + + set subsets(dfa,$nfanext) $id + set subsets(nfa,$id) $nfanext + + # Schedule the calculation of the transition function + # of the new state. + + lappend pending $id + incr id + } + + # Add the transition + $dfa next $dfastate $sym --> $subsets(dfa,$nfanext) + } + } + + if {[llength [$fa startstates]]} {trim $fa !reachable} + if {[llength [$fa finalstates]]} {trim $fa !useful} + + if {$hasmap} { + # The map is from new dfa states to the sets of nfa states. + + set map {} + foreach s [$dfa states] { + lappend map $s $subsets(nfa,$s) + } + } + + $fa = $dfa + $dfa destroy + + # ASSERT : $fa is deterministic + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::minimize {fa {mapvar {}}} { + # Brzozowski's method: + # Reverse, determinize, reverse again, determinize again. + + reverse $fa + determinize $fa mapa + reverse $fa + determinize $fa mapb + + if {$mapvar ne ""} { + upvar 1 $mapvar map + + if {![llength $mapa] && ![llength $mapb]} { + # No state reorganizations, signal up + set map {} + } elseif {[llength $mapa] && ![llength $mapb]} { + # Only one reorg, this is the combined reorg as well. + set map $mapa + } elseif {![llength $mapa] && [llength $mapb]} { + # Only one reorg, this is the combined reorg as well. + set map $mapb + } else { + # Two reorgs. Compose the maps into the final map signaled + # up. + + # mapb : final state -> set of states in mapa -> sets of original states. + + set map {} + array set tmp $mapa + foreach {b aset} $mapb { + set compose {} + foreach a $aset {foreach o $tmp($a) {lappend compose $o}} + lappend map $b [lsort -uniq $compose] + } + } + } + + # The FA is implicitly trimmed by the determinize's. + return +} + +# ### ### ### ######### ######### ######### +## API implementation. Language. + +proc ::grammar::fa::op::complement {fa} { + # Complementing is possible if and only if the FA is complete, + # and accomplished by swapping the final and non-final states. + + if {![$fa is complete]} { + return -code error "Unable to complement incomplete FA" + } + if {![$fa is deterministic]} { + return -code error "Unable to complement non-deterministic FA" + } + + set newfinal [struct::set difference [$fa states] [$fa finalstates]] + $fa final set $newfinal + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::kleene {fa} { + # The Kleene Closure of the FA makes no sense if we don't have + # start and final states we can work from. + + set start [$fa startstates] + set final [$fa finalstates] + + if {![llength $start] || ![llength $final]} { + return -code error "Unable to add Kleene's closure to a FA without start/final states" + } + + # FUTURE :: If final states have no outgoing transitions, and start + # FUTURE :: states have no input transitions, then place the new + # FUTURE :: transitions directly between start and final + # FUTURE :: states. In that case we don't need new states. + + # We need new start/final states, like for optional (see below) + + set ns [NewState $fa s] + set nf [NewState $fa f] + + foreach s $start {$fa next $ns "" --> $s} + foreach f $final {$fa next $f "" --> $nf} + + $fa start clear ; $fa start add $ns + $fa final clear ; $fa final add $nf + + $fa next $ns "" --> $nf ; # Optionality + $fa next $nf "" --> $ns ; # Loop for closure + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::optional {fa} { + # The Optionality of the FA makes no sense if we don't have + # start and final states we can work from. + + set start [$fa startstates] + set final [$fa finalstates] + + if {![llength $start] || ![llength $final]} { + return -code error "Unable to make a FA without start/final states optional" + } + + # We have to introduce new start and final states to ensure + # that we do not get additional recognized words from the FA + # due to epsilon transitions. IOW just placing epsilons from + # all start to all final states is wrong. Consider unreachable + # final states, they become reachable. Or final states able to + # reach final states from. Again the epsilons would extend the + # language. We have to detach our optional epsilon from anything + # in the existing start/final states. Hence the new start/final. + + # FUTURE : Recognize if there are no problems with placing direct + # FUTURE : epsilons from start to final. + + set ns [NewState $fa s] + set nf [NewState $fa f] + + foreach s $start {$fa next $ns "" --> $s} + foreach f $final {$fa next $f "" --> $nf} + + $fa start clear ; $fa start add $ns + $fa final clear ; $fa final add $nf + + $fa next $ns "" --> $nf ; # This is the transition which creates the optionality. + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::union {fa fb {mapvar {}}} { + # We union the input symbols, then add the states and + # transitions of the second FA to the first, adding in + # epsilons for the start and final states as well. When + # adding states we make sure that the new states do not + # intersect with the existing states. + + struct::list assign \ + [MergePrepare $fa $fb union smap] \ + astart afinal bstart bfinal + + if {$mapvar ne ""} { + upvar 1 $mapvar map + set map $smap + } + + # And now the new start & final states + + set ns [NewState $fa s] + set nf [NewState $fa f] + + eLink1N $fa $ns $astart + eLink1N $fa $ns $bstart + + eLinkN1 $fa $afinal $nf + eLinkN1 $fa $bfinal $nf + + $fa start clear ; $fa start add $ns + $fa final clear ; $fa final add $nf + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::intersect {fa fb {mapvar {}} {idstart 0}} { + # Intersection has to run the two automata in parallel, using + # paired states. If we have start states we begin the + # construction with them. This leads to a smaller result as we + # do not have create a full cross-crossproduct. The latter is + # unfortunately required if there are no start states. + + struct::list assign [CrossPrepare $fa $fb intersection] tmp res + + # The start states of the new FA consist of the cross-product of + # the start states of fa with fb. These are also the states used + # to seed DoCross. + + set id $idstart + set smap {} + set bstart [$tmp startstates] + foreach a [$fa startstates] { + foreach b $bstart { + set pair [list $a $b] + lappend smap $id $pair + lappend pending $pair $id + $res state add $id + $res start add $id + incr id + } + } + + set cp [DoCross $fa $tmp $res $id $pending smap] + + foreach {id pair} $smap { + struct::list assign $pair a b + if {[$fa final? $a] && [$tmp final? $b]} { + $res final add $id + } + } + + # Remove excess states (generated because of the sinks). + trim $res + if {$mapvar ne ""} { + upvar 1 $mapvar map + # The loop is required to filter out the mappings for all + # states which were trimmed off. + set map {} + foreach {id pair} $smap { + if {![$res state exists $id]} continue + lappend map $id $pair + } + } + + # Copy result into permanent storage and delete all intermediaries + $fa = $res + $res destroy + if {$tmp ne $fb} {$tmp destroy} + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::difference {fa fb {mapvar {}}} { + # Difference has to run the two automata in parallel, using + # paired states. Only the final states are defined differently + # than for intersection. It has to be final in fa and _not_ final + # in fb to be a final state of the result. <=> Accepted by A, but + # not B, to be in the difference. + + struct::list assign [CrossPrepare $fa $fb difference] tmp res + + # The start states of the new FA consist of the cross-product of + # the start states of fa with fb. These are also the states used + # to seed DoCross. + + set id 0 + set smap {} + set bstart [$tmp startstates] + foreach a [$fa startstates] { + foreach b $bstart { + set pair [list $a $b] + lappend smap $id $pair + lappend pending $pair $id + $res state add $id + $res start add $id + incr id + } + } + + set cp [DoCross $fa $tmp $res $id $pending smap] + + foreach {id pair} $smap { + struct::list assign $pair a b + if {[$fa final? $a] && ![$tmp final? $b]} { + $res final add $id + } + } + + # Remove excess states (generated because of the sinks). + trim $res + if {$mapvar ne ""} { + upvar 1 $mapvar map + # The loop is required to filter out the mappings for all + # states which were trimmed off. + set map {} + foreach {id pair} $smap { + if {![$res state exists $id]} continue + lappend map $id $pair + } + } + + # Copy result into permanent storage and delete all intermediaries + $fa = $res + $res destroy + if {$tmp ne $fb} {$tmp destroy} + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::concatenate {fa fb {mapvar {}}} { + # Like union, only the interconnect between existing and new FA is different. + + struct::list assign \ + [MergePrepare $fa $fb concatenate smap] \ + astart afinal bstart bfinal + + if {$mapvar ne ""} { + upvar 1 $mapvar map + set map $smap + } + + set ns [NewState $fa s] + set nm [NewState $fa m] ;# Midpoint. + set nf [NewState $fa f] + + eLink1N $fa $ns $astart + eLinkN1 $fa $afinal $nm + + eLink1N $fa $nm $bstart + eLinkN1 $fa $bfinal $nf + + $fa start clear ; $fa start add $ns + $fa final clear ; $fa final add $nf + return +} + +# ### ### ### ######### ######### ######### +## API implementation. Compilation (regexp -> FA). + +proc ::grammar::fa::op::fromRegex {fa regex {over {}}} { + # Convert a regular expression into a FA. The regex is given as + # parse tree in the form of a nested list. + + # {. A B ...} ... Concatenation (accepts zero|one arguments). + # {| A B ...} ... Alternatives (accepts zero|one arguments). + # {? A} ... Optional. + # {* A} ... Kleene. + # {+ A} ... Pos.Kleene. + # {! A} ... Complement/Negation. + # {S Symbol} ... Atom, Symbol + # + # Recursive descent with a helper ... + + if {![llength $regex]} { + $fa clear + return + } + + set tmp [[cons] %AUTO%] + + if {![llength $over]} { + set over [lsort -uniq [RESymbols $regex]] + } + foreach sym $over { + $tmp symbol add $sym + } + + set id 0 + struct::list assign [Regex $tmp $regex id] s f + $tmp start set [list $s] + $tmp final set [list $f] + + $fa = $tmp + $tmp destroy + return +} + +# ### ### ### ######### ######### ######### +## Internal helpers. + +proc ::grammar::fa::op::RESymbols {regex} { + set cmd [lindex $regex 0] + switch -exact -- $cmd { + ? - * - ! - + { + return [RESymbols [lindex $regex 1]] + } + . - | - & { + set res {} + foreach sub [lrange $regex 1 end] { + foreach sym [RESymbols $sub] {lappend res $sym} + } + return $res + } + S { + return [list [lindex $regex 1]] + } + default { + return -code error "Expected . ! ? * | &, or S, got \"$cmd\"" + } + } +} + +proc ::grammar::fa::op::Regex {fa regex idvar} { + upvar 1 $idvar id + set cmd [lindex $regex 0] + switch -exact -- $cmd { + ? { + # Optional + set a $id ; incr id ; $fa state add $a + set b $id ; incr id ; $fa state add $b + + struct::list assign [Regex $fa [lindex $regex 1] id] s f + $fa next $a "" --> $s + $fa next $f "" --> $b + $fa next $a "" --> $b + } + * { + # Kleene + set a $id ; incr id ; $fa state add $a + set b $a + + struct::list assign [Regex $fa [lindex $regex 1] id] s f + $fa next $a "" --> $s + $fa next $f "" --> $a ;# == b + } + + { + # Pos. Kleene + set a $id ; incr id ; $fa state add $a + set b $id ; incr id ; $fa state add $b + + struct::list assign [Regex $fa [lindex $regex 1] id] s f + $fa next $a "" --> $s + $fa next $f "" --> $b + $fa next $b "" --> $a + } + ! { + # Complement. + # Build up in a temp FA, complement, and + # merge nack into the current + + set a $id ; incr id ; $fa state add $a + set b $id ; incr id ; $fa state add $b + + set tmp [[cons] %AUTO%] + foreach sym [$fa symbols] {$tmp symbol add $sym} + struct::list assign [Regex $tmp [lindex $regex 1] id] s f + $tmp start add $s + $tmp final add $f + + determinize $tmp {} $id + incr id [llength [$tmp states]] + if {![$tmp is complete]} { + complete $tmp $id + incr id + } + complement $tmp + + # Merge and link. + $fa deserialize_merge [$tmp serialize] + + eLink1N $fa $a [$tmp startstates] + eLinkN1 $fa [$tmp finalstates] $b + $tmp destroy + } + & { + # Intersection ... /And + + if {[llength $regex] < 3} { + # Optimized path. Intersection of one sub-expression + # is the sub-expression itself. + + struct::list assign [Regex $fa [lindex $regex 1] id] a b + } else { + set a $id ; incr id ; $fa state add $a + set b $id ; incr id ; $fa state add $b + + set tmp [[cons] %AUTO%] + foreach sym [$fa symbols] {$tmp symbol add $sym} + set idsub 0 + struct::list assign [Regex $tmp [lindex $regex 1] idsub] s f + $tmp start add $s + $tmp final add $f + + set beta [[cons] %AUTO%] + foreach sub [lrange $regex 2 end] { + foreach sym [$fa symbols] {$beta symbol add $sym} + struct::list assign [Regex $beta $sub idsub] s f + $beta start add $s + $beta final add $f + intersect $tmp $beta {} $id + } + $beta destroy + determinize $tmp {} $id + incr id [llength [$tmp states]] + + # Merge and link. + $fa deserialize_merge [$tmp serialize] + + eLink1N $fa $a [$tmp startstates] + eLinkN1 $fa [$tmp finalstates] $b + $tmp destroy + } + } + . { + # Concatenation ... + + if {[llength $regex] == 1} { + # Optimized path. No sub-expressions. This represents + # language containing only the empty string, aka + # epsilon. + + set a $id ; incr id ; $fa state add $a + set b $id ; incr id ; $fa state add $b + $fa next $a "" --> $b + + } elseif {[llength $regex] == 2} { + # Optimized path. Concatenation of one sub-expression + # is the sub-expression itself. + + struct::list assign [Regex $fa [lindex $regex 1] id] a b + } else { + set first 1 + set last {} + foreach sub [lrange $regex 1 end] { + struct::list assign [Regex $fa $sub id] s f + if {$first} {set first 0 ; set a $s} + if {$last != {}} { + $fa next $last "" --> $s + } + set last $f + } + set b $f + } + } + | { + # Alternatives ... (Union) + + if {[llength $regex] == 1} { + # Optimized path. No sub-expressions. This represents + # the empty language, i.e. the language without words. + + set a $id ; incr id ; $fa state add $a + set b $id ; incr id ; $fa state add $b + + } elseif {[llength $regex] == 2} { + # Optimized path. Choice/Union of one sub-expression + # is the sub-expression itself. + + struct::list assign [Regex $fa [lindex $regex 1] id] a b + } else { + set a $id ; incr id ; $fa state add $a + set b $id ; incr id ; $fa state add $b + foreach sub [lrange $regex 1 end] { + struct::list assign [Regex $fa $sub id] s f + $fa next $a "" --> $s + $fa next $f "" --> $b + } + } + } + S { + # Atom, base transition. + set sym [lindex $regex 1] + set a $id ; incr id ; $fa state add $a + set b $id ; incr id ; $fa state add $b + $fa next $a $sym --> $b + } + default { + return -code error "Expected . ! ? * | &, or S, got \"$cmd\"" + } + } + return [list $a $b] +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::CrossPrepare {fa fb label} { + set starta [$fa startstates] + set finala [$fa finalstates] + set startb [$fb startstates] + set finalb [$fb finalstates] + if { + ![llength $starta] || ![llength $finala] || + ![llength $startb] || ![llength $finalb] + } { + return -code error "Unable to perform the $label of two FAs without start/final states" + } + + # The inputs are made complete over the union of their symbol + # sets. A temp. container is used for the second input if necessary. + + set totals [struct::set union [$fa symbols] [$fb symbols]] + foreach sym [struct::set difference $totals [$fa symbols]] { + $fa symbol add $sym + } + if {![$fa is epsilon-free]} { + remove_eps $fa + trim $fa + } + if {![$fa is complete]} { + complete $fa + } + set tmp $fb + set bnew [struct::set difference $totals [$fb symbols]] + if {[llength $bnew]} { + set tmp [[cons] %AUTO% = $fb] + foreach sym $bnew { + $tmp symbol add $sym + } + } + if {![$fb is epsilon-free]} { + if {$tmp eq $fb} {set tmp [[cons] %AUTO% = $fb]} + remove_eps $tmp + trim $tmp + } + if {![$fb is complete]} { + if {$tmp eq $fb} {set tmp [[cons] %AUTO% = $fb]} + complete $tmp + } + + set res [[cons] %AUTO%] + foreach sym $totals { + $res symbol add $sym + } + + return [list $tmp $res] +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::DoCross {fa fb res id seed smapvar} { + upvar 1 $smapvar smap + + set symbols [$fa symbols] + array set tmp $seed + + set pending $seed + while {[llength $pending]} { + set cpair [struct::list shift pending] + set cid [struct::list shift pending] + + struct::list assign $cpair a b + + # ASSERT: /res state exists /cid + + # Generate the transitions for the pair, add the resulting + # destinations to the FA, and schedule them for a visit if + # they are new. + + foreach sym $symbols { + set adestinations [$fa next $a $sym] + set bdestinations [$fb next $b $sym] + + foreach ad $adestinations { + foreach bd $bdestinations { + set dest [list $ad $bd] + + if {![info exists tmp($dest)]} { + $res state add $id + lappend smap $id $dest + lappend pending $dest $id + set tmp($dest) $id + incr id + } + $res next $cid $sym --> $tmp($dest) + } + } + } + } + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::MergePrepare {fa fb label mapvar} { + upvar 1 $mapvar map + + set starta [$fa startstates] + set finala [$fa finalstates] + set startb [$fb startstates] + set finalb [$fb finalstates] + if { + ![llength $starta] || ![llength $finala] || + ![llength $startb] || ![llength $finalb] + } { + return -code error "Unable to $label FAs without start/final states" + } + + # FUTURE: add {*}[symbols], ignore dup's + foreach sym [$fb symbols] {catch {$fa symbol add $sym}} + + set dup [struct::set intersect [$fa states] [$fb states]] + if {![llength $dup]} { + # The states do not overlap. A plain merge of fb is enough to + # copy the information. + + $fa deserialize_merge [$fb serialize] + set map {} + } else { + # We have duplicate states, therefore we have to remap fb to + # prevent interference between the two. + + set map {} + set tmp [[cons] %AUTO% = $fb] + set id 0 + foreach s $dup { + # The renaming process has to ensure that the new name is + # in neither fa, nor already in fb as well. + while { + [$fa state exists $id] || + [$tmp state exists $id] + } {incr id} + $tmp state rename $s $id + lappend map $id $s + incr id + } + + set startb [$tmp startstates] + set finalb [$tmp finalstates] + + $fa deserialize_merge [$tmp serialize] + $tmp destroy + } + + return [list $starta $finala $startb $finalb] +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::eLink1N {fa from states} { + foreach s $states { + $fa next $from "" --> $s + } + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::eLinkN1 {fa states to} { + foreach s $states { + $fa next $s "" --> $to + } + return +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::NewState {fa prefix} { + set newstate [FindNewState $fa $prefix] + $fa state add $newstate + return $newstate +} + +# --- --- --- --------- --------- --------- + +proc ::grammar::fa::op::FindNewState {fa prefix} { + #if {![$fa state exists $prefix]} {return $prefix} + set n 0 + while {[$fa state exists ${prefix}.$n]} {incr n} + return ${prefix}.$n +} + +# ### ### ### ######### ######### ######### +## API implementation. Decompilation (FA -> regexp). + +proc ::grammar::fa::op::toRegexp {fa} { + # NOTE: FUTURE - Do not go through the serialization, nor through + # a matrix. The algorithm can be expressed more directly as + # operations on the automaton (states and transitions). + + set ET [ser_to_ematrix [$fa serialize]] + while {[llength $ET] > 2} { + set ET [matrix_drop_state $ET] + } + return [lindex $ET 0 1] +} + +proc ::grammar::fa::op::toRegexp2 {fa} { + # NOTE: FUTURE - See above. + set ET [ser_to_ematrix [$fa serialize]] + while {[llength $ET] > 2} { + set ET [matrix_drop_state $ET re2] + } + return [lindex $ET 0 1] +} + +# ### ### ### ######### ######### ######### +## Internal helpers. + +proc ::grammar::fa::op::ser_to_ematrix {ser} { + if {[lindex $ser 0] ne "grammar::fa"} then { + error "Expected grammar::fa automaton serialisation" + } + set stateL {} + set n 2; foreach {state des} [lindex $ser 2] { + lappend stateL $state + set N($state) $n + incr n + } + set row0 {} + for {set k 0} {$k<$n} {incr k} {lappend row0 [list |]} + set res [list $row0 $row0] + foreach {from des} [lindex $ser 2] { + set row [lrange $row0 0 1] + if {[lindex $des 0]} then {lset res 0 $N($from) [list .]} + if {[lindex $des 1]} then {lset row 1 [list .]} + foreach to $stateL {set S($to) [list |]} + foreach {symbol targetL} [lindex $des 2] { + if {$symbol eq ""} then { + set atom [list .] + } else { + set atom [list S $symbol] + } + foreach to $targetL {lappend S($to) $atom} + } + foreach to $stateL { + if {[llength $S($to)] == 2} then { + lappend row [lindex $S($to) 1] + } else { + lappend row $S($to) + } + } + lappend res $row + } + return $res +} + +proc ::grammar::fa::op::matrix_drop_state {T_in {ns re1}} { + set sumcmd ${ns}::| + set prodcmd ${ns}::. + set T1 {} + set lastcol {} + foreach row $T_in { + lappend T1 [lreplace $row end end] + lappend lastcol [lindex $row end] + } + set lastrow [lindex $T1 end] + set T1 [lreplace $T1 end end] + set b [${ns}::* [lindex $lastcol end]] + set lastcol [lreplace $lastcol end end] + set res {} + foreach row $T1 a $lastcol { + set newrow {} + foreach pos $row c $lastrow { + lappend newrow [$sumcmd $pos [$prodcmd $a $b $c]] + } + lappend res $newrow + } + return $res +} + +# ### ### ### ######### ######### ######### +## Internal helpers. Regexp simplification I. + +namespace eval ::grammar::fa::op::re1 { + namespace export | . {\*} +} + +proc ::grammar::fa::op::re1::| {args} { + set L {} + + # | = Choices. + # Sub-choices are lifted into the top expression (foreach). + # Identical choices are reduced to a single term (lsort -uniq). + + foreach re $args { + switch -- [lindex $re 0] "|" { + foreach term [lrange $re 1 end] {lappend L $term} + } default { + lappend L $re + } + } + set L [lsort -unique $L] + if {[llength $L] == 1} then { + return [lindex $L 0] + } else { + return [linsert $L 0 |] + } +} + +proc ::grammar::fa::op::re1::. {args} { + set L {} + + # . = Sequence. + # One element sub-choices are lifted into the top expression. + # Sub-sequences are lifted into the top expression. + + foreach re $args { + switch -- [lindex $re 0] "." { + foreach term [lrange $re 1 end] {lappend L $term} + } "|" { + if {[llength $re] == 1} then {return $re} + lappend L $re + } default { + lappend L $re + } + } + if {[llength $L] == 1} then { + return [lindex $L 0] + } else { + return [linsert $L 0 .] + } +} + +proc ::grammar::fa::op::re1::* {re} { + # * = Kleene closure. + # Sub-closures are lifted into the top expression. + # One-element sub-(choices,sequences) are lifted into the top expression. + + switch -- [lindex $re 0] "|" - "." { + if {[llength $re] == 1} then { + return [list .] + } else { + return [list * $re] + } + } "*" { + return $re + } default { + return [list * $re] + } +} + +# ### ### ### ######### ######### ######### +## Internal helpers. Regexp simplification II. + +namespace eval ::grammar::fa::op::re2 { + # Inherit choices and kleene-closure from the basic simplifier. + + namespace import [namespace parent]::re1::| + namespace import [namespace parent]::re1::\\* +} + +proc ::grammar::fa::op::re2::. {args} { + + # . = Sequences + # Sub-sequences are lifted into the top expression. + # Sub-choices are multiplied out. + # <Example a(b|c) => ab|ac > + + set L {} + set n -1 + foreach re $args { + incr n + switch -- [lindex $re 0] "." { + foreach term [lrange $re 1 end] {lappend L $term} + } "|" { + set res [list |] + set L2 [lreplace $args 0 $n] + foreach term [lrange $re 1 end] { + lappend res [eval [list .] $L [list $term] $L2] + } + return [eval $res] + } default { + lappend L $re + } + } + if {[llength $L] == 1} then { + return [lindex $L 0] + } else { + return [linsert $L 0 .] + } +} + +# ### ### ### ######### ######### ######### +## API. Simplification of regular expressions. + +proc ::grammar::fa::op::simplifyRegexp {RE0} { + set RE1 [namespace inscope nonnull $RE0] + if {[lindex $RE1 0] eq "S" || $RE1 eq "." || $RE1 eq "|"} then { + return $RE1 + } + set tmp [grammar::fa %AUTO% fromRegex $RE1] + $tmp minimize + set RE1 [toRegexp $tmp] + $tmp destroy + if {[string length $RE1] < [string length $RE0]} then { + set RE0 $RE1 + } + if {[lindex $RE0 0] eq "S"} then {return $RE0} + set res [lrange $RE0 0 0] + foreach branch [lrange $RE0 1 end] { + lappend res [simplifyRegexp $branch] + } + return $res +} + +# ### ### ### ######### ######### ######### +## Internal helpers. + +namespace eval ::grammar::fa::op::nonnull {} + +proc ::grammar::fa::op::nonnull::| {args} { + set also_empty false + set res [list |] + foreach branch $args { + set RE [eval $branch] + if {[lindex $RE 0] eq "?"} then { + set also_empty true + set RE [lindex $RE 1] + } + switch -- [lindex $RE 0] "|" { + eval [lreplace $RE 0 0 lappend res] + } "." { + if {[llength $RE] == 1} then { + set also_empty true + } else { + lappend res $RE + } + } default { + lappend res $RE + } + } + if {!$also_empty} then {return $res} + foreach branch [lrange $res 1 end] { + if {[lindex $branch 0] eq "*"} then {return $res} + } + if {[llength $res] == 1} then { + return [list .] + } elseif {[llength $res] == 2} then { + return [lreplace $res 0 0 ?] + } else { + return [list ? $res] + } +} + +proc ::grammar::fa::op::nonnull::. {args} { + set res [list .] + foreach branch $args { + set RE [eval $branch] + switch -- [lindex $RE 0] "|" { + if {[llength $RE] == 1} then {return $RE} + lappend res $RE + } "." { + eval [lreplace $RE 0 0 lappend res] + } default { + lappend res $RE + } + } + return $res +} + +proc ::grammar::fa::op::nonnull::* {sub} { + set RE [eval $sub] + switch -- [lindex $RE 0] "*" - "?" - "+" { + return [lreplace $RE 0 0 *] + } default { + return [list * $RE] + } +} + +proc ::grammar::fa::op::nonnull::+ {sub} { + set RE [eval $sub] + switch -- [lindex $RE 0] "+" { + return $RE + } "*" - "?" { + return [lreplace $RE 0 0 *] + } default { + return [list * $RE] + } +} + +proc ::grammar::fa::op::nonnull::? {sub} { + set RE [eval $sub] + switch -- [lindex $RE 0] "?" - "*" { + return $RE + } "+" { + return [lreplace $RE 0 0 *] + } default { + return [list ? $RE] + } +} + +proc ::grammar::fa::op::nonnull::S {name} { + return [list S $name] +} + +# ### ### ### ######### ######### ######### +## API. Translate RE of this package to Tcl REs + +proc ::grammar::fa::op::toTclRegexp {re symdict} { + return [lindex [namespace inscope tclre $re $symdict] 1] +} + +# ### ### ### ######### ######### ######### +## Internal helpers. + +namespace eval ::grammar::fa::op::tclre {} + +proc ::grammar::fa::op::tclre::S {name dict} { + array set A $dict + if {[info exists A($name)]} then { + return $A($name) + } elseif {[string length $name] == 1} then { + if {[regexp {[\\\[\]{}.()*+?^$]} $name]} then { + return [list char \\$name] + } else { + return [list char $name] + } + } else { + return [list class "\[\[:${name}:\]\]"] + } +} + +proc ::grammar::fa::op::tclre::. {args} { + set suffix [lrange $args end end] + set L {} + foreach factor [lrange $args 0 end-1] { + set pair [eval $factor $suffix] + switch -- [lindex $pair 0] "sum" { + lappend L ([lindex $pair 1]) + } default { + lappend L [lindex $pair 1] + } + } + return [list prod [join $L ""]] +} + +proc ::grammar::fa::op::tclre::* {re dict} { + set pair [eval $re [list $dict]] + switch -- [lindex $pair 0] "sum" - "prod" { + return [list prod "([lindex $pair 1])*"] + } default { + return [list prod "[lindex $pair 1]*"] + } +} + +proc ::grammar::fa::op::tclre::+ {re dict} { + set pair [eval $re [list $dict]] + switch -- [lindex $pair 0] "sum" - "prod" { + return [list prod "([lindex $pair 1])+"] + } default { + return [list prod "[lindex $pair 1]+"] + } +} + +proc ::grammar::fa::op::tclre::? {re dict} { + set pair [eval $re [list $dict]] + switch -- [lindex $pair 0] "sum" - "prod" { + return [list prod "([lindex $pair 1])?"] + } default { + return [list prod "[lindex $pair 1]?"] + } +} + +proc ::grammar::fa::op::tclre::| {args} { + set suffix [lrange $args end end] + set charL {} + set classL {} + set prodL {} + foreach factor [lrange $args 0 end-1] { + set pair [eval $factor $suffix] + switch -- [lindex $pair 0] "char" { + lappend charL [lindex $pair 1] + } "class" { + lappend classL [string range [lindex $pair 1] 1 end-1] + } default { + lappend prodL [lindex $pair 1] + } + } + if {[llength $charL]>1 || [llength $classL]>0} then { + while {[set n [lsearch $charL -]] >= 0} { + lset charL $n {\-} + } + set bracket "\[[join $charL ""][join $classL ""]\]" + if {![llength $prodL]} then { + return [list atom $bracket] + } + lappend prodL $bracket + } else { + eval [list lappend prodL] $charL + } + return [list sum [join $prodL |]] +} + +proc ::grammar::fa::op::tclre::& {args} { + error "Cannot express language intersection in Tcl-RE's" + + # Note: This can be translated by constructing an automaton for + # the intersection, and then translating its conversion to a + # regular expression. +} + +proc ::grammar::fa::op::tclre::! {args} { + error "Cannot express language complementation in Tcl-RE's" + + # Note: This can be translated by constructing an automaton for + # the complement, and then translating its conversion to a regular + # expression. This however requires knowledge regarding the set of + # symbols. Large (utf-8) for Tcl regexes. +} + +# ### ### ### ######### ######### ######### + +proc ::grammar::fa::op::constructor {cmd} { + variable cons $cmd + return +} + +proc ::grammar::fa::op::cons {} { + variable cons + if {$cons ne ""} {return $cons} + return -code error "No constructor for FA container was established." +} + +# ### ### ### ######### ######### ######### +## Package Management + +package provide grammar::fa::op 0.4.1 diff --git a/tcllib/modules/grammar_fa/faop.test b/tcllib/modules/grammar_fa/faop.test new file mode 100644 index 0000000..8357734 --- /dev/null +++ b/tcllib/modules/grammar_fa/faop.test @@ -0,0 +1,45 @@ +# -*- tcl -*- +# faop.test: tests for complex operations on the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop.test,v 1.11 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 1.0 + +support { + useAccel [useTcllibC] struct/sets.tcl struct::set + TestAccelInit struct::set + + use snit/snit.tcl snit ; # 1.1 always, even when Tcl 8.5 runs the testsuite. + use struct/list.tcl struct::list + + useLocalFile tests/Xsupport +} +testing { + useLocal faop.tcl grammar::fa::op +} +support { + useLocalKeep fa.tcl grammar::fa +} + +# ------------------------------------------------------------------------- + +set class ::grammar::fa::op + +# ------------------------------------------------------------------------- + +TestAccelDo struct::set setimpl { + TestFiles tests/faop_*.test +} + +# ------------------------------------------------------------------------- +TestAccelExit struct::set +testsuiteCleanup diff --git a/tcllib/modules/grammar_fa/pkgIndex.tcl b/tcllib/modules/grammar_fa/pkgIndex.tcl new file mode 100644 index 0000000..155fe7c --- /dev/null +++ b/tcllib/modules/grammar_fa/pkgIndex.tcl @@ -0,0 +1,6 @@ +if {![package vsatisfies [package provide Tcl] 8.4]} {return} + +package ifneeded grammar::fa 0.5 [list source [file join $dir fa.tcl]] +package ifneeded grammar::fa::op 0.4.1 [list source [file join $dir faop.tcl]] +package ifneeded grammar::fa::dacceptor 0.1.1 [list source [file join $dir dacceptor.tcl]] +package ifneeded grammar::fa::dexec 0.2 [list source [file join $dir dexec.tcl]] diff --git a/tcllib/modules/grammar_fa/tests/Xsupport b/tcllib/modules/grammar_fa/tests/Xsupport new file mode 100644 index 0000000..73c2d56 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/Xsupport @@ -0,0 +1,371 @@ +# -*- tcl -*- +# ------------------------------------------------------------------------- +# Helper for tests: Validation of serializations. + +proc validate_serial {value fa} { + # value is list/3 ('grammar::fa' symbols states) + # !("" in symbols) + # states is ordered dict (key is state, value is statedata) + # statedata is list/3 (start final trans|"") + # start is boolean + # final is boolean + # trans is dict (key in symbols, value is list (state)) + + # Output for debug ... + ##puts "$fa => ($value)" + + # symbols set-equal symbols(fa) + # states set-equal states(fa) + # finalstates set-equal finalstates(fa) + # startstates set-equal startstates(fa) + + set prefix "error in serialization:" + if {[llength $value] != 3} { + return "$prefix list length not 3" + } + + struct::list assign $value type symbols statedata + + if {$type ne "grammar::fa"} { + return "$prefix unknown type \"$type\"" + } + if {[struct::set contains $symbols ""]} { + return "$prefix empty symbol is not legal" + } + if {![struct::set equal $symbols [$fa symbols]]} { + return "$prefix set of symbols does not match" + } + if {[llength $statedata] % 2 == 1} { + return "$prefix state data is not a dictionary" + } + array set _states $statedata + if {[llength $statedata] != (2*[array size _states])} { + return "$prefix state data contains duplicate states" + } + if {![struct::set equal [array names _states] [$fa states]]} { + return "$prefix set of states does not match" + } + foreach {k v} $statedata { + if {[llength $v] != 3} { + return "$prefix state list length not 3" + } + struct::list assign $v start final trans + if {![string is boolean -strict $start]} { + return "$prefix expected boolean for start, got \"$start\", for state \"$k\"" + } + if {($start && ![$fa start? $k]) || (!$start && [$fa start? $k])} { + return "$prefix start does not match for state \"$k\"" + } + if {![string is boolean -strict $final]} { + return "$prefix expected boolean for final, got \"$final\", for state \"$k\"" + } + if {($final && ![$fa final? $k]) || (!$final && [$fa final? $k])} { + return "$prefix final does not match for state \"$k\"" + } + if {[llength $trans] % 2 == 1} { + return "$prefix transition data is not a dictionary for state \"$k\"" + } + array set _trans $trans + if {[llength $trans] != (2*[array size _trans])} { + return "$prefix transition data contains duplicate symbols for state \"$k\"" + } + # trans keys set-equal to trans/symbols(fa,k) + if {![struct::set equal [$fa symbols@ $k] [array names _trans]]} { + return "$prefix transition symbols do not match for state \"$k\"" + } + unset _trans + + foreach {sym destinations} $trans { + if {($sym ne "") && ![struct::set contains $symbols $sym]} { + return "$prefix illegal symbol \"$sym\" in transition for state \"$k\"" + } + foreach dest $destinations { + if {![info exists _states($dest)]} { + return "$prefix illegal destination state \"$dest\" for state \"$k\"" + } + } + if {![struct::set equal $destinations [$fa next $k $sym]]} { + return "$prefix destination set does not match for state \"$k\"" + } + } + } + return ok +} + +# ------------------------------------------------------------------------- +# Helper for tests: Serialization of empty FA. + +set fa_empty {grammar::fa {} {}} + +# ------------------------------------------------------------------------- +# Helper for tests: Predefined graphs for use in tests. +# (Properties and such). Number of graphs: 30. + +array set fa_pre {} + +proc gen {code} { + global fa_pre + uplevel #0 $fa_pre($code) + return +} +proc def {code script} { + global fa_pre + set fa_pre($code) $script + return +} + + +def x { + a state add x +} +def x- { + a state add x + a symbol add @ + a next x @ --> x +} +def xe { + a state add x + a next x "" --> x +} +def xy { + a state add x y +} +def xy- { + a state add x y + a symbol add @ + a next x @ --> y +} +def xye { + a state add x y + a next x "" --> y +} +def xyee { + a state add x y + a next x "" --> y + a next y "" --> x +} +def xye- { + a state add x y + a symbol add @ + a next x "" --> y + a next y @ --> x +} +def xy-- { + a state add x y + a symbol add @ + a next x @ --> y + a next y @ --> x +} +def xy-= { + a state add x y + a symbol add @ = + a next x @ --> y + a next y = --> x +} +def xyz/ee { + a state add x y z + a next x "" --> y + a next x "" --> z +} +def xyz/e- { + a state add x y z + a symbol add @ + a next x @ --> y + a next x "" --> z +} +def xyz/-- { + a state add x y z + a symbol add @ + a next x @ --> y + a next x @ --> z +} +def xyz/-= { + a state add x y z + a symbol add @ = + a next x @ --> y + a next x = --> z +} +def xyz|ee { + a state add x y z + a next x "" --> z + a next y "" --> z +} +def xyz|e- { + a state add x y z + a symbol add @ + a next x @ --> z + a next y "" --> z +} +def xyz|-- { + a state add x y z + a symbol add @ + a next x @ --> z + a next y @ --> z +} +def xyz|-= { + a state add x y z + a symbol add @ = + a next x @ --> z + a next y = --> z +} +def xyz+eee { + a state add x y z + a next x "" --> y + a next y "" --> z + a next z "" --> x +} +def xyz+ee- { + a state add x y z + a symbol add @ + a next x "" --> y + a next y "" --> z + a next z @ --> x +} +def xyz+e-- { + a state add x y z + a symbol add @ + a next x "" --> y + a next y @ --> z + a next z @ --> x +} +def xyz+e-= { + a state add x y z + a symbol add @ = + a next x "" --> y + a next y @ --> z + a next z = --> x +} +def xyz+--- { + a state add x y z + a symbol add @ + a next x @ --> y + a next y @ --> z + a next z @ --> x +} +def xyz+--= { + a state add x y z + a symbol add @ = + a next x @ --> y + a next y @ --> z + a next z = --> x +} +def xyz+-=_ { + a state add x y z + a symbol add @ = % + a next x @ --> y + a next y = --> z + a next z % --> x +} +def xyz&eee { + a state add x y z + a next x "" --> y + a next x "" --> z + a next y "" --> z +} +def xyz&ee- { + a state add x y z + a symbol add @ + a next x "" --> y + a next x "" --> z + a next y @ --> z +} +def xyz&e-- { + a state add x y z + a symbol add @ + a next x "" --> y + a next x @ --> z + a next y @ --> z +} +def xyz&e-= { + a state add x y z + a symbol add @ = + a next x "" --> y + a next x @ --> z + a next y = --> z +} +def xyz&--- { + a state add x y z + a symbol add @ + a next x @ --> y + a next x @ --> z + a next y @ --> z +} +def xyz&--= { + a state add x y z + a symbol add @ = + a next x @ --> y + a next x @ --> z + a next y = --> z +} +def xyz&-=_ { + a state add x y z + a symbol add @ = % + a next x @ --> y + a next x = --> z + a next y % --> z +} +def xyz!ee { + a state add x y z + a next x "" --> y + a next y "" --> z +} +def xyz!e- { + a state add x y z + a symbol add @ + a next x "" --> y + a next y @ --> z +} +def xyz!-- { + a state add x y z + a symbol add @ + a next x @ --> y + a next y @ --> z +} +def xyz!-= { + a state add x y z + a symbol add @ = % + a next x @ --> y + a next y = --> z +} +def xyz!-e { + a state add x y z + a symbol add @ + a next x @ --> y + a next y "" --> z +} + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +def datom { + a state add x y + a symbol add @ + a next x @ --> y +} +def dalt { + a state add u v w x y z + a symbol add @ = + a next u "" --> v ; a next v @ --> x ; a next x "" --> z + a next u "" --> w ; a next w = --> y ; a next y "" --> z +} +def daltb { + a state add u v w x y z + a symbol add @ = + a next u "" --> v ; a next v @ --> x ; a next x "" --> z + a next u "" --> w ; a next w = --> y ; a next y "" --> z + a next z "" --> u +} +def dopt { + a state add u v w x + a symbol add @ + a next u "" --> v ; a next v @ --> w ; a next w "" --> x + a next u "" --> x +} +def drep { + a state add u v w x + a symbol add @ + a next u "" --> v ; a next v @ --> w ; a next w "" --> x + a next u "" --> x + a next x "" --> u +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/grammar_fa/tests/da_accept.test b/tcllib/modules/grammar_fa/tests/da_accept.test new file mode 100644 index 0000000..3ea7cc1 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/da_accept.test @@ -0,0 +1,84 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa::dacceptor engine +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: da_accept.test,v 1.5 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- +# Regular expression for C comments (Extended notation, using the 'not' operator). +# +# '/' . '*' . (! (ALL* . '*' . '/' . ALL*)) . '*' . '/' +# ALL = '/' | '*' | 'any' +# +# Generated minimal DFA +# +# any/ * +# | | +# 0 -/-> 1 -*-> 2 -*-> 3 -/-> 4 +# \<-any-/ + +#puts -nonewline " RE compile, " ; flush stdout + +grammar::fa ccomments fromRegex {. {S /} + {S *} + {! {. {* {| {S *} {S /} {S any}}} + {S *} + {S /} + {* {| {S *} {S /} {S any}}}}} + {S *} + {S /} + } {/ * any} + +#puts -nonewline {FA, } ; flush stdout + +ccomments determinize ; #puts -nonewline {deterministic, } ; flush stdout +ccomments minimize ; #puts minimal ; flush stdout + + +# ------------------------------------------------------------------------- + +test da-accept-${setimpl}-1.0 {accept? error} { + grammar::fa::dacceptor da ccomments + catch {da accept?} msg + da destroy + set msg +} {wrong # args: should be "::grammar::fa::dacceptor::Snit_methodaccept? type selfns win self symbolstring"} + + +test da-accept-${setimpl}-1.1 {accept? error} { + grammar::fa::dacceptor da ccomments + catch {da accept? x y} msg + da destroy + set msg +} {wrong # args: should be "::grammar::fa::dacceptor::Snit_methodaccept? type selfns win self symbolstring"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +foreach {n acceptany accept string} { + 0 0 0 {x y} + 1 1 1 {/ * * /} + 2 1 0 {/ * x * /} + 3 0 0 {/ * * / * /} + 4 0 0 {/ * x * / x * /} + 5 0 0 {/ * * * / * * /} +} { + test da-accept-${setimpl}-2.$n {accept?, -any any} { + grammar::fa::dacceptor da ccomments -any any + set res [da accept? $string] + da destroy + set res + } $acceptany ; # {} + + test da-accept-${setimpl}-3.$n {accept?} { + grammar::fa::dacceptor da ccomments + set res [da accept? $string] + da destroy + set res + } $accept ; # {} +} + +# ------------------------------------------------------------------------- +ccomments destroy +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/da_cons.test b/tcllib/modules/grammar_fa/tests/da_cons.test new file mode 100644 index 0000000..42cdb6a --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/da_cons.test @@ -0,0 +1,140 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa::dacceptor engine +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: da_cons.test,v 1.8 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +if {![::tcltest::testConstraint runtotal]} { + ::tcltest::cleanupTests + return +} + +# ------------------------------------------------------------------------- + +test da-cons-${setimpl}-1.0 {construction error} { + catch {grammar::fa::dacceptor a} msg + set msg +} {Error in constructor: wrong # args: should be "::grammar::fa::dacceptor::Snit_constructor type selfns win self fa args"} + + +test da-cons-${setimpl}-1.1 {construction error} { + catch {grammar::fa::dacceptor a foo fie far} msg + set msg +} {Error in constructor: unknown option "fie"} + + +test da-cons-${setimpl}-1.2 {construction error} { + catch {grammar::fa::dacceptor a b} msg + set msg +} {Error in constructor: invalid command name "b"} + +foreach {n code setup_result} { + 00 x {{} 0 x 1} + 01 x- {{} 0 x 1} + 02 xe {{} 0 x 0} + 03 xy {{} 0 x 1 y 1 {x y} 0} + 04 xy- {{} 0 x 1 y 1 {x y} 0} + 05 xye {{} 0 x 0 y 0 {x y} 0} + 06 xyee {{} 0 x 0 y 0 {x y} 0} + 07 xye- {{} 0 x 0 y 0 {x y} 0} + 08 xy-- {{} 0 x 1 y 1 {x y} 0} + 09 xy-= {{} 0 x 1 y 1 {x y} 0} + 10 xyz/ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 11 xyz/e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 12 xyz/-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 13 xyz/-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 14 xyz|ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 15 xyz|e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 16 xyz|-- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 17 xyz|-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 18 xyz+eee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 19 xyz+ee- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 20 xyz+e-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 21 xyz+e-= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 22 xyz+--- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 23 xyz+--= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 24 xyz+-=_ {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 25 xyz&eee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 26 xyz&ee- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 27 xyz&e-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 28 xyz&e-= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 29 xyz&--- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 30 xyz&--= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 31 xyz&-=_ {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 32 xyz!ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 33 xyz!e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 34 xyz!-- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 35 xyz!-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 36 xyz!-e {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} +} { + foreach {stset expected} $setup_result { + foreach {fset __} $setup_result { + set key ${n}.${code}.([join $stset {}]).([join $fset {}]) + + test da-cons-${setimpl}-1.3.$key {construction error} { + grammar::fa a + gen $code + a start set $stset + a final set $fset + set nfa [expr {![a is deterministic]}] + set fail [catch {grammar::fa::dacceptor da a} msg] + a destroy + catch {da destroy} + + expr {($nfa && $fail) || (!$nfa && !$fail)} + } 1 + } + } +} + +test da-cons-${setimpl}-1.4 {construction error} { + grammar::fa a + gen xyz+-=_ + a start add x + catch {grammar::fa::dacceptor da a -any *} msg + a destroy + set msg +} {Error in constructor: Chosen any symbol "*" does not exist} + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test da-cons-${setimpl}-2.0 {construction} { + grammar::fa a + gen xyz+-=_ + a start add x + grammar::fa::dacceptor da a + a destroy + da destroy +} {} + + +test da-cons-${setimpl}-2.1 {construction} { + set res {} + grammar::fa a + gen xyz+-=_ + a start add x + lappend res [info commands ::da] + grammar::fa::dacceptor da a + a destroy + lappend res [info commands ::da] + da destroy + lappend res [info commands ::da] + set res +} {{} ::da {}} + + +test da-cons-${setimpl}-2.2 {construction} { + grammar::fa a + gen xyz+-=_ + a start add x + grammar::fa::dacceptor da a -any @ + a destroy + da destroy +} {} + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/de_cons.test b/tcllib/modules/grammar_fa/tests/de_cons.test new file mode 100644 index 0000000..5ff8407 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/de_cons.test @@ -0,0 +1,157 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa::dexec engine +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: de_cons.test,v 1.8 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +if {![::tcltest::testConstraint runtotal]} { + ::tcltest::cleanupTests + return +} + +# ------------------------------------------------------------------------- + +global events + +# ------------------------------------------------------------------------- + +test de-cons-${setimpl}-1.0 {construction error} { + catch {grammar::fa::dexec a} msg + set msg +} {Error in constructor: wrong # args: should be "::grammar::fa::dexec::Snit_constructor type selfns win self fa args"} + + +test de-cons-${setimpl}-1.1 {construction error} { + catch {grammar::fa::dexec a foo fie far} msg + set msg +} {Error in constructor: unknown option "fie"} + + +test de-cons-${setimpl}-1.2 {construction error} { + catch {grammar::fa::dexec a b} msg + set msg +} {Error in constructor: invalid command name "b"} + +foreach {n code setup_result} { + 00 x {{} 0 x 1} + 01 x- {{} 0 x 1} + 02 xe {{} 0 x 0} + 03 xy {{} 0 x 1 y 1 {x y} 0} + 04 xy- {{} 0 x 1 y 1 {x y} 0} + 05 xye {{} 0 x 0 y 0 {x y} 0} + 06 xyee {{} 0 x 0 y 0 {x y} 0} + 07 xye- {{} 0 x 0 y 0 {x y} 0} + 08 xy-- {{} 0 x 1 y 1 {x y} 0} + 09 xy-= {{} 0 x 1 y 1 {x y} 0} + 10 xyz/ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 11 xyz/e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 12 xyz/-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 13 xyz/-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 14 xyz|ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 15 xyz|e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 16 xyz|-- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 17 xyz|-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 18 xyz+eee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 19 xyz+ee- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 20 xyz+e-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 21 xyz+e-= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 22 xyz+--- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 23 xyz+--= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 24 xyz+-=_ {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 25 xyz&eee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 26 xyz&ee- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 27 xyz&e-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 28 xyz&e-= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 29 xyz&--- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 30 xyz&--= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 31 xyz&-=_ {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 32 xyz!ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 33 xyz!e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 34 xyz!-- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 35 xyz!-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 36 xyz!-e {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} +} { + foreach {stset expected} $setup_result { + foreach {fset __} $setup_result { + set key ${n}.${code}.([join $stset {}]).([join $fset {}]) + + test de-cons-${setimpl}-1.3.$key {construction error} { + grammar::fa a + gen $code + a start set $stset + a final set $fset + set nfa [expr {![a is deterministic]}] + set fail [catch {grammar::fa::dexec de a -command {lappend events}} msg] + a destroy + catch {de destroy} + + set res [expr {($nfa && $fail) || (!$nfa && !$fail)}] + if {!$res} {set res $msg} + set res + } 1 + } + } +} + +test de-cons-${setimpl}-1.4 {construction error} { + grammar::fa a + gen xyz+-=_ + a start add x + catch {grammar::fa::dexec de a -any *} msg + a destroy + set msg +} {Error in constructor: Chosen any symbol "*" does not exist} + +test de-cons-${setimpl}-1.5 {construction error} { + grammar::fa a + gen xyz+-=_ + a start add x + catch {grammar::fa::dexec de a -any @} msg + a destroy + set msg +} {Error in constructor: Command callback missing} + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test de-cons-${setimpl}-2.0 {construction} { + grammar::fa a + gen xyz+-=_ + a start add x + grammar::fa::dexec de a -command {lappend events} + a destroy + de destroy +} {} + + +test de-cons-${setimpl}-2.1 {construction} { + set res {} + grammar::fa a + gen xyz+-=_ + a start add x + lappend res [info commands ::de] + grammar::fa::dexec de a -command {lappend events} + a destroy + lappend res [info commands ::de] + de destroy + lappend res [info commands ::de] + set res +} {{} ::de {}} + + +test de-cons-${setimpl}-2.2 {construction} { + grammar::fa a + gen xyz+-=_ + a start add x + grammar::fa::dexec de a -any @ -command {lappend events} + a destroy + de destroy +} {} + + +# ------------------------------------------------------------------------- +unset events +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/de_exec.test b/tcllib/modules/grammar_fa/tests/de_exec.test new file mode 100644 index 0000000..ab0cce9 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/de_exec.test @@ -0,0 +1,104 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa::dexec engine +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: de_exec.test,v 1.6 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- +# Regular expression for C comments (Extended notation, using the 'not' operator). +# +# '/' . '*' . (! (ALL* . '*' . '/' . ALL*)) . '*' . '/' +# ALL = '/' | '*' | 'any' +# +# Generated minimal DFA +# +# any/ * +# | | +# 0 -/-> 1 -*-> 2 -*-> 3 -/-> 4 +# \<-any-/ + +#puts -nonewline " RE compile, " ; flush stdout + +grammar::fa ccomments fromRegex {. {S /} + {S *} + {! {. {* {| {S *} {S /} {S any}}} + {S *} + {S /} + {* {| {S *} {S /} {S any}}}}} + {S *} + {S /} + } {/ * any} + +#puts -nonewline {FA, } ; flush stdout + +ccomments determinize ; #puts -nonewline {deterministic, } ; flush stdout +ccomments minimize ; #puts minimal ; flush stdout + +# ------------------------------------------------------------------------- + +global events + +# ------------------------------------------------------------------------- + +test de-reset-${setimpl}-1.0 {reset error} { + grammar::fa::dexec de ccomments -command {lappend events} + catch {de reset x} msg + de destroy + set msg +} {wrong # args: should be "::grammar::fa::dexec::Snit_methodreset type selfns win self"} + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +foreach {n string acceptany accept} { + 0 {x y} + {reset . error BADTRANS {Bad transition ("0" "any"), no destination} .} + {reset . error BADSYM {Bad symbol "x"} .} + + 1 {/ * * /} + {reset . state 1 . state 2 . state 3 . state 4 final 4} + {reset . state 1 . state 2 . state 3 . state 4 final 4} + + 2 {/ * x * /} + {reset . state 1 . state 2 . state 2 . state 3 . state 4 final 4} + {reset . state 1 . state 2 . error BADSYM {Bad symbol "x"} . .} + + 3 {/ * * / * /} + {reset . state 1 . state 2 . state 3 . state 4 final 4 . error BADTRANS {Bad transition ("4" "*"), no destination} .} + {reset . state 1 . state 2 . state 3 . state 4 final 4 . error BADTRANS {Bad transition ("4" "*"), no destination} .} + + 4 {/ * x * / x * /} + {reset . state 1 . state 2 . state 2 . state 3 . state 4 final 4 . error BADTRANS {Bad transition ("4" "any"), no destination} . .} + {reset . state 1 . state 2 . error BADSYM {Bad symbol "x"} . . . . .} + + 5 {/ * * * / * * /} + {reset . state 1 . state 2 . state 3 . state 3 . state 4 final 4 . error BADTRANS {Bad transition ("4" "*"), no destination} . .} + {reset . state 1 . state 2 . state 3 . state 3 . state 4 final 4 . error BADTRANS {Bad transition ("4" "*"), no destination} . .} +} { + test de-put-${setimpl}-2.$n {put, -any any} { + set events {} + grammar::fa::dexec de ccomments -any any -command {lappend events} + foreach sy $string { + lappend events . + de put $sy + } + de destroy + set events + } $acceptany ; # {} + + test de-put-${setimpl}-3.$n {put} { + set events {} + grammar::fa::dexec de ccomments -command {lappend events} + foreach sy $string { + lappend events . + de put $sy + } + de destroy + set events + } $accept ; # {} +} + +# ------------------------------------------------------------------------- +ccomments destroy +unset events +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_cons.test b/tcllib/modules/grammar_fa/tests/fa_cons.test new file mode 100644 index 0000000..6bbfaf1 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_cons.test @@ -0,0 +1,87 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_cons.test,v 1.6 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-cons-${setimpl}-1.0 {construction error} { + catch {grammar::fa a foo} msg + set msg +} {Error in constructor: wrong#args: ::a ?=|:=|<--|as|deserialize a'|fromRegex re ?over??} + + +test fa-cons-${setimpl}-1.1 {construction error} { + catch {grammar::fa a foo fie far fux} msg + set msg +} {Error in constructor: wrong#args: ::a ?=|:=|<--|as|deserialize a'|fromRegex re ?over??} + + +test fa-cons-${setimpl}-1.2 {construction error} { + catch {grammar::fa a foo fie far} msg + set msg +} {Error in constructor: bad assignment: ::a ?=|:=|<--|as|deserialize a'|fromRegex re ?over??} + + +test fa-cons-${setimpl}-1.3 {construction error} { + catch {grammar::fa a foo fie} msg + set msg +} {Error in constructor: bad assignment: ::a ?=|:=|<--|as|deserialize a'|fromRegex re ?over??} + + +test fa-cons-${setimpl}-1.4 {construction error} { + catch {grammar::fa a = b} msg + set msg +} {Error in constructor: invalid command name "b"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-cons-${setimpl}-2.0 {construction} { + grammar::fa a + a destroy +} {} + +test fa-cons-${setimpl}-2.1 {construction} { + set res {} + lappend res [info commands ::a] + grammar::fa a + lappend res [info commands ::a] + a destroy + lappend res [info commands ::a] + set res +} {{} ::a {}} + + +test fa-cons-${setimpl}-2.2 {construction, properties of empty fa} { + set res {} + grammar::fa a + lappend res [a info type] + lappend res [a symbols] + lappend res [a states] + lappend res [a finalstates] + lappend res [a startstates] + lappend res [a reachable_states] + lappend res [a useful_states] + lappend res [a is deterministic] + lappend res [a is useful] + lappend res [a is complete] + lappend res [a is epsilon-free] + a destroy + set res +} {::grammar::fa {} {} {} {} {} {} 0 0 1 1} + + +test fa-cons-${setimpl}-2.3 {construction, serial} { + grammar::fa a + set res [a serialize] + a destroy + set res +} $fa_empty + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_ec.test b/tcllib/modules/grammar_fa/tests/fa_ec.test new file mode 100644 index 0000000..ef488e7 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_ec.test @@ -0,0 +1,84 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_ec.test,v 1.4 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-ec-${setimpl}-1.0 {epsilon closure} { + grammar::fa a + catch {a epsilon_closure} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodepsilon_closure type selfns win self s"} + +test fa-ec-${setimpl}-1.1 {epsilon closure} { + grammar::fa a + catch {a epsilon_closure x} res + a destroy + set res +} {Illegal state "x"} + +test fa-ec-${setimpl}-1.2 {epsilon closure} { + grammar::fa a + catch {a epsilon_closure x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodepsilon_closure type selfns win self s"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +foreach {n code ec} { + 00 x {x} + 01 x- {x} + 02 xe {x} + 03 xy {x} + 04 xy- {x} + 05 xye {x y} + 06 xyee {x y} + 07 xye- {x y} + 08 xy-- {x} + 09 xy-= {x} + 10 xyz/ee {x y z} + 11 xyz/e- {x z} + 12 xyz/-- {x} + 13 xyz/-= {x} + 14 xyz|ee {x z} + 15 xyz|e- {x} + 16 xyz|-- {x} + 17 xyz|-= {x} + 18 xyz+eee {x y z} + 19 xyz+ee- {x y z} + 20 xyz+e-- {x y} + 21 xyz+e-= {x y} + 22 xyz+--- {x} + 23 xyz+--= {x} + 24 xyz+-=_ {x} + 25 xyz&eee {x y z} + 26 xyz&ee- {x y z} + 27 xyz&e-- {x y} + 28 xyz&e-= {x y} + 29 xyz&--- {x} + 30 xyz&--= {x} + 31 xyz&-=_ {x} + 32 xyz!ee {x y z} + 33 xyz!e- {x y} + 34 xyz!-- {x} + 35 xyz!-= {x} + 36 xyz!-e {x} +} { + test fa-ec-${setimpl}-2.${n}.$code {epsilon closure} { + grammar::fa a + gen $code + set res [lsort [a epsilon_closure x]] + a destroy + set res + } $ec +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_final.test b/tcllib/modules/grammar_fa/tests/fa_final.test new file mode 100644 index 0000000..0927af3 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_final.test @@ -0,0 +1,391 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_final.test,v 1.6 2009/10/27 21:17:23 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-final-${setimpl}-1.0 {final states, error} { + grammar::fa a + catch {a finalstates x} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodfinalstates type selfns win self"} + + +test fa-final-${setimpl}-1.1 {final query, error} { + grammar::fa a + catch {a final?} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodfinal? type selfns win self s"} + + +test fa-final-${setimpl}-1.2 {final query, error} { + grammar::fa a + catch {a final? x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodfinal? type selfns win self s"} + + +test fa-final-${setimpl}-1.3 {final query, error} { + grammar::fa a + catch {a final? x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-final-${setimpl}-1.4 {final query set, error} { + grammar::fa a + catch {a final?set} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodfinal?set type selfns win self states"} + + +test fa-final-${setimpl}-1.5 {final query set, error} { + grammar::fa a + catch {a final?set x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodfinal?set type selfns win self states"} + + +test fa-final-${setimpl}-1.6 {final query set, error} { + grammar::fa a + catch {a final?set x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-final-${setimpl}-1.7 {final query set, error} { + grammar::fa a + a state add x + catch {a final?set {x y}} res + a destroy + set res +} {Illegal state "y"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-final-${setimpl}-2.0 {final, error} { + grammar::fa a + catch {a final} res + a destroy + set res +} {wrong number args: should be "::a final method args"} +# [tcltest::wrongNumArgs {::a final method} {args} 0] + + +test fa-final-${setimpl}-2.1 {final, error} { + grammar::fa a + catch {a final foo} res + a destroy + set res +} {"::a final foo" is not defined} + + +test fa-final-${setimpl}-2.2 {final, error} { + grammar::fa a + catch {a final add} res + a destroy + set res +} [tcltest::wrongNumArgs {::grammar::fa::Snit_hmethodfinal_add} {type selfns win self state args} 0] +# [snitWrongNumArgs a {final add} {state args} 0] +# {wrong # args: should be "::grammar::fa::Snit_hmethodfinal_add type selfns win self state args"} + + +test fa-final-${setimpl}-2.3 {final, error} { + grammar::fa a + catch {a final add x y} res + a destroy + set res +} {Illegal state "x"} + + +test fa-final-${setimpl}-2.4 {final, error} { + grammar::fa a + catch {a final add x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-final-${setimpl}-2.5 {final states} { + grammar::fa a + catch {a final remove} res + a destroy + set res +} [tcltest::wrongNumArgs {::grammar::fa::Snit_hmethodfinal_remove} {type selfns win self state args} 0] +# {wrong # args: should be "::grammar::fa::Snit_hmethodfinal_remove type selfns win self state args"} + + +test fa-final-${setimpl}-2.6 {final states} { + grammar::fa a + catch {a final remove x y} res + a destroy + set res +} {Illegal state "x"} + + +test fa-final-${setimpl}-2.7 {final states} { + grammar::fa a + catch {a final remove x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-final-${setimpl}-2.8 {final states} { + grammar::fa a + catch {a final set} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_hmethodfinal_set type selfns win self states"} + + +test fa-final-${setimpl}-2.9 {final states} { + grammar::fa a + a state add x + catch {a final set {x y}} res + a destroy + set res +} {Illegal state "y"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-final-${setimpl}-3.0 {final states, empty fa} { + grammar::fa a + set res [a finalstates] + a destroy + set res +} {} + + +test fa-final-${setimpl}-3.1 {final states, plain state} { + grammar::fa a + a state add x + set res [a finalstates] + a destroy + set res +} {} + + +test fa-final-${setimpl}-3.2 {final states, state addition} { + grammar::fa a + a state add x + a final add x + set res [a finalstates] + a destroy + set res +} x + + +test fa-final-${setimpl}-3.3 {final states, state addition} { + grammar::fa a + a state add x y + a final add x y + set res [lsort [a finalstates]] + a destroy + set res +} {x y} + + +test fa-final-${setimpl}-3.4 {final states, state addition, and remova;} { + grammar::fa a + a state add x y + a final add x y + set res {} + lappend res [a finalstates] + a final remove y + lappend res [a finalstates] + a final remove x + lappend res [a finalstates] + a destroy + set res +} {{x y} x {}} + + +test fa-final-${setimpl}-3.5 {final states, state addition, and remova;} { + grammar::fa a + a state add x y + a final add x y + set res {} + lappend res [a finalstates] + a state delete y + lappend res [a finalstates] + a state delete x + lappend res [a finalstates] + a destroy + set res +} {{x y} x {}} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-final-${setimpl}-4.0 {final?} { + grammar::fa a + a state add x + set res [a final? x] + a destroy + set res +} 0 + + +test fa-final-${setimpl}-4.1 {final?} { + grammar::fa a + a state add x + a final add x + set res [a final? x] + a destroy + set res +} 1 + + +test fa-final-${setimpl}-4.2 {final?} { + grammar::fa a + a state add x + a final add x + set res [a final? x] + a final remove x + lappend res [a final? x] + a destroy + set res +} {1 0} + + +test fa-final-${setimpl}-4.3 {final?} { + grammar::fa a + a state add x + a final add x + set res [a final? x] + a state delete x + catch {a final? x} msg + lappend res $msg + a destroy + set res +} {1 {Illegal state "x"}} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-final-${setimpl}-5.0 {final?set} { + grammar::fa a + a state add x + set res [a final?set x] + a destroy + set res +} 0 + + +test fa-final-${setimpl}-5.1 {final?set} { + grammar::fa a + a state add x + a final add x + set res [a final?set x] + a destroy + set res +} 1 + + +test fa-final-${setimpl}-5.2 {final?set} { + grammar::fa a + set res {} + a state add x + a final add x + lappend res [a final?set x] + a final remove x + lappend res [a final?set x] + a destroy + set res +} {1 0} + + +test fa-final-${setimpl}-5.3 {final?set} { + grammar::fa a + set res {} + a state add x y + a final add x + lappend res [a final?set y] + lappend res [a final?set {x y}] + a destroy + set res +} {0 1} + + +test fa-final-${setimpl}-5.4 {final?set} { + grammar::fa a + a state add x + set res {} + lappend res [a final? x] + lappend res [a final remove x] + lappend res [a final? x] + a destroy + set res +} {0 {} 0} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +test fa-final-${setimpl}-6.0 {final clear} { + grammar::fa a + a state add x + a final add x + set res {} + lappend res [a finalstates] + a final clear + lappend res [a finalstates] + a destroy + set res +} {x {}} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-final-${setimpl}-7.0 {final set} { + grammar::fa a + a state add x + a final set x + set res [a finalstates] + a destroy + set res +} x + + +test fa-final-${setimpl}-7.1 {final set} { + grammar::fa a + a state add x y + a final set {x y} + set res [lsort [a finalstates]] + a destroy + set res +} {x y} + + +test fa-final-${setimpl}-7.2 {final set} { + grammar::fa a + set res {} + a state add x y z + a final add z + lappend res [a finalstates] + a final set {x y} + lappend res [lsort [a finalstates]] + a destroy + set res +} {z {x y}} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_is.test b/tcllib/modules/grammar_fa/tests/fa_is.test new file mode 100644 index 0000000..8f8e36a --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_is.test @@ -0,0 +1,59 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_is.test,v 1.4 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-is-${setimpl}-1.0 {is, error} { + grammar::fa a + catch {a is} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_methodis type selfns win self cmd"} + + +test fa-is-${setimpl}-1.1 {is, error} { + grammar::fa a + catch {a is foo} msg + a destroy + set msg +} {Expected complete, deterministic, epsilon-free, or useful, got "foo"} + + +test fa-is-${setimpl}-1.2 {is, error} { + grammar::fa a + catch {a is complete bar} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_methodis type selfns win self cmd"} + + +test fa-is-${setimpl}-1.3 {is, error} { + grammar::fa a + catch {a is deterministic bar} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_methodis type selfns win self cmd"} + + +test fa-is-${setimpl}-1.4 {is, error} { + grammar::fa a + catch {a is useful bar} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_methodis type selfns win self cmd"} + + +test fa-is-${setimpl}-1.5 {is, error} { + grammar::fa a + catch {a is epsilon-free bar} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_methodis type selfns win self cmd"} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_is_complete.test b/tcllib/modules/grammar_fa/tests/fa_is_complete.test new file mode 100644 index 0000000..7229303 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_is_complete.test @@ -0,0 +1,60 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_is_complete.test,v 1.5 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +foreach {n code result} { + 00 x 1 + 01 x- 1 + 02 xe 1 + 03 xy 1 + 04 xy- 0 + 05 xye 1 + 06 xyee 1 + 07 xye- 1 + 08 xy-- 1 + 09 xy-= 0 + 10 xyz/ee 1 + 11 xyz/e- 0 + 12 xyz/-- 0 + 13 xyz/-= 0 + 14 xyz|ee 1 + 15 xyz|e- 0 + 16 xyz|-- 0 + 17 xyz|-= 0 + 18 xyz+eee 1 + 19 xyz+ee- 1 + 20 xyz+e-- 1 + 21 xyz+e-= 0 + 22 xyz+--- 1 + 23 xyz+--= 0 + 24 xyz+-=_ 0 + 25 xyz&eee 1 + 26 xyz&ee- 0 + 27 xyz&e-- 0 + 28 xyz&e-= 0 + 29 xyz&--- 0 + 30 xyz&--= 0 + 31 xyz&-=_ 0 + 32 xyz!ee 1 + 33 xyz!e- 0 + 34 xyz!-- 0 + 35 xyz!-= 0 + 36 xyz!-e 0 +} { + test fa-is-${setimpl}-complete-1.${n}.$code {is complete} { + grammar::fa a + gen $code + set res [a is complete] + a destroy + set res + } $result ;# {} +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_is_deterministic.test b/tcllib/modules/grammar_fa/tests/fa_is_deterministic.test new file mode 100644 index 0000000..3be3831 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_is_deterministic.test @@ -0,0 +1,75 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_is_deterministic.test,v 1.7 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +if {![::tcltest::testConstraint runtotal]} { + ::tcltest::cleanupTests + return +} + +# ------------------------------------------------------------------------- + +foreach {n code setup_result} { + 00 x {{} 0 x 1} + 01 x- {{} 0 x 1} + 02 xe {{} 0 x 0} + 03 xy {{} 0 x 1 y 1 {x y} 0} + 04 xy- {{} 0 x 1 y 1 {x y} 0} + 05 xye {{} 0 x 0 y 0 {x y} 0} + 06 xyee {{} 0 x 0 y 0 {x y} 0} + 07 xye- {{} 0 x 0 y 0 {x y} 0} + 08 xy-- {{} 0 x 1 y 1 {x y} 0} + 09 xy-= {{} 0 x 1 y 1 {x y} 0} + 10 xyz/ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 11 xyz/e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 12 xyz/-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 13 xyz/-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 14 xyz|ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 15 xyz|e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 16 xyz|-- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 17 xyz|-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 18 xyz+eee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 19 xyz+ee- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 20 xyz+e-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 21 xyz+e-= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 22 xyz+--- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 23 xyz+--= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 24 xyz+-=_ {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 25 xyz&eee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 26 xyz&ee- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 27 xyz&e-- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 28 xyz&e-= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 29 xyz&--- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 30 xyz&--= {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 31 xyz&-=_ {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 32 xyz!ee {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 33 xyz!e- {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 34 xyz!-- {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 35 xyz!-= {{} 0 x 1 y 1 z 1 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} + 36 xyz!-e {{} 0 x 0 y 0 z 0 {x y} 0 {x z} 0 {y z} 0 {x y z} 0} +} { + foreach {stset expected} $setup_result { + foreach {fset __} $setup_result { + set key ${n}.${code}.([join $stset {}]).([join $fset {}]) + + test fa-is-${setimpl}-deterministic-1.$key {is deterministic} { + grammar::fa a + gen $code + a start set $stset + a final set $fset + set res [a is deterministic] + a destroy + set res + } $expected ; # {} + } + } +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_is_epsfree.test b/tcllib/modules/grammar_fa/tests/fa_is_epsfree.test new file mode 100644 index 0000000..32d2f36 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_is_epsfree.test @@ -0,0 +1,60 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_is_epsfree.test,v 1.4 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +foreach {n code result} { + 00 x 1 + 01 x- 1 + 02 xe 0 + 03 xy 1 + 04 xy- 1 + 05 xye 0 + 06 xyee 0 + 07 xye- 0 + 08 xy-- 1 + 09 xy-= 1 + 10 xyz/ee 0 + 11 xyz/e- 0 + 12 xyz/-- 1 + 13 xyz/-= 1 + 14 xyz|ee 0 + 15 xyz|e- 0 + 16 xyz|-- 1 + 17 xyz|-= 1 + 18 xyz+eee 0 + 19 xyz+ee- 0 + 20 xyz+e-- 0 + 21 xyz+e-= 0 + 22 xyz+--- 1 + 23 xyz+--= 1 + 24 xyz+-=_ 1 + 25 xyz&eee 0 + 26 xyz&ee- 0 + 27 xyz&e-- 0 + 28 xyz&e-= 0 + 29 xyz&--- 1 + 30 xyz&--= 1 + 31 xyz&-=_ 1 + 32 xyz!ee 0 + 33 xyz!e- 0 + 34 xyz!-- 1 + 35 xyz!-= 1 + 36 xyz!-e 0 +} { + test fa-is-${setimpl}-epsilonfree-1.${n}.$code {is epsilon free} { + grammar::fa a + gen $code + set res [a is epsilon-free] + a destroy + set res + } $result ; # {} +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_is_useful.test b/tcllib/modules/grammar_fa/tests/fa_is_useful.test new file mode 100644 index 0000000..65d870b --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_is_useful.test @@ -0,0 +1,715 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_is_useful.test,v 1.7 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +if {![::tcltest::testConstraint runtotal]} { + ::tcltest::cleanupTests + return +} + +# ------------------------------------------------------------------------- +unset -nocomplain expected +array set expected { + 04.xy-.(x,y) _ + 04.xy-.(x,xy) _ + 04.xy-.(xy,y) _ + 05.xye.(x,y) _ + 05.xye.(x,xy) _ + 05.xye.(xy,y) _ + 06.xyee.(x,x) _ + 06.xyee.(x,y) _ + 06.xyee.(x,xy) _ + 06.xyee.(y,x) _ + 06.xyee.(y,y) _ + 06.xyee.(y,xy) _ + 06.xyee.(xy,x) _ + 06.xyee.(xy,y) _ + 07.xye-.(x,x) _ + 07.xye-.(x,y) _ + 07.xye-.(x,xy) _ + 07.xye-.(y,x) _ + 07.xye-.(y,y) _ + 07.xye-.(y,xy) _ + 07.xye-.(xy,x) _ + 07.xye-.(xy,y) _ + 08.xy--.(x,x) _ + 08.xy--.(x,y) _ + 08.xy--.(x,xy) _ + 08.xy--.(y,x) _ + 08.xy--.(y,y) _ + 08.xy--.(y,xy) _ + 08.xy--.(xy,x) _ + 08.xy--.(xy,y) _ + 09.xy-=.(x,x) _ + 09.xy-=.(x,y) _ + 09.xy-=.(x,xy) _ + 09.xy-=.(y,x) _ + 09.xy-=.(y,y) _ + 09.xy-=.(y,xy) _ + 09.xy-=.(xy,x) _ + 09.xy-=.(xy,y) _ + 10.xyz/ee.(x,yz) _ + 10.xyz/ee.(x,xyz) _ + 10.xyz/ee.(xy,yz) _ + 10.xyz/ee.(xy,xyz) _ + 10.xyz/ee.(xz,yz) _ + 10.xyz/ee.(xz,xyz) _ + 10.xyz/ee.(xyz,yz) _ + 11.xyz/e-.(x,yz) _ + 11.xyz/e-.(x,xyz) _ + 11.xyz/e-.(xy,yz) _ + 11.xyz/e-.(xy,xyz) _ + 11.xyz/e-.(xz,yz) _ + 11.xyz/e-.(xz,xyz) _ + 11.xyz/e-.(xyz,yz) _ + 12.xyz/--.(x,yz) _ + 12.xyz/--.(x,xyz) _ + 12.xyz/--.(xy,yz) _ + 12.xyz/--.(xy,xyz) _ + 12.xyz/--.(xz,yz) _ + 12.xyz/--.(xz,xyz) _ + 12.xyz/--.(xyz,yz) _ + 13.xyz/-=.(x,yz) _ + 13.xyz/-=.(x,xyz) _ + 13.xyz/-=.(xy,yz) _ + 13.xyz/-=.(xy,xyz) _ + 13.xyz/-=.(xz,yz) _ + 13.xyz/-=.(xz,xyz) _ + 13.xyz/-=.(xyz,yz) _ + 14.xyz|ee.(xy,z) _ + 14.xyz|ee.(xy,xz) _ + 14.xyz|ee.(xy,yz) _ + 14.xyz|ee.(xy,xyz) _ + 14.xyz|ee.(xyz,z) _ + 14.xyz|ee.(xyz,xz) _ + 14.xyz|ee.(xyz,yz) _ + 15.xyz|e-.(xy,z) _ + 15.xyz|e-.(xy,xz) _ + 15.xyz|e-.(xy,yz) _ + 15.xyz|e-.(xy,xyz) _ + 15.xyz|e-.(xyz,z) _ + 15.xyz|e-.(xyz,xz) _ + 15.xyz|e-.(xyz,yz) _ + 16.xyz|--.(xy,z) _ + 16.xyz|--.(xy,xz) _ + 16.xyz|--.(xy,yz) _ + 16.xyz|--.(xy,xyz) _ + 16.xyz|--.(xyz,z) _ + 16.xyz|--.(xyz,xz) _ + 16.xyz|--.(xyz,yz) _ + 17.xyz|-=.(xy,z) _ + 17.xyz|-=.(xy,xz) _ + 17.xyz|-=.(xy,yz) _ + 17.xyz|-=.(xy,xyz) _ + 17.xyz|-=.(xyz,z) _ + 17.xyz|-=.(xyz,xz) _ + 17.xyz|-=.(xyz,yz) _ + 18.xyz+eee.(x,x) _ + 18.xyz+eee.(x,y) _ + 18.xyz+eee.(x,z) _ + 18.xyz+eee.(x,xy) _ + 18.xyz+eee.(x,xz) _ + 18.xyz+eee.(x,yz) _ + 18.xyz+eee.(x,xyz) _ + 18.xyz+eee.(y,x) _ + 18.xyz+eee.(y,y) _ + 18.xyz+eee.(y,z) _ + 18.xyz+eee.(y,xy) _ + 18.xyz+eee.(y,xz) _ + 18.xyz+eee.(y,yz) _ + 18.xyz+eee.(y,xyz) _ + 18.xyz+eee.(z,x) _ + 18.xyz+eee.(z,y) _ + 18.xyz+eee.(z,z) _ + 18.xyz+eee.(z,xy) _ + 18.xyz+eee.(z,xz) _ + 18.xyz+eee.(z,yz) _ + 18.xyz+eee.(z,xyz) _ + 18.xyz+eee.(xy,x) _ + 18.xyz+eee.(xy,y) _ + 18.xyz+eee.(xy,z) _ + 18.xyz+eee.(xy,xy) _ + 18.xyz+eee.(xy,xz) _ + 18.xyz+eee.(xy,yz) _ + 18.xyz+eee.(xy,xyz) _ + 18.xyz+eee.(xz,x) _ + 18.xyz+eee.(xz,y) _ + 18.xyz+eee.(xz,z) _ + 18.xyz+eee.(xz,xy) _ + 18.xyz+eee.(xz,xz) _ + 18.xyz+eee.(xz,yz) _ + 18.xyz+eee.(xz,xyz) _ + 18.xyz+eee.(yz,x) _ + 18.xyz+eee.(yz,y) _ + 18.xyz+eee.(yz,z) _ + 18.xyz+eee.(yz,xy) _ + 18.xyz+eee.(yz,xz) _ + 18.xyz+eee.(yz,yz) _ + 18.xyz+eee.(yz,xyz) _ + 18.xyz+eee.(xyz,x) _ + 18.xyz+eee.(xyz,y) _ + 18.xyz+eee.(xyz,z) _ + 18.xyz+eee.(xyz,xy) _ + 18.xyz+eee.(xyz,xz) _ + 18.xyz+eee.(xyz,yz) _ + 19.xyz+ee-.(x,x) _ + 19.xyz+ee-.(x,y) _ + 19.xyz+ee-.(x,z) _ + 19.xyz+ee-.(x,xy) _ + 19.xyz+ee-.(x,xz) _ + 19.xyz+ee-.(x,yz) _ + 19.xyz+ee-.(x,xyz) _ + 19.xyz+ee-.(y,x) _ + 19.xyz+ee-.(y,y) _ + 19.xyz+ee-.(y,z) _ + 19.xyz+ee-.(y,xy) _ + 19.xyz+ee-.(y,xz) _ + 19.xyz+ee-.(y,yz) _ + 19.xyz+ee-.(y,xyz) _ + 19.xyz+ee-.(z,x) _ + 19.xyz+ee-.(z,y) _ + 19.xyz+ee-.(z,z) _ + 19.xyz+ee-.(z,xy) _ + 19.xyz+ee-.(z,xz) _ + 19.xyz+ee-.(z,yz) _ + 19.xyz+ee-.(z,xyz) _ + 19.xyz+ee-.(xy,x) _ + 19.xyz+ee-.(xy,y) _ + 19.xyz+ee-.(xy,z) _ + 19.xyz+ee-.(xy,xy) _ + 19.xyz+ee-.(xy,xz) _ + 19.xyz+ee-.(xy,yz) _ + 19.xyz+ee-.(xy,xyz) _ + 19.xyz+ee-.(xz,x) _ + 19.xyz+ee-.(xz,y) _ + 19.xyz+ee-.(xz,z) _ + 19.xyz+ee-.(xz,xy) _ + 19.xyz+ee-.(xz,xz) _ + 19.xyz+ee-.(xz,yz) _ + 19.xyz+ee-.(xz,xyz) _ + 19.xyz+ee-.(yz,x) _ + 19.xyz+ee-.(yz,y) _ + 19.xyz+ee-.(yz,z) _ + 19.xyz+ee-.(yz,xy) _ + 19.xyz+ee-.(yz,xz) _ + 19.xyz+ee-.(yz,yz) _ + 19.xyz+ee-.(yz,xyz) _ + 19.xyz+ee-.(xyz,x) _ + 19.xyz+ee-.(xyz,y) _ + 19.xyz+ee-.(xyz,z) _ + 19.xyz+ee-.(xyz,xy) _ + 19.xyz+ee-.(xyz,xz) _ + 19.xyz+ee-.(xyz,yz) _ + 20.xyz+e--.(x,x) _ + 20.xyz+e--.(x,y) _ + 20.xyz+e--.(x,z) _ + 20.xyz+e--.(x,xy) _ + 20.xyz+e--.(x,xz) _ + 20.xyz+e--.(x,yz) _ + 20.xyz+e--.(x,xyz) _ + 20.xyz+e--.(y,x) _ + 20.xyz+e--.(y,y) _ + 20.xyz+e--.(y,z) _ + 20.xyz+e--.(y,xy) _ + 20.xyz+e--.(y,xz) _ + 20.xyz+e--.(y,yz) _ + 20.xyz+e--.(y,xyz) _ + 20.xyz+e--.(z,x) _ + 20.xyz+e--.(z,y) _ + 20.xyz+e--.(z,z) _ + 20.xyz+e--.(z,xy) _ + 20.xyz+e--.(z,xz) _ + 20.xyz+e--.(z,yz) _ + 20.xyz+e--.(z,xyz) _ + 20.xyz+e--.(xy,x) _ + 20.xyz+e--.(xy,y) _ + 20.xyz+e--.(xy,z) _ + 20.xyz+e--.(xy,xy) _ + 20.xyz+e--.(xy,xz) _ + 20.xyz+e--.(xy,yz) _ + 20.xyz+e--.(xy,xyz) _ + 20.xyz+e--.(xz,x) _ + 20.xyz+e--.(xz,y) _ + 20.xyz+e--.(xz,z) _ + 20.xyz+e--.(xz,xy) _ + 20.xyz+e--.(xz,xz) _ + 20.xyz+e--.(xz,yz) _ + 20.xyz+e--.(xz,xyz) _ + 20.xyz+e--.(yz,x) _ + 20.xyz+e--.(yz,y) _ + 20.xyz+e--.(yz,z) _ + 20.xyz+e--.(yz,xy) _ + 20.xyz+e--.(yz,xz) _ + 20.xyz+e--.(yz,yz) _ + 20.xyz+e--.(yz,xyz) _ + 20.xyz+e--.(xyz,x) _ + 20.xyz+e--.(xyz,y) _ + 20.xyz+e--.(xyz,z) _ + 20.xyz+e--.(xyz,xy) _ + 20.xyz+e--.(xyz,xz) _ + 20.xyz+e--.(xyz,yz) _ + 21.xyz+e-=.(x,x) _ + 21.xyz+e-=.(x,y) _ + 21.xyz+e-=.(x,z) _ + 21.xyz+e-=.(x,xy) _ + 21.xyz+e-=.(x,xz) _ + 21.xyz+e-=.(x,yz) _ + 21.xyz+e-=.(x,xyz) _ + 21.xyz+e-=.(y,x) _ + 21.xyz+e-=.(y,y) _ + 21.xyz+e-=.(y,z) _ + 21.xyz+e-=.(y,xy) _ + 21.xyz+e-=.(y,xz) _ + 21.xyz+e-=.(y,yz) _ + 21.xyz+e-=.(y,xyz) _ + 21.xyz+e-=.(z,x) _ + 21.xyz+e-=.(z,y) _ + 21.xyz+e-=.(z,z) _ + 21.xyz+e-=.(z,xy) _ + 21.xyz+e-=.(z,xz) _ + 21.xyz+e-=.(z,yz) _ + 21.xyz+e-=.(z,xyz) _ + 21.xyz+e-=.(xy,x) _ + 21.xyz+e-=.(xy,y) _ + 21.xyz+e-=.(xy,z) _ + 21.xyz+e-=.(xy,xy) _ + 21.xyz+e-=.(xy,xz) _ + 21.xyz+e-=.(xy,yz) _ + 21.xyz+e-=.(xy,xyz) _ + 21.xyz+e-=.(xz,x) _ + 21.xyz+e-=.(xz,y) _ + 21.xyz+e-=.(xz,z) _ + 21.xyz+e-=.(xz,xy) _ + 21.xyz+e-=.(xz,xz) _ + 21.xyz+e-=.(xz,yz) _ + 21.xyz+e-=.(xz,xyz) _ + 21.xyz+e-=.(yz,x) _ + 21.xyz+e-=.(yz,y) _ + 21.xyz+e-=.(yz,z) _ + 21.xyz+e-=.(yz,xy) _ + 21.xyz+e-=.(yz,xz) _ + 21.xyz+e-=.(yz,yz) _ + 21.xyz+e-=.(yz,xyz) _ + 21.xyz+e-=.(xyz,x) _ + 21.xyz+e-=.(xyz,y) _ + 21.xyz+e-=.(xyz,z) _ + 21.xyz+e-=.(xyz,xy) _ + 21.xyz+e-=.(xyz,xz) _ + 21.xyz+e-=.(xyz,yz) _ + 22.xyz+---.(x,x) _ + 22.xyz+---.(x,y) _ + 22.xyz+---.(x,z) _ + 22.xyz+---.(x,xy) _ + 22.xyz+---.(x,xz) _ + 22.xyz+---.(x,yz) _ + 22.xyz+---.(x,xyz) _ + 22.xyz+---.(y,x) _ + 22.xyz+---.(y,y) _ + 22.xyz+---.(y,z) _ + 22.xyz+---.(y,xy) _ + 22.xyz+---.(y,xz) _ + 22.xyz+---.(y,yz) _ + 22.xyz+---.(y,xyz) _ + 22.xyz+---.(z,x) _ + 22.xyz+---.(z,y) _ + 22.xyz+---.(z,z) _ + 22.xyz+---.(z,xy) _ + 22.xyz+---.(z,xz) _ + 22.xyz+---.(z,yz) _ + 22.xyz+---.(z,xyz) _ + 22.xyz+---.(xy,x) _ + 22.xyz+---.(xy,y) _ + 22.xyz+---.(xy,z) _ + 22.xyz+---.(xy,xy) _ + 22.xyz+---.(xy,xz) _ + 22.xyz+---.(xy,yz) _ + 22.xyz+---.(xy,xyz) _ + 22.xyz+---.(xz,x) _ + 22.xyz+---.(xz,y) _ + 22.xyz+---.(xz,z) _ + 22.xyz+---.(xz,xy) _ + 22.xyz+---.(xz,xz) _ + 22.xyz+---.(xz,yz) _ + 22.xyz+---.(xz,xyz) _ + 22.xyz+---.(yz,x) _ + 22.xyz+---.(yz,y) _ + 22.xyz+---.(yz,z) _ + 22.xyz+---.(yz,xy) _ + 22.xyz+---.(yz,xz) _ + 22.xyz+---.(yz,yz) _ + 22.xyz+---.(yz,xyz) _ + 22.xyz+---.(xyz,x) _ + 22.xyz+---.(xyz,y) _ + 22.xyz+---.(xyz,z) _ + 22.xyz+---.(xyz,xy) _ + 22.xyz+---.(xyz,xz) _ + 22.xyz+---.(xyz,yz) _ + 23.xyz+--=.(x,x) _ + 23.xyz+--=.(x,y) _ + 23.xyz+--=.(x,z) _ + 23.xyz+--=.(x,xy) _ + 23.xyz+--=.(x,xz) _ + 23.xyz+--=.(x,yz) _ + 23.xyz+--=.(x,xyz) _ + 23.xyz+--=.(y,x) _ + 23.xyz+--=.(y,y) _ + 23.xyz+--=.(y,z) _ + 23.xyz+--=.(y,xy) _ + 23.xyz+--=.(y,xz) _ + 23.xyz+--=.(y,yz) _ + 23.xyz+--=.(y,xyz) _ + 23.xyz+--=.(z,x) _ + 23.xyz+--=.(z,y) _ + 23.xyz+--=.(z,z) _ + 23.xyz+--=.(z,xy) _ + 23.xyz+--=.(z,xz) _ + 23.xyz+--=.(z,yz) _ + 23.xyz+--=.(z,xyz) _ + 23.xyz+--=.(xy,x) _ + 23.xyz+--=.(xy,y) _ + 23.xyz+--=.(xy,z) _ + 23.xyz+--=.(xy,xy) _ + 23.xyz+--=.(xy,xz) _ + 23.xyz+--=.(xy,yz) _ + 23.xyz+--=.(xy,xyz) _ + 23.xyz+--=.(xz,x) _ + 23.xyz+--=.(xz,y) _ + 23.xyz+--=.(xz,z) _ + 23.xyz+--=.(xz,xy) _ + 23.xyz+--=.(xz,xz) _ + 23.xyz+--=.(xz,yz) _ + 23.xyz+--=.(xz,xyz) _ + 23.xyz+--=.(yz,x) _ + 23.xyz+--=.(yz,y) _ + 23.xyz+--=.(yz,z) _ + 23.xyz+--=.(yz,xy) _ + 23.xyz+--=.(yz,xz) _ + 23.xyz+--=.(yz,yz) _ + 23.xyz+--=.(yz,xyz) _ + 23.xyz+--=.(xyz,x) _ + 23.xyz+--=.(xyz,y) _ + 23.xyz+--=.(xyz,z) _ + 23.xyz+--=.(xyz,xy) _ + 23.xyz+--=.(xyz,xz) _ + 23.xyz+--=.(xyz,yz) _ + 24.xyz+-=_.(x,x) _ + 24.xyz+-=_.(x,y) _ + 24.xyz+-=_.(x,z) _ + 24.xyz+-=_.(x,xy) _ + 24.xyz+-=_.(x,xz) _ + 24.xyz+-=_.(x,yz) _ + 24.xyz+-=_.(x,xyz) _ + 24.xyz+-=_.(y,x) _ + 24.xyz+-=_.(y,y) _ + 24.xyz+-=_.(y,z) _ + 24.xyz+-=_.(y,xy) _ + 24.xyz+-=_.(y,xz) _ + 24.xyz+-=_.(y,yz) _ + 24.xyz+-=_.(y,xyz) _ + 24.xyz+-=_.(z,x) _ + 24.xyz+-=_.(z,y) _ + 24.xyz+-=_.(z,z) _ + 24.xyz+-=_.(z,xy) _ + 24.xyz+-=_.(z,xz) _ + 24.xyz+-=_.(z,yz) _ + 24.xyz+-=_.(z,xyz) _ + 24.xyz+-=_.(xy,x) _ + 24.xyz+-=_.(xy,y) _ + 24.xyz+-=_.(xy,z) _ + 24.xyz+-=_.(xy,xy) _ + 24.xyz+-=_.(xy,xz) _ + 24.xyz+-=_.(xy,yz) _ + 24.xyz+-=_.(xy,xyz) _ + 24.xyz+-=_.(xz,x) _ + 24.xyz+-=_.(xz,y) _ + 24.xyz+-=_.(xz,z) _ + 24.xyz+-=_.(xz,xy) _ + 24.xyz+-=_.(xz,xz) _ + 24.xyz+-=_.(xz,yz) _ + 24.xyz+-=_.(xz,xyz) _ + 24.xyz+-=_.(yz,x) _ + 24.xyz+-=_.(yz,y) _ + 24.xyz+-=_.(yz,z) _ + 24.xyz+-=_.(yz,xy) _ + 24.xyz+-=_.(yz,xz) _ + 24.xyz+-=_.(yz,yz) _ + 24.xyz+-=_.(yz,xyz) _ + 24.xyz+-=_.(xyz,x) _ + 24.xyz+-=_.(xyz,y) _ + 24.xyz+-=_.(xyz,z) _ + 24.xyz+-=_.(xyz,xy) _ + 24.xyz+-=_.(xyz,xz) _ + 24.xyz+-=_.(xyz,yz) _ + 25.xyz&eee.(x,z) _ + 25.xyz&eee.(x,xz) _ + 25.xyz&eee.(x,yz) _ + 25.xyz&eee.(x,xyz) _ + 25.xyz&eee.(xy,z) _ + 25.xyz&eee.(xy,xz) _ + 25.xyz&eee.(xy,yz) _ + 25.xyz&eee.(xy,xyz) _ + 25.xyz&eee.(xz,z) _ + 25.xyz&eee.(xz,xz) _ + 25.xyz&eee.(xz,yz) _ + 25.xyz&eee.(xz,xyz) _ + 25.xyz&eee.(xyz,z) _ + 25.xyz&eee.(xyz,xz) _ + 25.xyz&eee.(xyz,yz) _ + 26.xyz&ee-.(x,z) _ + 26.xyz&ee-.(x,xz) _ + 26.xyz&ee-.(x,yz) _ + 26.xyz&ee-.(x,xyz) _ + 26.xyz&ee-.(xy,z) _ + 26.xyz&ee-.(xy,xz) _ + 26.xyz&ee-.(xy,yz) _ + 26.xyz&ee-.(xy,xyz) _ + 26.xyz&ee-.(xz,z) _ + 26.xyz&ee-.(xz,xz) _ + 26.xyz&ee-.(xz,yz) _ + 26.xyz&ee-.(xz,xyz) _ + 26.xyz&ee-.(xyz,z) _ + 26.xyz&ee-.(xyz,xz) _ + 26.xyz&ee-.(xyz,yz) _ + 27.xyz&e--.(x,z) _ + 27.xyz&e--.(x,xz) _ + 27.xyz&e--.(x,yz) _ + 27.xyz&e--.(x,xyz) _ + 27.xyz&e--.(xy,z) _ + 27.xyz&e--.(xy,xz) _ + 27.xyz&e--.(xy,yz) _ + 27.xyz&e--.(xy,xyz) _ + 27.xyz&e--.(xz,z) _ + 27.xyz&e--.(xz,xz) _ + 27.xyz&e--.(xz,yz) _ + 27.xyz&e--.(xz,xyz) _ + 27.xyz&e--.(xyz,z) _ + 27.xyz&e--.(xyz,xz) _ + 27.xyz&e--.(xyz,yz) _ + 28.xyz&e-=.(x,z) _ + 28.xyz&e-=.(x,xz) _ + 28.xyz&e-=.(x,yz) _ + 28.xyz&e-=.(x,xyz) _ + 28.xyz&e-=.(xy,z) _ + 28.xyz&e-=.(xy,xz) _ + 28.xyz&e-=.(xy,yz) _ + 28.xyz&e-=.(xy,xyz) _ + 28.xyz&e-=.(xz,z) _ + 28.xyz&e-=.(xz,xz) _ + 28.xyz&e-=.(xz,yz) _ + 28.xyz&e-=.(xz,xyz) _ + 28.xyz&e-=.(xyz,z) _ + 28.xyz&e-=.(xyz,xz) _ + 28.xyz&e-=.(xyz,yz) _ + 29.xyz&---.(x,z) _ + 29.xyz&---.(x,xz) _ + 29.xyz&---.(x,yz) _ + 29.xyz&---.(x,xyz) _ + 29.xyz&---.(xy,z) _ + 29.xyz&---.(xy,xz) _ + 29.xyz&---.(xy,yz) _ + 29.xyz&---.(xy,xyz) _ + 29.xyz&---.(xz,z) _ + 29.xyz&---.(xz,xz) _ + 29.xyz&---.(xz,yz) _ + 29.xyz&---.(xz,xyz) _ + 29.xyz&---.(xyz,z) _ + 29.xyz&---.(xyz,xz) _ + 29.xyz&---.(xyz,yz) _ + 30.xyz&--=.(x,z) _ + 30.xyz&--=.(x,xz) _ + 30.xyz&--=.(x,yz) _ + 30.xyz&--=.(x,xyz) _ + 30.xyz&--=.(xy,z) _ + 30.xyz&--=.(xy,xz) _ + 30.xyz&--=.(xy,yz) _ + 30.xyz&--=.(xy,xyz) _ + 30.xyz&--=.(xz,z) _ + 30.xyz&--=.(xz,xz) _ + 30.xyz&--=.(xz,yz) _ + 30.xyz&--=.(xz,xyz) _ + 30.xyz&--=.(xyz,z) _ + 30.xyz&--=.(xyz,xz) _ + 30.xyz&--=.(xyz,yz) _ + 31.xyz&-=_.(x,z) _ + 31.xyz&-=_.(x,xz) _ + 31.xyz&-=_.(x,yz) _ + 31.xyz&-=_.(x,xyz) _ + 31.xyz&-=_.(xy,z) _ + 31.xyz&-=_.(xy,xz) _ + 31.xyz&-=_.(xy,yz) _ + 31.xyz&-=_.(xy,xyz) _ + 31.xyz&-=_.(xz,z) _ + 31.xyz&-=_.(xz,xz) _ + 31.xyz&-=_.(xz,yz) _ + 31.xyz&-=_.(xz,xyz) _ + 31.xyz&-=_.(xyz,z) _ + 31.xyz&-=_.(xyz,xz) _ + 31.xyz&-=_.(xyz,yz) _ + 32.xyz!ee.(x,z) _ + 32.xyz!ee.(x,xz) _ + 32.xyz!ee.(x,yz) _ + 32.xyz!ee.(x,xyz) _ + 32.xyz!ee.(xy,z) _ + 32.xyz!ee.(xy,xz) _ + 32.xyz!ee.(xy,yz) _ + 32.xyz!ee.(xy,xyz) _ + 32.xyz!ee.(xz,z) _ + 32.xyz!ee.(xz,xz) _ + 32.xyz!ee.(xz,yz) _ + 32.xyz!ee.(xz,xyz) _ + 32.xyz!ee.(xyz,z) _ + 32.xyz!ee.(xyz,xz) _ + 32.xyz!ee.(xyz,yz) _ + 33.xyz!e-.(x,z) _ + 33.xyz!e-.(x,xz) _ + 33.xyz!e-.(x,yz) _ + 33.xyz!e-.(x,xyz) _ + 33.xyz!e-.(xy,z) _ + 33.xyz!e-.(xy,xz) _ + 33.xyz!e-.(xy,yz) _ + 33.xyz!e-.(xy,xyz) _ + 33.xyz!e-.(xz,z) _ + 33.xyz!e-.(xz,xz) _ + 33.xyz!e-.(xz,yz) _ + 33.xyz!e-.(xz,xyz) _ + 33.xyz!e-.(xyz,z) _ + 33.xyz!e-.(xyz,xz) _ + 33.xyz!e-.(xyz,yz) _ + 34.xyz!--.(x,z) _ + 34.xyz!--.(x,xz) _ + 34.xyz!--.(x,yz) _ + 34.xyz!--.(x,xyz) _ + 34.xyz!--.(xy,z) _ + 34.xyz!--.(xy,xz) _ + 34.xyz!--.(xy,yz) _ + 34.xyz!--.(xy,xyz) _ + 34.xyz!--.(xz,z) _ + 34.xyz!--.(xz,xz) _ + 34.xyz!--.(xz,yz) _ + 34.xyz!--.(xz,xyz) _ + 34.xyz!--.(xyz,z) _ + 34.xyz!--.(xyz,xz) _ + 34.xyz!--.(xyz,yz) _ + 35.xyz!-=.(x,z) _ + 35.xyz!-=.(x,xz) _ + 35.xyz!-=.(x,yz) _ + 35.xyz!-=.(x,xyz) _ + 35.xyz!-=.(xy,z) _ + 35.xyz!-=.(xy,xz) _ + 35.xyz!-=.(xy,yz) _ + 35.xyz!-=.(xy,xyz) _ + 35.xyz!-=.(xz,z) _ + 35.xyz!-=.(xz,xz) _ + 35.xyz!-=.(xz,yz) _ + 35.xyz!-=.(xz,xyz) _ + 35.xyz!-=.(xyz,z) _ + 35.xyz!-=.(xyz,xz) _ + 35.xyz!-=.(xyz,yz) _ + 36.xyz!-e.(x,z) _ + 36.xyz!-e.(x,xz) _ + 36.xyz!-e.(x,yz) _ + 36.xyz!-e.(x,xyz) _ + 36.xyz!-e.(xy,z) _ + 36.xyz!-e.(xy,xz) _ + 36.xyz!-e.(xy,yz) _ + 36.xyz!-e.(xy,xyz) _ + 36.xyz!-e.(xz,z) _ + 36.xyz!-e.(xz,xz) _ + 36.xyz!-e.(xz,yz) _ + 36.xyz!-e.(xz,xyz) _ + 36.xyz!-e.(xyz,z) _ + 36.xyz!-e.(xyz,xz) _ + 36.xyz!-e.(xyz,yz) _ +} + +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 + } + + foreach st $sets { + foreach fin $sets { + set key $n.$code.([join $st {}],[join $fin {}]) + + if { + ([join $st {}] eq [join $fin {}]) && + ([join $st {}] eq [string range $code 0 $max]) + } { + # If all states are both start and final the FA cannot + # be other than useful. + set expected($key) . + } + + test fa-is-${setimpl}-useful-1.$key {is useful} { + grammar::fa a + gen $code + a start set $st + a final set $fin + set res [a is useful] + a destroy + set res + } [info exists expected($key)] ;# {} + } + } +} + + +#parray expected +unset expected + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_next.test b/tcllib/modules/grammar_fa/tests/fa_next.test new file mode 100644 index 0000000..749d354 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_next.test @@ -0,0 +1,421 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_next.test,v 1.5 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-next-${setimpl}-1.0 {next} { + grammar::fa a + catch {a next} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_methodnext {type selfns win self s sym args} 5] + + +test fa-next-${setimpl}-1.1 {next} { + grammar::fa a + catch {a next a} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_methodnext {type selfns win self s sym args} 5] + + +test fa-next-${setimpl}-1.2 {next} { + grammar::fa a + catch {a next a b c} res + a destroy + set res +} {wrong#args: ::a next s sym ?--> s'?} + + +test fa-next-${setimpl}-1.3 {next} { + grammar::fa a + catch {a next a b c d e} res + a destroy + set res +} {wrong#args: ::a next s sym ?--> s'?} + + +test fa-next-${setimpl}-1.4 {next} { + grammar::fa a + catch {a next a b} res + a destroy + set res +} {Illegal state "a"} + + +test fa-next-${setimpl}-1.5 {next} { + grammar::fa a + a state add a + catch {a next a b} res + a destroy + set res +} {Illegal symbol "b"} + + +test fa-next-${setimpl}-1.6 {next} { + grammar::fa a + a state add a + a symbol add b + catch {a next a b --> c} res + a destroy + set res +} {Illegal state "c"} + + +test fa-next-${setimpl}-1.7 {next} { + grammar::fa a + a state add a + a state add c + a symbol add b + catch {a next a b x c} res + a destroy + set res +} {Expected -->, got "x"} + + +test fa-next-${setimpl}-1.8 {next} { + grammar::fa a + a state add a c + a symbol add b + a next a b --> c + catch {a next a b --> c} res + a destroy + set res +} {Transition "(a, (b)) --> c" is already known} + + +test fa-next-${setimpl}-1.9 {!next} { + grammar::fa a + catch {a !next} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_method!next {type selfns win self s sym args} 5] + + +test fa-next-${setimpl}-1.10 {!next} { + grammar::fa a + catch {a !next a} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_method!next {type selfns win self s sym args} 5] + + +test fa-next-${setimpl}-1.11 {!next} { + grammar::fa a + catch {a !next a b c} res + a destroy + set res +} {wrong#args: ::a !next s sym ?--> s'?} + + +test fa-next-${setimpl}-1.12 {!next} { + grammar::fa a + catch {a !next a b c d e} res + a destroy + set res +} {wrong#args: ::a !next s sym ?--> s'?} + + +test fa-next-${setimpl}-1.13 {!next} { + grammar::fa a + catch {a !next a b} res + a destroy + set res +} {Illegal state "a"} + + +test fa-next-${setimpl}-1.14 {!next} { + grammar::fa a + a state add a + catch {a !next a b} res + a destroy + set res +} {Illegal symbol "b"} + + +test fa-next-${setimpl}-1.15 {!next} { + grammar::fa a + a state add a + a symbol add b + catch {a !next a b --> c} res + a destroy + set res +} {Illegal state "c"} + + +test fa-next-${setimpl}-1.16 {!next} { + grammar::fa a + a state add a + a state add c + a symbol add b + catch {a !next a b x c} res + a destroy + set res +} {Expected -->, got "x"} + + +test fa-next-${setimpl}-1.17 {nextset} { + grammar::fa a + catch {a nextset} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodnextset type selfns win self states sym"} + + +test fa-next-${setimpl}-1.18 {nextset} { + grammar::fa a + catch {a nextset a} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodnextset type selfns win self states sym"} + + +test fa-next-${setimpl}-1.19 {nextset} { + grammar::fa a + catch {a nextset a b c} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodnextset type selfns win self states sym"} + + +test fa-next-${setimpl}-1.20 {nextset} { + grammar::fa a + catch {a nextset a b} res + a destroy + set res +} {Illegal symbol "b"} + + +test fa-next-${setimpl}-1.21 {nextset} { + grammar::fa a + a symbol add b + catch {a nextset a b} res + a destroy + set res +} {Illegal state "a"} + + +test fa-next-${setimpl}-1.22 {nextset} { + grammar::fa a + a symbol add b + a state add a + catch {a nextset {a c} b} res + a destroy + set res +} {Illegal state "c"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-next-${setimpl}-2.0 {next} { + grammar::fa a + a state add a + a symbol add b + set res [a next a b] + a destroy + set res +} {} + + +test fa-next-${setimpl}-2.1 {next} { + grammar::fa a + a state add a + a state add c + a symbol add b + a next a b --> c + set res [a next a b] + a destroy + set res +} c + + +test fa-next-${setimpl}-2.2 {next} { + grammar::fa a + a state add a c d + a symbol add b + a next a b --> c + a next a b --> d + set res [lsort [a next a b]] + a destroy + set res +} {c d} + + +test fa-next-${setimpl}-2.3 {next, loop} { + grammar::fa a + a state add a + a symbol add @ + a next a @ --> a + set res [a next a @] + a destroy + set res +} a + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-next-${setimpl}-3.0 {!next} { + set res {} + grammar::fa a + a state add a + a symbol add b + a next a b --> a + lappend res [a next a b] + a !next a b --> a + lappend res [a next a b] + a destroy + set res +} {a {}} + + +test fa-next-${setimpl}-3.1 {!next} { + set res {} + grammar::fa a + a state add a + a symbol add b + a next a b --> a + lappend res [a next a b] + a !next a b + lappend res [a next a b] + a destroy + set res +} {a {}} + + +test fa-next-${setimpl}-3.2 {!next} { + set res {} + grammar::fa a + a state add a + a state add b + a symbol add b + a next a b --> a + a next a b --> b + lappend res [lsort [a next a b]] + a !next a b --> a + lappend res [a next a b] + a destroy + set res +} {{a b} b} + + +test fa-next-${setimpl}-3.3 {!next} { + set res {} + grammar::fa a + a state add a + a state add b + a symbol add b + a next a b --> a + a next a b --> b + lappend res [lsort [a next a b]] + a !next a b + lappend res [a next a b] + a destroy + set res +} {{a b} {}} + + +test fa-next-${setimpl}-3.4 {!next} { + set res {} + grammar::fa a + a state add a + a symbol add b + a !next a b + a destroy + set res +} {} + + +test fa-next-${setimpl}-3.5 {!next} { + set res {} + grammar::fa a + a state add a + a symbol add b + a !next a b --> a + a destroy + set res +} {} + + +test fa-next-${setimpl}-3.6 {!next, loop} { + grammar::fa a + a state add a + a symbol add @ + a next a @ --> a + set res [a next a @] + a !next a @ --> a + a destroy + set res +} a + + +test fa-next-${setimpl}-3.7 {!next, loop} { + grammar::fa a + a state add a + a symbol add @ + a next a @ --> a + set res [a next a @] + a !next a @ + a destroy + set res +} a + + +test fa-next-${setimpl}-3.8 {!next, loop} { + grammar::fa a + a state add a + a symbol add @ = + a next a @ --> a + a next a = --> a + a !next a @ --> a + a !next a = --> a + a destroy +} {} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-next-${setimpl}-4.0 {nextset} { + grammar::fa a + a symbol add b + a state add a + a state add c + set res [a nextset {a c} b] + a destroy + set res +} {} + + +test fa-next-${setimpl}-4.1 {nextset} { + grammar::fa a + a symbol add b + a state add a + a state add c + a next a b --> c + set res [a nextset {a c} b] + a destroy + set res +} c + + +test fa-next-${setimpl}-4.2 {nextset} { + grammar::fa a + a symbol add b + a state add a + a state add c + a next a b --> c + a next c b --> a + set res [lsort [a nextset {a c} b]] + a destroy + set res +} {a c} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_reach.test b/tcllib/modules/grammar_fa/tests/fa_reach.test new file mode 100644 index 0000000..21ac0d1 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_reach.test @@ -0,0 +1,344 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_reach.test,v 1.4 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-reach-${setimpl}-1.0 {reachability} { + grammar::fa a + catch {a reachable_states x} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodreachable_states type selfns win self"} + + +test fa-reach-${setimpl}-1.1 {!reachability} { + grammar::fa a + catch {a unreachable_states a} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodunreachable_states type selfns win self"} + + +test fa-reach-${setimpl}-1.2 {reachability} { + grammar::fa a + catch {a reachable} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodreachable type selfns win self s"} + + +test fa-reach-${setimpl}-1.3 {reachability} { + grammar::fa a + catch {a reachable x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-reach-${setimpl}-1.4 {reachability} { + grammar::fa a + catch {a reachable x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodreachable type selfns win self s"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-reach-${setimpl}-2.0 {reachable states, empty fa} { + grammar::fa a + set res [a reachable_states] + a destroy + set res +} {} + + +test fa-reach-${setimpl}-2.1 {reachable states, state addition, plain} { + grammar::fa a + a state add x + set res [a reachable_states] + a destroy + set res +} {} + +test fa-reach-${setimpl}-2.2 {reachable states, state addition, final} { + grammar::fa a + a state add x + a final add x + set res [a reachable_states] + a destroy + set res +} {} + + +test fa-reach-${setimpl}-2.3 {reachable states, state addition, start} { + grammar::fa a + a state add x + a start add x + set res [a reachable_states] + a destroy + set res +} x + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-reach-${setimpl}-3.0 {unreachable states, empty fa} { + grammar::fa a + set res [a unreachable_states] + a destroy + set res +} {} + + +test fa-reach-${setimpl}-3.1 {unreachable states, state addition, plain} { + grammar::fa a + a state add x + set res [a unreachable_states] + a destroy + set res +} x + +test fa-reach-${setimpl}-3.2 {unreachable states, state addition, final} { + grammar::fa a + a state add x + a final add x + set res [a unreachable_states] + a destroy + set res +} x + + +test fa-reach-${setimpl}-3.3 {unreachable states, state addition, start} { + grammar::fa a + a state add x + a start add x + set res [a unreachable_states] + a destroy + set res +} {} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code setup_result} { + 00 x {{} {} x x x {}} + 01 x- {{} {} x x x {}} + 02 xe {{} {} x x x {}} + 03 xy {{} {} {x y} x x y y y x {x y} {x y} {}} + 04 xy- {{} {} {x y} x {x y} {} y y x {x y} {x y} {}} + 05 xye {{} {} {x y} x {x y} {} y y x {x y} {x y} {}} + 06 xyee {{} {} {x y} x {x y} {} y {x y} {} {x y} {x y} {}} + 07 xye- {{} {} {x y} x {x y} {} y {x y} {} {x y} {x y} {}} + 08 xy-- {{} {} {x y} x {x y} {} y {x y} {} {x y} {x y} {}} + 09 xy-= {{} {} {x y} x {x y} {} y {x y} {} {x y} {x y} {}} + 10 xyz/ee { + {} {} {x y z} x {x y z} {} + y y {x z} z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 11 xyz/e- { + {} {} {x y z} x {x y z} {} + y y {x z} z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 12 xyz/-- { + {} {} {x y z} x {x y z} {} + y y {x z} z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 13 xyz/-= { + {} {} {x y z} x {x y z} {} + y y {x z} z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 14 xyz|ee { + {} {} {x y z} x {x z} y + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x z} y + {y z} {y z} x {x y z} {x y z} {} + } + 15 xyz|e- { + {} {} {x y z} x {x z} y + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x z} y + {y z} {y z} x {x y z} {x y z} {} + } + 16 xyz|-- { + {} {} {x y z} x {x z} y + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x z} y + {y z} {y z} x {x y z} {x y z} {} + } + 17 xyz|-= { + {} {} {x y z} x {x z} y + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x z} y + {y z} {y z} x {x y z} {x y z} {} + } + 18 xyz+eee { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 19 xyz+ee- { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 20 xyz+e-- { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 21 xyz+e-= { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 22 xyz+--- { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 23 xyz+--= { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 24 xyz+-=_ { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 25 xyz&eee { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 26 xyz&ee- { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 27 xyz&e-- { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 28 xyz&e-= { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 29 xyz&--- { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 30 xyz&--= { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 31 xyz&-=_ { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 32 xyz!ee { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 33 xyz!e- { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 34 xyz!-- { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 35 xyz!-= { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } + 36 xyz!-e { + {} {} {x y z} x {x y z} {} + y {y z} x z z {x y} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {y z} x {x y z} {x y z} {} + } +} { + foreach {fset reachable unreach} $setup_result { + set key ${n}.${code}.([join $fset {}]) + set expected {} + foreach x $reachable {lappend expected 1} + foreach x $unreach {lappend expected 0} + + test fa-reach-${setimpl}-4.$key {reachable states} { + grammar::fa a + gen $code + a start set $fset + set res [lsort [a reachable_states]] + a destroy + set res + } $reachable ; # {} + + test fa-reach-${setimpl}-5.$key {!reachable states} { + grammar::fa a + gen $code + a start set $fset + set res [lsort [a unreachable_states]] + a destroy + set res + } $unreach ; # {} + + test fa-reach-${setimpl}-6.$key {reachability testing} { + grammar::fa a + gen $code + a start set $fset + set res {} + foreach x $reachable {lappend res [a reachable $x]} + foreach x $unreach {lappend res [a reachable $x]} + a destroy + set res + } $expected ; # {} + } +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_serial.test b/tcllib/modules/grammar_fa/tests/fa_serial.test new file mode 100644 index 0000000..46b018f --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_serial.test @@ -0,0 +1,221 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_serial.test,v 1.8 2007/04/12 03:43:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +if {![::tcltest::testConstraint runtotal]} { + ::tcltest::cleanupTests + return +} + +# ------------------------------------------------------------------------- + +test fa-serial-${setimpl}-1.0 {serialize, error} { + grammar::fa a + catch {a serialize a} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_methodserialize type selfns win self"} + + +test fa-serial-${setimpl}-1.1 {deserialize, error} { + grammar::fa a + catch {a deserialize} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_methoddeserialize type selfns win self value"} + + +test fa-serial-${setimpl}-1.2 {deserialize, error} { + grammar::fa a + catch {a deserialize a b} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_methoddeserialize type selfns win self value"} + + +test fa-serial-${setimpl}-1.3 {assignment, error} { + grammar::fa a + catch {a =} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_method= type selfns win self b"} + + +test fa-serial-${setimpl}-1.4 {assignment, error} { + grammar::fa a + catch {a = a b} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_method= type selfns win self b"} + + +test fa-serial-${setimpl}-1.5 {assignment, error} { + grammar::fa a + catch {a -->} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_method--> type selfns win self b"} + +test fa-serial-${setimpl}-1.6 {assignment, error} { + grammar::fa a + catch {a --> a b} msg + a destroy + set msg +} {wrong # args: should be "::grammar::fa::Snit_method--> type selfns win self b"} + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +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}} + } elseif {[string match xy* $code]} { + set sets {{} x y {x y}} + } elseif {[string match x* $code]} { + set sets {{} x} + } else { + set sets {{}} + } + + foreach st $sets { + foreach fin $sets { + set key $n.$code.([join $st {}],[join $fin {}]) + + test fa-serial-${setimpl}-2.$key {serialize} { + grammar::fa a + gen $code + foreach s $st {if {[a state exists $s]} {a start add $s}} + foreach s $fin {if {[a state exists $s]} {a final add $s}} + set res [validate_serial [a serialize] a] + a destroy + set res + } ok + + test fa-serial-${setimpl}-3.$key {deserialize} { + grammar::fa a + gen $code + foreach s $st {if {[a state exists $s]} {a start add $s}} + foreach s $fin {if {[a state exists $s]} {a final add $s}} + + grammar::fa b + b deserialize [a serialize] + set res [validate_serial [b serialize] a] + lappend res [validate_serial [a serialize] b] + + a destroy + b destroy + set res + } {ok ok} + + test fa-serial-${setimpl}-4.$key {assignment} { + grammar::fa a + gen $code + foreach s $st {if {[a state exists $s]} {a start add $s}} + foreach s $fin {if {[a state exists $s]} {a final add $s}} + + grammar::fa b + b = a + set res [validate_serial [b serialize] a] + lappend res [validate_serial [a serialize] b] + + a destroy + b destroy + set res + } {ok ok} + + test fa-serial-${setimpl}-5.$key {reverse assignment} { + grammar::fa a + gen $code + foreach s $st {if {[a state exists $s]} {a start add $s}} + foreach s $fin {if {[a state exists $s]} {a final add $s}} + + grammar::fa b + a --> b + set res [validate_serial [b serialize] a] + lappend res [validate_serial [a serialize] b] + + a destroy + b destroy + set res + } {ok ok} + + foreach op {= := <-- as} { + test fa-serial-${setimpl}-6.$key.$op {construction from fa} { + grammar::fa a + gen $code + foreach s $st {if {[a state exists $s]} {a start add $s}} + foreach s $fin {if {[a state exists $s]} {a final add $s}} + + grammar::fa b $op a + set res [validate_serial [b serialize] a] + lappend res [validate_serial [a serialize] b] + + a destroy + b destroy + set res + } {ok ok} + } + + test fa-serial-${setimpl}-7.$key {construction from fa} { + grammar::fa a + gen $code + foreach s $st {if {[a state exists $s]} {a start add $s}} + foreach s $fin {if {[a state exists $s]} {a final add $s}} + + grammar::fa b deserialize [a serialize] + set res [validate_serial [b serialize] a] + lappend res [validate_serial [a serialize] b] + + a destroy + b destroy + set res + } {ok ok} + } + } +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_start.test b/tcllib/modules/grammar_fa/tests/fa_start.test new file mode 100644 index 0000000..bc12f1c --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_start.test @@ -0,0 +1,386 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_start.test,v 1.6 2009/10/27 21:17:23 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-start-${setimpl}-1.0 {start states, error} { + grammar::fa a + catch {a startstates x} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodstartstates type selfns win self"} + + +test fa-start-${setimpl}-1.1 {start query, error} { + grammar::fa a + catch {a start?} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodstart? type selfns win self s"} + + +test fa-start-${setimpl}-1.2 {start query, error} { + grammar::fa a + catch {a start? x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodstart? type selfns win self s"} + + +test fa-start-${setimpl}-1.3 {start query, error} { + grammar::fa a + catch {a start? x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-start-${setimpl}-1.4 {start query set, error} { + grammar::fa a + catch {a start?set} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodstart?set type selfns win self states"} + + +test fa-start-${setimpl}-1.5 {start query set, error} { + grammar::fa a + catch {a start?set x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodstart?set type selfns win self states"} + + +test fa-start-${setimpl}-1.6 {start query set, error} { + grammar::fa a + catch {a start?set x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-start-${setimpl}-1.7 {start query set, error} { + grammar::fa a + a state add x + catch {a start?set {x y}} res + a destroy + set res +} {Illegal state "y"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-start-${setimpl}-2.0 {start, error} { + grammar::fa a + catch {a start} res + a destroy + set res +} {wrong number args: should be "::a start method args"} +# [tcltest::wrongNumArgs ::grammar::fa::Snit_methodstart {type selfns win self cmd args} 5] + + +test fa-start-${setimpl}-2.1 {start, error} { + grammar::fa a + catch {a start foo} res + a destroy + set res +} {"::a start foo" is not defined} + + +test fa-start-${setimpl}-2.2 {start, error} { + grammar::fa a + catch {a start add} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodstart_add {type selfns win self state args} 5] + +test fa-start-${setimpl}-2.3 {start, error} { + grammar::fa a + catch {a start add x y} res + a destroy + set res +} {Illegal state "x"} + + +test fa-start-${setimpl}-2.4 {start, error} { + grammar::fa a + catch {a start add x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-start-${setimpl}-2.5 {start states} { + grammar::fa a + catch {a start remove} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodstart_remove {type selfns win self state args} 5] + + +test fa-start-${setimpl}-2.6 {start states} { + grammar::fa a + catch {a start remove x y} res + a destroy + set res +} {Illegal state "x"} + + +test fa-start-${setimpl}-2.7 {start states} { + grammar::fa a + catch {a start remove x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-start-${setimpl}-2.8 {start states} { + grammar::fa a + catch {a start set} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodstart_set {type selfns win self states} 4] + + +test fa-start-${setimpl}-2.9 {start states} { + grammar::fa a + a state add x + catch {a start set {x y}} res + a destroy + set res +} {Illegal state "y"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-start-${setimpl}-3.0 {start states, empty fa} { + grammar::fa a + set res [a startstates] + a destroy + set res +} {} + + +test fa-start-${setimpl}-3.1 {start states, plain state} { + grammar::fa a + a state add x + set res [a startstates] + a destroy + set res +} {} + + +test fa-start-${setimpl}-3.2 {start states, state addition} { + grammar::fa a + a state add x + a start add x + set res [a startstates] + a destroy + set res +} x + + +test fa-start-${setimpl}-3.3 {start states, state addition} { + grammar::fa a + a state add x y + a start add x y + set res [lsort [a startstates]] + a destroy + set res +} {x y} + + +test fa-start-${setimpl}-3.4 {start states, state addition, and remova;} { + grammar::fa a + a state add x y + a start add x y + set res {} + lappend res [a startstates] + a start remove y + lappend res [a startstates] + a start remove x + lappend res [a startstates] + a destroy + set res +} {{x y} x {}} + + +test fa-start-${setimpl}-3.5 {start states, state addition, and remova;} { + grammar::fa a + a state add x y + a start add x y + set res {} + lappend res [a startstates] + a state delete y + lappend res [a startstates] + a state delete x + lappend res [a startstates] + a destroy + set res +} {{x y} x {}} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-start-${setimpl}-4.0 {start?} { + grammar::fa a + a state add x + set res [a start? x] + a destroy + set res +} 0 + + +test fa-start-${setimpl}-4.1 {start?} { + grammar::fa a + a state add x + a start add x + set res [a start? x] + a destroy + set res +} 1 + + +test fa-start-${setimpl}-4.2 {start?} { + grammar::fa a + a state add x + a start add x + set res [a start? x] + a start remove x + lappend res [a start? x] + a destroy + set res +} {1 0} + + +test fa-start-${setimpl}-4.3 {start?} { + grammar::fa a + a state add x + a start add x + set res [a start? x] + a state delete x + catch {a start? x} msg + lappend res $msg + a destroy + set res +} {1 {Illegal state "x"}} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-start-${setimpl}-5.0 {start?set} { + grammar::fa a + a state add x + set res [a start?set x] + a destroy + set res +} 0 + + +test fa-start-${setimpl}-5.1 {start?set} { + grammar::fa a + a state add x + a start add x + set res [a start?set x] + a destroy + set res +} 1 + + +test fa-start-${setimpl}-5.2 {start?set} { + grammar::fa a + set res {} + a state add x + a start add x + lappend res [a start?set x] + a start remove x + lappend res [a start?set x] + a destroy + set res +} {1 0} + + +test fa-start-${setimpl}-5.3 {start?set} { + grammar::fa a + set res {} + a state add x y + a start add x + lappend res [a start?set y] + lappend res [a start?set {x y}] + a destroy + set res +} {0 1} + + +test fa-start-${setimpl}-5.4 {start?set} { + grammar::fa a + a state add x + set res {} + lappend res [a start? x] + lappend res [a start remove x] + lappend res [a start? x] + a destroy + set res +} {0 {} 0} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +test fa-start-${setimpl}-6.0 {start clear} { + grammar::fa a + a state add x + a start add x + set res {} + lappend res [a startstates] + a start clear + lappend res [a startstates] + a destroy + set res +} {x {}} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +test fa-start-${setimpl}-7.0 {start set} { + grammar::fa a + a state add x + a start set x + set res [a startstates] + a destroy + set res +} x + + +test fa-start-${setimpl}-7.1 {start set} { + grammar::fa a + a state add x y + a start set {x y} + set res [lsort [a startstates]] + a destroy + set res +} {x y} + + +test fa-start-${setimpl}-7.2 {start set} { + grammar::fa a + set res {} + a state add x y z + a start add z + lappend res [a startstates] + a start set {x y} + lappend res [lsort [a startstates]] + a destroy + set res +} {z {x y}} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_state.test b/tcllib/modules/grammar_fa/tests/fa_state.test new file mode 100644 index 0000000..d752b72 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_state.test @@ -0,0 +1,304 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_state.test,v 1.8 2009/10/27 21:17:23 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-state-${setimpl}-1.0 {state, error} { + grammar::fa a + catch {a state} res + a destroy + set res +} {wrong number args: should be "::a state method args"} +# [tcltest::wrongNumArgs {::a state method} {args} 0] + + +test fa-state-${setimpl}-1.1 {state, error} { + grammar::fa a + catch {a state add} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodstate_add {type selfns win self s args} 4] + + +test fa-state-${setimpl}-1.2 {state, error} { + grammar::fa a + a state add x + catch {a state foo x} res + a destroy + set res +} {"::a state foo" is not defined} + + +test fa-state-${setimpl}-1.3 {state, error} { + grammar::fa a + a state add x + catch {a state add x} res + a destroy + set res +} {State "x" is already known} + + +test fa-state-${setimpl}-1.4 {state, error} { + grammar::fa a + catch {a state exists} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodstate_exists {type selfns win self s} 4] + + +test fa-state-${setimpl}-1.5 {state, error} { + grammar::fa a + catch {a state exists a b} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_hmethodstate_exists type selfns win self s"} + + +test fa-state-${setimpl}-1.6 {state, error} { + grammar::fa a + catch {a state delete} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodstate_delete {type selfns win self s args} 4] + + +test fa-state-${setimpl}-1.7 {state, error} { + grammar::fa a + catch {a state delete x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-state-${setimpl}-1.8 {state, error} { + grammar::fa a + catch {a state rename} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodstate_rename {type selfns win self s snew} 0] + + +test fa-state-${setimpl}-1.9 {state, error} { + grammar::fa a + catch {a state rename foo} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodstate_rename {type selfns win self s snew} 1] + + +test fa-state-${setimpl}-1.10 {state, error} { + grammar::fa a + catch {a state rename x y} res + a destroy + set res +} {Illegal state "x"} + + +test fa-state-${setimpl}-1.11 {state, error} { + grammar::fa a + a state add x y + catch {a state rename x y} res + a destroy + set res +} {State "y" is already known} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-state-${setimpl}-2.0 {state add} { + grammar::fa a + set res [a state add x] + a destroy + set res +} {} + + +test fa-state-${setimpl}-2.1 {state add, variadic} { + grammar::fa a + set res [a state add x y] + a destroy + set res +} {} + + +test fa-state-${setimpl}-2.2 {state add / states / exists} { + grammar::fa a + a state add x + set res [a states] + lappend res [a state exists x] + lappend res [a state exists y] + a destroy + set res +} {x 1 0} + + +test fa-state-${setimpl}-2.3 {state add / states / exists} { + grammar::fa a + a state add x y + set res {} + lappend res [lsort [a states]] + lappend res [a state exists x] + lappend res [a state exists y] + a destroy + set res +} {{x y} 1 1} + + +test fa-state-${setimpl}-2.4 {state add, basic properties} { + grammar::fa a + a state add x + set res {} + lappend res [a final? x] + lappend res [a start? x] + lappend res [a symbols@ x] + a destroy + set res +} {0 0 {}} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +test fa-state-${setimpl}-3.0 {state delete} { + grammar::fa a + a state add x + set res [a states] + lappend res [a state exists x] + a state delete x + lappend res [a states] + lappend res [a state exists x] + a destroy + set res +} {x 1 {} 0} + +test fa-state-${setimpl}-3.1 {state delete, variadic} { + grammar::fa a + a state add x y + set res {} + lappend res [lsort [a states]] + lappend res [a state exists x] + lappend res [a state exists y] + a state delete x y + lappend res [a states] + lappend res [a state exists x] + lappend res [a state exists y] + a destroy + set res +} {{x y} 1 1 {} 0 0} + +test fa-state-${setimpl}-3.2 {state delete, loop} { + grammar::fa a + a state add a + a symbol add @ + a next a @ --> a + a state delete a + a destroy +} {} + +test fa-state-${setimpl}-3.3 {state delete, inbound transition} { + grammar::fa a + gen xyz!-= + set res [a next x @] + a state delete y + lappend res [a next x @] + a destroy + set res +} {y {}} + + +test fa-state-${setimpl}-3.4 {state delete, outbound transition} { + grammar::fa a + gen xy- + a state delete x + a state delete y + a symbol delete @ + a destroy + set res {} +} {} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-state-${setimpl}-4.0 {state, exists} { + grammar::fa a + set res [a state exists x] + a destroy + set res +} 0 + + +test fa-state-${setimpl}-4.1 {state, exists} { + grammar::fa a + a state add x + set res [a state exists x] + a destroy + set res +} 1 + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-state-${setimpl}-5.4 {state rename} { + grammar::fa a + a state add x y + a state rename x z + set res [a serialize] + a destroy + set res +} {grammar::fa {} {z {0 0 {}} y {0 0 {}}}} + + +test fa-state-${setimpl}-5.5 {state rename} { + grammar::fa a + a state add x y + a state rename y z + set res [a serialize] + a destroy + set res +} {grammar::fa {} {x {0 0 {}} z {0 0 {}}}} + + +test fa-state-${setimpl}-5.6 {state rename} { + grammar::fa a + a state add x y + a symbol add @ + a next x @ --> y + a state rename x z + set res [a serialize] + a destroy + set res +} {grammar::fa @ {z {0 0 {@ y}} y {0 0 {}}}} + + +test fa-state-${setimpl}-5.7 {state rename} { + grammar::fa a + a state add x y + a symbol add @ + a next x @ --> y + a state rename y z + set res [a serialize] + a destroy + set res +} {grammar::fa @ {x {0 0 {@ z}} z {0 0 {}}}} + + +test fa-state-${setimpl}-6.0 {state rename with loop, SF bug 2595296} { + grammar::fa a + a state add x + a symbol add @ + a next x @ --> x + a state rename x y + set res [a serialize] + a destroy + set res +} {grammar::fa @ {y {0 0 {@ y}}}} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_states.test b/tcllib/modules/grammar_fa/tests/fa_states.test new file mode 100644 index 0000000..788993c --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_states.test @@ -0,0 +1,76 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_states.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-states-${setimpl}-1.0 {states, argument errors} { + grammar::fa a + catch {a states x} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodstates type selfns win self"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-states-${setimpl}-2.0 {states, empty fa} { + grammar::fa a + set res [a states] + a destroy + set res +} {} + +test fa-states-${setimpl}-2.1 {states, state addition} { + grammar::fa a + a state add x + set res [a states] + a destroy + set res +} x + +test fa-states-${setimpl}-2.2 {states, state addition} { + grammar::fa a + a state add x y + set res [lsort [a states]] + a destroy + set res +} {x y} + + +test fa-states-${setimpl}-2.3 {states, state addition and removal} { + grammar::fa a + a state add x y + a state delete x + set res [a states] + a destroy + set res +} y + + +test fa-states-${setimpl}-2.4 {states, state addition and removal} { + grammar::fa a + a state add x y + a state delete y + set res [a states] + a destroy + set res +} x + + +test fa-states-${setimpl}-2.5 {states, state addition and removal} { + grammar::fa a + a state add x y + a state delete x y + set res [a states] + a destroy + set res +} {} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_symbol.test b/tcllib/modules/grammar_fa/tests/fa_symbol.test new file mode 100644 index 0000000..673baa5 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_symbol.test @@ -0,0 +1,254 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_symbol.test,v 1.7 2009/10/27 21:17:23 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-symbol-${setimpl}-1.0 {symbol, error} { + grammar::fa a + catch {a symbol} res + a destroy + set res +} {wrong number args: should be "::a symbol method args"} +# [tcltest::wrongNumArgs {::a symbol method} {sym args} 0] + + +test fa-symbol-${setimpl}-1.1 {symbol, error} { + grammar::fa a + catch {a symbol foo @} res + a destroy + set res +} {"::a symbol foo" is not defined} + + +test fa-symbol-${setimpl}-1.2 {symbol, error} { + grammar::fa a + catch {a symbol add} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodsymbol_add {type selfns win self sym args} 4] + + +test fa-symbol-${setimpl}-1.3 {symbol, error} { + grammar::fa a + a symbol add x + catch {a symbol add x} res + a destroy + set res +} {Symbol "x" is already known} + + +test fa-symbol-${setimpl}-1.4 {symbol, error} { + grammar::fa a + catch {a symbol add ""} res + a destroy + set res +} {Cannot add illegal empty symbol ""} + + +test fa-symbol-${setimpl}-1.5 {symbol, error} { + grammar::fa a + catch {a symbol delete} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodsymbol_delete {type selfns win self sym args} 4] + + +test fa-symbol-${setimpl}-1.6 {symbol, error} { + grammar::fa a + catch {a symbol delete @} res + a destroy + set res +} {Illegal symbol "@"} + + +test fa-symbol-${setimpl}-1.7 {symbol, error} { + grammar::fa a + catch {a symbol exists} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodsymbol_exists {type selfns win self sym} 4] + + +test fa-symbol-${setimpl}-1.8 {symbol, error} { + grammar::fa a + catch {a symbol exists a b} res + a destroy + set res +} [tcltest::tooManyArgs ::grammar::fa::Snit_hmethodsymbol_exists {type selfns win self sym}] + + +test fa-symbol-${setimpl}-1.9 {symbol, error} { + grammar::fa a + catch {a symbol rename} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodsymbol_rename {type selfns win self sym newsym} 4] + + +test fa-symbol-${setimpl}-1.10 {symbol, error} { + grammar::fa a + catch {a symbol rename foo} res + a destroy + set res +} [tcltest::wrongNumArgs ::grammar::fa::Snit_hmethodsymbol_rename {type selfns win self sym newsym} 5] + + +test fa-symbol-${setimpl}-1.11 {symbol, error} { + grammar::fa a + catch {a symbol rename foo bar snarf} res + a destroy + set res +} [tcltest::tooManyArgs ::grammar::fa::Snit_hmethodsymbol_rename {type selfns win self sym newsym}] + + +test fa-symbol-${setimpl}-1.12 {symbol, error} { + grammar::fa a + catch {a symbol rename x y} res + a destroy + set res +} {Illegal symbol "x"} + + +test fa-symbol-${setimpl}-1.13 {symbol, error} { + grammar::fa a + catch {a symbol rename "" y} res + a destroy + set res +} {Illegal symbol ""} + + +test fa-symbol-${setimpl}-1.14 {symbol, error} { + grammar::fa a + a symbol add x y + catch {a symbol rename x y} res + a destroy + set res +} {Symbol "y" is already known} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-symbol-${setimpl}-2.0 {symbol add} { + grammar::fa a + set res {} + lappend res [a symbol add x y] + lappend res [lsort [a symbols]] + a destroy + set res +} {{} {x y}} + + +test fa-symbol-${setimpl}-2.1 {symbol add} { + grammar::fa a + a symbol add x + set res [a symbols] + a destroy + set res +} x + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-symbol-${setimpl}-3.0 {symbol delete} { + grammar::fa a + a symbol add x + set res [a symbols] + lappend res [a symbol exists x] + a symbol delete x + lappend res [a symbols] + lappend res [a symbol exists x] + a destroy + set res +} {x 1 {} 0} + + +test fa-symbol-${setimpl}-3.1 {symbol delete, transitions} { + grammar::fa a + a state add x y + a symbol add @ + a next x @ --> y + + set res [a symbols] + lappend res [a symbol exists @] + a symbol delete @ + lappend res [a symbols] + lappend res [a symbol exists @] + lappend res [validate_serial {grammar::fa {} {x {0 0 {}} y {0 0 {}}}} a] + a destroy + set res +} {@ 1 {} 0 ok} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-symbol-${setimpl}-4.0 {symbol exists} { + grammar::fa a + set res [a symbol exists x] + a destroy + set res +} 0 + + +test fa-symbol-${setimpl}-4.1 {symbol exists} { + grammar::fa a + a symbol add x + set res [a symbol exists x] + a destroy + set res +} 1 + + +test fa-symbol-${setimpl}-4.2 {symbol exists} { + grammar::fa a + a symbol add x + set res [a symbol exists x] + a symbol delete x + lappend res [a symbol exists x] + a destroy + set res +} {1 0} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +test fa-symbol-${setimpl}-5.0 {symbol rename} { + grammar::fa a + a symbol add x y + a symbol rename x z + set res [validate_serial {grammar::fa {y z} {}} a] + a destroy + set res +} ok + + +test fa-symbol-${setimpl}-5.1 {symbol rename} { + grammar::fa a + a symbol add x y + a symbol rename y z + set res [validate_serial {grammar::fa {x z} {}} a] + a destroy + set res +} ok + + +test fa-symbol-${setimpl}-5.2 {symbol rename} { + grammar::fa a + a state add x y + a symbol add @ + a next x @ --> y + a symbol rename @ = + set res [validate_serial {grammar::fa = {x {0 0 {= y}} y {0 0 {}}}} a] + a destroy + set res +} ok + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_symbols.test b/tcllib/modules/grammar_fa/tests/fa_symbols.test new file mode 100644 index 0000000..06054b4 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_symbols.test @@ -0,0 +1,81 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_symbols.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-symbols-${setimpl}-1.0 {symbols, argument errors} { + grammar::fa a + catch {a symbols x} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodsymbols type selfns win self"} + + +test fa-symbols-${setimpl}-1.1 {symbol mgmt} { + grammar::fa a + catch {a symbols x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodsymbols type selfns win self"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-symbols-${setimpl}-2.0 {symbols, empty fa} { + grammar::fa a + set res [a symbols] + a destroy + set res +} {} + +test fa-symbols-${setimpl}-2.1 {symbols, symbol addition} { + grammar::fa a + a symbol add x + set res [a symbols] + a destroy + set res +} x + +test fa-symbols-${setimpl}-2.2 {symbols, symbol addition} { + grammar::fa a + a symbol add x y + set res [lsort [a symbols]] + a destroy + set res +} {x y} + +test fa-symbols-${setimpl}-2.3 {symbols, symbol addition and removal} { + grammar::fa a + a symbol add x y + a symbol delete x + set res [a symbols] + a destroy + set res +} y + +test fa-symbols-${setimpl}-2.4 {symbols, symbol addition and removal} { + grammar::fa a + a symbol add x y + a symbol delete y + set res [a symbols] + a destroy + set res +} x + +test fa-symbols-${setimpl}-2.5 {symbols, symbol addition and removal} { + grammar::fa a + a symbol add x y + a symbol delete x y + set res [a symbols] + a destroy + set res +} {} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_symbols_at.test b/tcllib/modules/grammar_fa/tests/fa_symbols_at.test new file mode 100644 index 0000000..0a9057f --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_symbols_at.test @@ -0,0 +1,138 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_symbols_at.test,v 1.6 2007/08/14 21:42:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-symbols-${setimpl}-at-1.0 {symbols@, error} { + grammar::fa a + catch {a symbols@} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodsymbols@ type selfns win self s ?t?"} + + +test fa-symbols-${setimpl}-at-1.1 {symbols@, error} { + grammar::fa a + catch {a symbols@ x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-symbols-${setimpl}-at-1.2 {symbols@, error} { + grammar::fa a + catch {a symbols@ x y z} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodsymbols@ type selfns win self s ?t?"} + + +test fa-symbols-${setimpl}-at-1.3 {symbols@set, error} { + grammar::fa a + catch {a symbols@set} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodsymbols@set type selfns win self states"} + + +test fa-symbols-${setimpl}-at-1.4 {symbols@set, error} { + grammar::fa a + catch {a symbols@set x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodsymbols@set type selfns win self states"} + + +test fa-symbols-${setimpl}-at-1.5 {symbols@set, error} { + grammar::fa a + catch {a symbols@set x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-symbols-${setimpl}-at-1.6 {symbols@set, error} { + grammar::fa a + a state add y + catch {a symbols@set {y x}} res + a destroy + set res +} {Illegal state "x"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +foreach {n code setup_result} { + 00 x {x {}} + 01 x- {x @} + 02 xe {x {{}}} + 03 xy {x {} y {}} + 04 xy- {x @ y {}} + 05 xye {x {{}} y {}} + 06 xyee {x {{}} y {{}}} + 07 xye- {x {{}} y @} + 08 xy-- {x @ y @} + 09 xy-= {x @ y =} + 10 xyz/ee {x {{}} y {} z {}} + 11 xyz/e- {x {{} @} y {} z {}} + 12 xyz/-- {x @ y {} z {}} + 13 xyz/-= {x {= @} y {} z {}} + 14 xyz|ee {x {{}} y {{}} z {}} + 15 xyz|e- {x @ y {{}} z {}} + 16 xyz|-- {x @ y @ z {}} + 17 xyz|-= {x @ y = z {}} + 18 xyz+eee {x {{}} y {{}} z {{}}} + 19 xyz+ee- {x {{}} y {{}} z @} + 20 xyz+e-- {x {{}} y @ z @} + 21 xyz+e-= {x {{}} y @ z =} + 22 xyz+--- {x @ y @ z @} + 23 xyz+--= {x @ y @ z =} + 24 xyz+-=_ {x @ y = z %} + 25 xyz&eee {x {{}} y {{}} z {}} + 26 xyz&ee- {x {{}} y @ z {}} + 27 xyz&e-- {x {{} @} y @ z {}} + 28 xyz&e-= {x {{} @} y = z {}} + 29 xyz&--- {x @ y @ z {}} + 30 xyz&--= {x @ y = z {}} + 31 xyz&-=_ {x {= @} y % z {}} + 32 xyz!ee {x {{}} y {{}} z {}} + 33 xyz!e- {x {{}} y @ z {}} + 34 xyz!-- {x @ y @ z {}} + 35 xyz!-= {x @ y = z {}} + 36 xyz!-e {x @ y {{}} z {}} +} { + foreach {state expected} $setup_result { + set key ${n}.$code.$state + + test fa-symbols-${setimpl}-at-2.$key {symbols@} { + grammar::fa a + gen $code + set res [lsort [a symbols@ $state]] + a destroy + set res + } $expected ; # {} + } +} + +foreach {n code setup_result} { +} { + foreach {states expected} $setup_result { + set key ${n}.$code.[join $states {}] + + test fa-symbols-${setimpl}-at-3.$key {symbols@set} { + grammar::fa a + gen $code + set res [lsort [a symbols@set $states]] + a destroy + set res + } $expected ; # {} + } +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/fa_useful.test b/tcllib/modules/grammar_fa/tests/fa_useful.test new file mode 100644 index 0000000..131740a --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/fa_useful.test @@ -0,0 +1,344 @@ +# -*- tcl -*- +# finite_automaton.test: tests for the grammar::fa container. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: fa_useful.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test fa-useful-${setimpl}-1.0 {usefulness} { + grammar::fa a + catch {a useful_states x} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methoduseful_states type selfns win self"} + + +test fa-useful-${setimpl}-1.1 {!usefulness} { + grammar::fa a + catch {a unuseful_states a} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methodunuseful_states type selfns win self"} + + +test fa-useful-${setimpl}-1.2 {usefulness} { + grammar::fa a + catch {a useful} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methoduseful type selfns win self s"} + + +test fa-useful-${setimpl}-1.3 {usefulness} { + grammar::fa a + catch {a useful x} res + a destroy + set res +} {Illegal state "x"} + + +test fa-useful-${setimpl}-1.4 {usefulness} { + grammar::fa a + catch {a useful x y} res + a destroy + set res +} {wrong # args: should be "::grammar::fa::Snit_methoduseful type selfns win self s"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-useful-${setimpl}-2.0 {useful states, empty fa} { + grammar::fa a + set res [a useful_states] + a destroy + set res +} {} + + +test fa-useful-${setimpl}-2.1 {useful states, state addition, plain} { + grammar::fa a + a state add x + set res [a useful_states] + a destroy + set res +} {} + +test fa-useful-${setimpl}-2.2 {useful states, state addition, final} { + grammar::fa a + a state add x + a final add x + set res [a useful_states] + a destroy + set res +} x + + +test fa-useful-${setimpl}-2.3 {useful states, state addition, start} { + grammar::fa a + a state add x + a start add x + set res [a useful_states] + a destroy + set res +} {} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +test fa-useful-${setimpl}-3.0 {unuseful states, empty fa} { + grammar::fa a + set res [a unuseful_states] + a destroy + set res +} {} + + +test fa-useful-${setimpl}-3.1 {unuseful states, state addition, plain} { + grammar::fa a + a state add x + set res [a unuseful_states] + a destroy + set res +} x + +test fa-useful-${setimpl}-3.2 {unuseful states, state addition, final} { + grammar::fa a + a state add x + a final add x + set res [a unuseful_states] + a destroy + set res +} {} + + +test fa-useful-${setimpl}-3.3 {unuseful states, state addition, start} { + grammar::fa a + a state add x + a start add x + set res [a unuseful_states] + a destroy + set res +} x + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code setup_result} { + 00 x {{} {} x x x {}} + 01 x- {{} {} x x x {}} + 02 xe {{} {} x x x {}} + 03 xy {{} {} {x y} x x y y y x {x y} {x y} {}} + 04 xy- {{} {} {x y} x x y y {x y} {} {x y} {x y} {}} + 05 xye {{} {} {x y} x x y y {x y} {} {x y} {x y} {}} + 06 xyee {{} {} {x y} x {x y} {} y {x y} {} {x y} {x y} {}} + 07 xye- {{} {} {x y} x {x y} {} y {x y} {} {x y} {x y} {}} + 08 xy-- {{} {} {x y} x {x y} {} y {x y} {} {x y} {x y} {}} + 09 xy-= {{} {} {x y} x {x y} {} y {x y} {} {x y} {x y} {}} + 10 xyz/ee { + {} {} {x y z} x x {y z} + y {x y} z z {x z} y + {x y} {x y} z {x z} {x z} y + {y z} {x y z} {} {x y z} {x y z} {} + } + 11 xyz/e- { + {} {} {x y z} x x {y z} + y {x y} z z {x z} y + {x y} {x y} z {x z} {x z} y + {y z} {x y z} {} {x y z} {x y z} {} + } + 12 xyz/-- { + {} {} {x y z} x x {y z} + y {x y} z z {x z} y + {x y} {x y} z {x z} {x z} y + {y z} {x y z} {} {x y z} {x y z} {} + } + 13 xyz/-= { + {} {} {x y z} x x {y z} + y {x y} z z {x z} y + {x y} {x y} z {x z} {x z} y + {y z} {x y z} {} {x y z} {x y z} {} + } + 14 xyz|ee { + {} {} {x y z} x x {y z} + y y {x z} z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 15 xyz|e- { + {} {} {x y z} x x {y z} + y y {x z} z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 16 xyz|-- { + {} {} {x y z} x x {y z} + y y {x z} z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 17 xyz|-= { + {} {} {x y z} x x {y z} + y y {x z} z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 18 xyz+eee { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 19 xyz+ee- { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 20 xyz+e-- { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 21 xyz+e-= { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 22 xyz+--- { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 23 xyz+--= { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 24 xyz+-=_ { + {} {} {x y z} x {x y z} {} + y {x y z} {} z {x y z} {} + {x y} {x y z} {} {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 25 xyz&eee { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 26 xyz&ee- { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 27 xyz&e-- { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 28 xyz&e-= { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 29 xyz&--- { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 30 xyz&--= { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 31 xyz&-=_ { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 32 xyz!ee { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 33 xyz!e- { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 34 xyz!-- { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 35 xyz!-= { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } + 36 xyz!-e { + {} {} {x y z} x x {y z} + y {x y} z z {x y z} {} + {x y} {x y} z {x z} {x y z} {} + {y z} {x y z} {} {x y z} {x y z} {} + } +} { + foreach {fset useful unuse} $setup_result { + set key ${n}.${code}.([join $fset {}]) + set expected {} + foreach x $useful {lappend expected 1} + foreach x $unuse {lappend expected 0} + + test fa-useful-${setimpl}-4.$key {useful states} { + grammar::fa a + gen $code + a final set $fset + set res [lsort [a useful_states]] + a destroy + set res + } $useful ; # {} + + test fa-useful-${setimpl}-5.$key {!useful states} { + grammar::fa a + gen $code + a final set $fset + set res [lsort [a unuseful_states]] + a destroy + set res + } $unuse ; # {} + + test fa-useful-${setimpl}-6.$key {usefulness testing} { + grammar::fa a + gen $code + a final set $fset + set res {} + foreach x $useful {lappend res [a useful $x]} + foreach x $unuse {lappend res [a useful $x]} + a destroy + set res + } $expected ; # {} + } +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_complete.test b/tcllib/modules/grammar_fa/tests/faop_complete.test new file mode 100644 index 0000000..ff87a9d --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_complete.test @@ -0,0 +1,107 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_complete.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-complete-${setimpl}-1.0 {complete, error} { + catch {grammar::fa::op::complete} res + set res +} {wrong # args: should be "grammar::fa::op::complete fa ?sink?"} + + +test faop-complete-${setimpl}-1.1 {complete, error} { + catch {grammar::fa::op::complete a b c} res + set res +} {wrong # args: should be "grammar::fa::op::complete fa ?sink?"} + + +test faop-complete-${setimpl}-1.2 {complete, error} { + catch {grammar::fa::op::complete a} res + set res +} {invalid command name "a"} + + +test faop-complete-${setimpl}-1.3 {complete, error} { + grammar::fa a + a state add sink x + a symbol add @ + catch {grammar::fa::op::complete a sink} res + a destroy + set res +} {The chosen sink state exists already} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code result} { + 00 x {grammar::fa {} {x {0 0 {}}}} + 01 x- {grammar::fa @ {x {0 0 {@ x}}}} + 02 xe {grammar::fa {} {x {0 0 {{} x}}}} + 03 xy {grammar::fa {} {x {0 0 {}} y {0 0 {}}}} + 04 xy- {grammar::fa @ {x {0 0 {@ y}} y {0 0 {@ sink}} sink {0 0 {@ sink}}}} + 05 xye {grammar::fa {} {x {0 0 {{} y}} y {0 0 {}}}} + 06 xyee {grammar::fa {} {x {0 0 {{} y}} y {0 0 {{} x}}}} + 07 xyz/ee {grammar::fa {} {x {0 0 {{} {y z}}} y {0 0 {}} z {0 0 {}}}} + 08 xyz/-= {grammar::fa {@ =} {x {0 0 {@ y = z}} y {0 0 {@ sink = sink}} z {0 0 {@ sink = sink}} sink {0 0 {@ sink = sink}}}} + 09 xyz|ee {grammar::fa {} {x {0 0 {{} z}} y {0 0 {{} z}} z {0 0 {}}}} + 10 xyz|-= {grammar::fa {@ =} {x {0 0 {@ z = sink}} y {0 0 {@ sink = z}} z {0 0 {@ sink = sink}} sink {0 0 {@ sink = sink}}}} + 11 xyz+eee {grammar::fa {} {x {0 0 {{} y}} y {0 0 {{} z}} z {0 0 {{} x}}}} + 12 xyz+-=_ {grammar::fa {@ % =} {x {0 0 {@ y % sink = sink}} y {0 0 {@ sink % sink = z}} z {0 0 {@ sink = sink % x}} sink {0 0 {@ sink = sink % sink}}}} + 13 xyz&eee {grammar::fa {} {x {0 0 {{} {y z}}} y {0 0 {{} z}} z {0 0 {}}}} + 14 xyz&-=_ {grammar::fa {@ % =} {x {0 0 {@ y % sink = z}} y {0 0 {@ sink = sink % z}} z {0 0 {@ sink = sink % sink}} sink {0 0 {@ sink = sink % sink}}}} + 15 xyz!ee {grammar::fa {} {x {0 0 {{} y}} y {0 0 {{} z}} z {0 0 {}}}} + 16 xyz!-= {grammar::fa {@ % =} {x {0 0 {@ y % sink = sink}} y {0 0 {@ sink % sink = z}} z {0 0 {@ sink = sink % sink}} sink {0 0 {@ sink = sink % sink}}}} +} { + set key ${n}.${code} + + test faop-complete-${setimpl}-2.$key {complete} { + grammar::fa a + gen $code + grammar::fa::op::complete a sink + set res [a is complete] + lappend res [validate_serial $result a] + a destroy + set res + } {1 ok} + + test faop-complete-${setimpl}-3.$key {second complete is a null operation} { + grammar::fa a + gen $code + grammar::fa::op::complete a + set res [a serialize] + grammar::fa::op::complete a + set res [validate_serial $res a] + a destroy + set res + } ok + + test faop-complete-${setimpl}-4.$key {complete, as method} { + grammar::fa a + gen $code + a complete sink + set res [a is complete] + lappend res [validate_serial $result a] + a destroy + set res + } {1 ok} + + test faop-complete-${setimpl}-5.$key {as method, second complete is a null operation} { + grammar::fa a + gen $code + a complete + set res [a serialize] + a complete + set res [validate_serial $res a] + a destroy + set res + } ok +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_concat.test b/tcllib/modules/grammar_fa/tests/faop_concat.test new file mode 100644 index 0000000..ad2b422 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_concat.test @@ -0,0 +1,113 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_concat.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-concat-${setimpl}-1.0 {concat, error} { + catch {grammar::fa::op::concatenate} res + set res +} {wrong # args: should be "grammar::fa::op::concatenate fa fb ?mapvar?"} + + +test faop-concat-${setimpl}-1.1 {concat, error} { + catch {grammar::fa::op::concatenate a b c d} res + set res +} {wrong # args: should be "grammar::fa::op::concatenate fa fb ?mapvar?"} + + +test faop-concat-${setimpl}-1.2 {concat, error} { + catch {grammar::fa::op::concatenate a b} res + set res +} {invalid command name "a"} + + +test faop-concat-${setimpl}-1.3 {concat, error} { + grammar::fa a + catch {grammar::fa::op::concatenate a b} res + a destroy + set res +} {invalid command name "b"} + + +test faop-concat-${setimpl}-1.4 {concat, error} { + grammar::fa a + grammar::fa b + catch {grammar::fa::op::concatenate a b} res + a destroy + b destroy + set res +} {Unable to concatenate FAs without start/final states} + + +test faop-concat-${setimpl}-1.5 {concat, error} { + grammar::fa a + grammar::fa b + a state add x + a start add x + catch {grammar::fa::op::concatenate a b} res + a destroy + b destroy + set res +} {Unable to concatenate FAs without start/final states} + + +test faop-concat-${setimpl}-1.6 {concat, error} { + grammar::fa a + grammar::fa b + a state add x + a final add x + catch {grammar::fa::op::concatenate a b} res + a destroy + b destroy + set res +} {Unable to concatenate FAs without start/final states} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n fa fb fres rmap} { + 0 + {grammar::fa @ {x {1 0 {@ y}} y {0 1 {}}}} + {grammar::fa = {u {1 0 {= v}} v {0 1 {}}}} + {grammar::fa {= @} {x {0 0 {@ y}} y {0 0 {{} m.0}} u {0 0 {= v}} v {0 0 {{} f.0}} s.0 {1 0 {{} x}} f.0 {0 1 {}} m.0 {0 0 {{} u}}}} + {} + + 1 + {grammar::fa @ {x {1 0 {@ y}} y {0 1 {}}}} + {grammar::fa = {x {1 0 {= y}} y {0 1 {}}}} + {grammar::fa {= @} {x {0 0 {@ y}} y {0 0 {{} m.0}} 0 {0 0 {= 1}} 1 {0 0 {{} f.0}} s.0 {1 0 {{} x}} f.0 {0 1 {}} m.0 {0 0 {{} 0}}}} + {0 x 1 y} +} { + set key ${n} + + test faop-concat-${setimpl}-2.$key {concat} { + grammar::fa a deserialize $fa + grammar::fa b deserialize $fb + grammar::fa::op::concatenate a b map + set res [validate_serial $fres a] + lappend res [string equal $rmap [dictsort $map]] + a destroy + b destroy + set res + } {ok 1} + + test faop-concat-${setimpl}-3.$key {concat, as method} { + grammar::fa a deserialize $fa + grammar::fa b deserialize $fb + a concatenate b map + set res [validate_serial $fres a] + lappend res [string equal $rmap [dictsort $map]] + a destroy + b destroy + set res + } {ok 1} +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_determinize.test b/tcllib/modules/grammar_fa/tests/faop_determinize.test new file mode 100644 index 0000000..4daaeed --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_determinize.test @@ -0,0 +1,117 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_determinize.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-determinize-${setimpl}-1.0 {determinize, error} { + catch {grammar::fa::op::determinize} res + set res +} {wrong # args: should be "grammar::fa::op::determinize fa ?mapvar? ?idstart?"} + + +test faop-determinize-${setimpl}-1.1 {determinize, error} { + catch {grammar::fa::op::determinize a b c d} res + set res +} {wrong # args: should be "grammar::fa::op::determinize fa ?mapvar? ?idstart?"} + + +test faop-determinize-${setimpl}-1.2 {determinize, error} { + catch {grammar::fa::op::determinize a} res + set res +} {invalid command name "a"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code st fin mapres result} { + 00 datom x y {} + {grammar::fa @ {x {1 0 {@ y}} y {0 1 {}}}} + + 01 dalt u z {0 {u v w} 1 {y z} 2 {x z}} + {grammar::fa {@ =} {0 {1 0 {@ 2 = 1}} 1 {0 1 {}} 2 {0 1 {}}}} + + 02 dopt u x {0 {u v x} 1 {w x}} + {grammar::fa @ {0 {1 1 {@ 1}} 1 {0 1 {}}}} + + 03 drep u x {0 {u v x} 1 {u v w x}} + {grammar::fa @ {0 {1 1 {@ 1}} 1 {0 1 {@ 1}}}} +} { + set key ${n}.${code} + + test faop-determinize-${setimpl}-2.$key {determinize, bounded} { + grammar::fa a + gen $code + a start add $st + a final add $fin + grammar::fa::op::determinize a map + set res [validate_serial $result a] + lappend res [string equal $mapres [dictsort $map]] + lappend res [a is deterministic] + a destroy + set res + } {ok 1 1} + + test faop-determinize-${setimpl}-3.$key {determinize, bounded, as method} { + grammar::fa a + gen $code + a start add $st + a final add $fin + a determinize map + set res [validate_serial $result a] + lappend res [string equal $mapres [dictsort $map]] + lappend res [a is deterministic] + a destroy + set res + } {ok 1 1} +} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code mapres result} { + 00 datom {0 x 1 y} + {grammar::fa @ {0 {0 0 {@ 1}} 1 {0 0 {}}}} + + 01 dalt {0 x 1 y 2 u 3 z 4 v 5 w 6 {y z} 7 {x z}} + {grammar::fa {@ =} {0 {0 0 {}} 1 {0 0 {}} 2 {0 0 {@ 7 = 6}} 3 {0 0 {}} 4 {0 0 {@ 7}} 5 {0 0 {= 6}} 6 {0 0 {}} 7 {0 0 {}}}} + + 02 dopt {0 x 1 u 2 v 3 w 4 {w x}} + {grammar::fa @ {0 {0 0 {}} 1 {0 0 {@ 4}} 2 {0 0 {@ 4}} 3 {0 0 {}} 4 {0 0 {}}}} + + 03 drep {0 x 1 u 2 v 3 w 4 {u v w x}} + {grammar::fa @ {0 {0 0 {@ 4}} 1 {0 0 {@ 4}} 2 {0 0 {@ 4}} 3 {0 0 {@ 4}} 4 {0 0 {@ 4}}}} +} { + set key ${n}.${code} + + test faop-determinize-${setimpl}-4.$key {determinize, unbounded} { + grammar::fa a + gen $code + grammar::fa::op::determinize a map + set res [validate_serial $result a] + lappend res [string equal $mapres [dictsort $map]] + lappend res [a is deterministic] ; # Never formally det, because of missing start. + a destroy + set res + } {ok 1 0} + + test faop-determinize-${setimpl}-5.$key {determinize, unbounded, as method} { + grammar::fa a + gen $code + a determinize map + set res [validate_serial $result a] + lappend res [string equal $mapres [dictsort $map]] + lappend res [a is deterministic] ; # Never formally det, because of missing start. + a destroy + set res + } {ok 1 0} +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_difference.test b/tcllib/modules/grammar_fa/tests/faop_difference.test new file mode 100644 index 0000000..8c3f1f0 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_difference.test @@ -0,0 +1,110 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_difference.test,v 1.6 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-difference-${setimpl}-1.0 {difference, error} { + catch {grammar::fa::op::difference} res + set res +} {wrong # args: should be "grammar::fa::op::difference fa fb ?mapvar?"} + + +test faop-difference-${setimpl}-1.1 {difference, error} { + catch {grammar::fa::op::difference a b c d} res + set res +} {wrong # args: should be "grammar::fa::op::difference fa fb ?mapvar?"} + + +test faop-difference-${setimpl}-1.2 {difference, error} { + catch {grammar::fa::op::difference a b} res + set res +} {invalid command name "a"} + + +test faop-difference-${setimpl}-1.3 {difference, error} { + grammar::fa a + catch {grammar::fa::op::difference a b} res + a destroy + set res +} {invalid command name "b"} + + +test faop-difference-${setimpl}-1.4 {difference, error} { + grammar::fa a + grammar::fa b + catch {grammar::fa::op::difference a b} res + a destroy + b destroy + set res +} {Unable to perform the difference of two FAs without start/final states} + + +test faop-difference-${setimpl}-1.5 {difference, error} { + grammar::fa a + grammar::fa b + a state add x + a start add x + catch {grammar::fa::op::difference a b} res + a destroy + b destroy + set res +} {Unable to perform the difference of two FAs without start/final states} + + +test faop-difference-${setimpl}-1.6 {difference, error} { + grammar::fa a + grammar::fa b + a state add x + a final add x + catch {grammar::fa::op::difference a b} res + a destroy + b destroy + set res +} {Unable to perform the difference of two FAs without start/final states} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n fa fb fres rmap} { + 00 + {grammar::fa {a b c} {x {1 0 {a y}} y {0 0 {b y c z}} z {0 1 {}}}} + {grammar::fa {a d c} {u {1 0 {a v}} v {0 0 {d v c w}} w {0 1 {}}}} + {grammar::fa {a b c d} {0 {1 0 {a 2}} 2 {0 0 {b 4}} 4 {0 0 {c 7 b 4}} 7 {0 1 {}}}} + {0 {x u} 2 {y v} 4 {y sink.0} 7 {z sink.0}} + +} { + set key $n + + test faop-difference-${setimpl}-2.$key {difference} { + grammar::fa a deserialize $fa + grammar::fa b deserialize $fb + set res {} + grammar::fa::op::difference a b map + lappend res [validate_serial $fres a] + lappend res [string equal $rmap [dictsort $map]] + a destroy + b destroy + set res + } {ok 1} + + test faop-difference-${setimpl}-3.$key {difference, as method} { + grammar::fa a deserialize $fa + grammar::fa b deserialize $fb + set res {} + a difference b map + lappend res [validate_serial $fres a] + lappend res [string equal $rmap [dictsort $map]] + a destroy + b destroy + set res + } {ok 1} +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_intersect.test b/tcllib/modules/grammar_fa/tests/faop_intersect.test new file mode 100644 index 0000000..8abced6 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_intersect.test @@ -0,0 +1,111 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_intersect.test,v 1.6 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-intersect-${setimpl}-1.0 {intersect, error} { + catch {grammar::fa::op::intersect} res + set res +} {wrong # args: should be "grammar::fa::op::intersect fa fb ?mapvar? ?idstart?"} + + +test faop-intersect-${setimpl}-1.1 {intersect, error} { + catch {grammar::fa::op::intersect a b c d e} res + set res +} {wrong # args: should be "grammar::fa::op::intersect fa fb ?mapvar? ?idstart?"} + + +test faop-intersect-${setimpl}-1.2 {intersect, error} { + catch {grammar::fa::op::intersect a b} res + set res +} {invalid command name "a"} + + +test faop-intersect-${setimpl}-1.3 {intersect, error} { + grammar::fa a + catch {grammar::fa::op::intersect a b} res + a destroy + set res +} {invalid command name "b"} + + +test faop-intersect-${setimpl}-1.4 {intersect, error} { + grammar::fa a + grammar::fa b + catch {grammar::fa::op::intersect a b} res + a destroy + b destroy + set res +} {Unable to perform the intersection of two FAs without start/final states} + + +test faop-intersect-${setimpl}-1.5 {intersect, error} { + grammar::fa a + grammar::fa b + a state add x + a start add x + catch {grammar::fa::op::intersect a b} res + a destroy + b destroy + set res +} {Unable to perform the intersection of two FAs without start/final states} + + +test faop-intersect-${setimpl}-1.6 {intersect, error} { + grammar::fa a + grammar::fa b + a state add x + a final add x + catch {grammar::fa::op::intersect a b} res + a destroy + b destroy + set res +} {Unable to perform the intersection of two FAs without start/final states} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n fa fb fres rmap} { + 00 + {grammar::fa {a b c} {x {1 0 {a y}} y {0 0 {b y c z}} z {0 1 {}}}} + {grammar::fa {a d c} {u {1 0 {a v}} v {0 0 {d v c w}} w {0 1 {}}}} + {grammar::fa {a b c d} {0 {1 0 {a 2}} 2 {0 0 {c 5}} 5 {0 1 {}}}} + {0 {x u} 2 {y v} 5 {z w}} +} { + set key $n + + test faop-intersect-${setimpl}-2.$key {intersect} { + grammar::fa a deserialize $fa + grammar::fa b deserialize $fb + set res {} + grammar::fa::op::intersect a b map + + lappend res [validate_serial $fres a] + lappend res [string equal $rmap [dictsort $map]] + a destroy + b destroy + set res + } {ok 1} + + test faop-intersect-${setimpl}-3.$key {intersect, as method} { + grammar::fa a deserialize $fa + grammar::fa b deserialize $fb + set res {} + a intersect b map + + lappend res [validate_serial $fres a] + lappend res [string equal $rmap [dictsort $map]] + a destroy + b destroy + set res + } {ok 1} +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_kleene.test b/tcllib/modules/grammar_fa/tests/faop_kleene.test new file mode 100644 index 0000000..3db1e72 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_kleene.test @@ -0,0 +1,102 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_kleene.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-kleene-${setimpl}-1.0 {kleene, error} { + catch {grammar::fa::op::kleene} res + set res +} {wrong # args: should be "grammar::fa::op::kleene fa"} + + +test faop-kleene-${setimpl}-1.1 {kleene, error} { + catch {grammar::fa::op::kleene a b} res + set res +} {wrong # args: should be "grammar::fa::op::kleene fa"} + + +test faop-kleene-${setimpl}-1.2 {kleene, error} { + catch {grammar::fa::op::kleene a} res + set res +} {invalid command name "a"} + + +test faop-kleene-${setimpl}-1.3 {kleene, error} { + grammar::fa a + catch {grammar::fa::op::kleene a} res + a destroy + set res +} {Unable to add Kleene's closure to a FA without start/final states} + + +test faop-kleene-${setimpl}-1.4 {kleene, error} { + grammar::fa a + a state add x + a start add x + catch {grammar::fa::op::kleene a} res + a destroy + set res +} {Unable to add Kleene's closure to a FA without start/final states} + + +test faop-kleene-${setimpl}-1.5 {kleene, error} { + grammar::fa a + a state add x + a final add x + catch {grammar::fa::op::kleene a} res + a destroy + set res +} {Unable to add Kleene's closure to a FA without start/final states} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code st fin result} { + 00 datom x y + {grammar::fa @ {x {0 0 {@ y}} y {0 0 {{} f.0}} s.0 {1 0 {{} {x f.0}}} f.0 {0 1 {{} s.0}}}} + + 01 dalt u z + {grammar::fa {@ =} {u {0 0 {{} {v w}}} v {0 0 {@ x}} w {0 0 {= y}} x {0 0 {{} z}} y {0 0 {{} z}} z {0 0 {{} f.0}} s.0 {1 0 {{} {u f.0}}} f.0 {0 1 {{} s.0}}}} + + 02 daltb u z + {grammar::fa {@ =} {u {0 0 {{} {v w}}} v {0 0 {@ x}} w {0 0 {= y}} x {0 0 {{} z}} y {0 0 {{} z}} z {0 0 {{} {u f.0}}} s.0 {1 0 {{} {u f.0}}} f.0 {0 1 {{} s.0}}}} + + 03 dopt u x + {grammar::fa @ {u {0 0 {{} {v x}}} v {0 0 {@ w}} w {0 0 {{} x}} x {0 0 {{} f.0}} s.0 {1 0 {{} {u f.0}}} f.0 {0 1 {{} s.0}}}} + + 04 drep u x + {grammar::fa @ {u {0 0 {{} {v x}}} v {0 0 {@ w}} w {0 0 {{} x}} x {0 0 {{} {u f.0}}} s.0 {1 0 {{} {u f.0}}} f.0 {0 1 {{} s.0}}}} +} { + set key ${n}.${code} + + test faop-kleene-${setimpl}-2.$key {kleene} { + grammar::fa a + gen $code + a start add $st + a final add $fin + grammar::fa::op::kleene a + set res [validate_serial $result a] + a destroy + set res + } ok + + test faop-kleene-${setimpl}-3.$key {kleene, as method} { + grammar::fa a + gen $code + a start add $st + a final add $fin + a kleene + set res [validate_serial $result a] + a destroy + set res + } ok +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_minimize.test b/tcllib/modules/grammar_fa/tests/faop_minimize.test new file mode 100644 index 0000000..949d069 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_minimize.test @@ -0,0 +1,117 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_minimize.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-minimize-${setimpl}-1.0 {minimize, error} { + catch {grammar::fa::op::minimize} res + set res +} {wrong # args: should be "grammar::fa::op::minimize fa ?mapvar?"} + + +test faop-minimize-${setimpl}-1.1 {minimize, error} { + catch {grammar::fa::op::minimize a b c} res + set res +} {wrong # args: should be "grammar::fa::op::minimize fa ?mapvar?"} + + +test faop-minimize-${setimpl}-1.2 {minimize, error} { + catch {grammar::fa::op::minimize a} res + set res +} {invalid command name "a"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code st fin mapres result} { + 00 datom x y {} + {grammar::fa @ {x {1 0 {@ y}} y {0 1 {}}}} + + 01 dalt u z {0 {u v w} 1 {x y z}} + {grammar::fa {@ =} {0 {1 0 {@ 1 = 1}} 1 {0 1 {}}}} + + 02 dopt u x {0 {u v w x} 1 {u w x}} + {grammar::fa @ {0 {1 1 {@ 1}} 1 {0 1 {}}}} + + 03 drep u x {0 {u v w x}} + {grammar::fa @ {0 {1 1 {@ 0}}}} +} { + set key ${n}.${code} + + test faop-minimize-${setimpl}-2.$key {minimize, bounded} { + grammar::fa a + gen $code + a start add $st + a final add $fin + grammar::fa::op::minimize a map + set res [validate_serial $result a] + lappend res [string equal $mapres [dictsort $map]] + lappend res [a is deterministic] + a destroy + set res + } {ok 1 1} + + test faop-minimize-${setimpl}-3.$key {minimize, bounded, as method} { + grammar::fa a + gen $code + a start add $st + a final add $fin + a minimize map + set res [validate_serial $result a] + lappend res [string equal $mapres [dictsort $map]] + lappend res [a is deterministic] + a destroy + set res + } {ok 1 1} +} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code mapres result} { + 00 datom {0 x 1 y} + {grammar::fa @ {0 {0 0 {@ 1}} 1 {0 0 {}}}} + + 01 dalt {0 v 1 x 2 w 3 y 4 {u v} 5 u 6 {u w} 7 z 8 {x z} 9 {y z}} + {grammar::fa {@ =} {0 {0 0 {}} 1 {0 0 {}} 2 {0 0 {}} 3 {0 0 {}} 4 {0 0 {@ 8}} 5 {0 0 {}} 6 {0 0 {= 9}} 7 {0 0 {}} 8 {0 0 {}} 9 {0 0 {}}}} + + 02 dopt {0 {u v} 1 x 2 u 3 v 4 w 5 {w x}} + {grammar::fa @ {0 {0 0 {@ 5}} 1 {0 0 {}} 2 {0 0 {}} 3 {0 0 {}} 4 {0 0 {}} 5 {0 0 {}}}} + + 03 drep {0 {u v w x} 1 x 2 u 3 v 4 w 5 {u v w x}} + {grammar::fa @ {0 {0 0 {@ 5}} 1 {0 0 {}} 2 {0 0 {}} 3 {0 0 {}} 4 {0 0 {}} 5 {0 0 {@ 5}}}} +} { + set key ${n}.${code} + + test faop-minimize-${setimpl}-4.$key {minimize, unbounded} { + grammar::fa a + gen $code + grammar::fa::op::minimize a map + set res [validate_serial $result a] + lappend res [string equal $mapres [dictsort $map]] + lappend res [a is deterministic] ; # Never formally det, because of missing start. + a destroy + set res + } {ok 1 0} + + test faop-minimize-${setimpl}-5.$key {minimize, unbounded, as method} { + grammar::fa a + gen $code + a minimize map + set res [validate_serial $result a] + lappend res [string equal $mapres [dictsort $map]] + lappend res [a is deterministic] ; # Never formally det, because of missing start. + a destroy + set res + } {ok 1 0} +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_optional.test b/tcllib/modules/grammar_fa/tests/faop_optional.test new file mode 100644 index 0000000..fcb455f --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_optional.test @@ -0,0 +1,102 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_optional.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-optional-${setimpl}-1.0 {optional, error} { + catch {grammar::fa::op::optional} res + set res +} {wrong # args: should be "grammar::fa::op::optional fa"} + + +test faop-optional-${setimpl}-1.1 {optional, error} { + catch {grammar::fa::op::optional a b} res + set res +} {wrong # args: should be "grammar::fa::op::optional fa"} + + +test faop-optional-${setimpl}-1.2 {optional, error} { + catch {grammar::fa::op::optional a} res + set res +} {invalid command name "a"} + + +test faop-optional-${setimpl}-1.3 {optional, error} { + grammar::fa a + catch {grammar::fa::op::optional a} res + a destroy + set res +} {Unable to make a FA without start/final states optional} + + +test faop-optional-${setimpl}-1.4 {optional, error} { + grammar::fa a + a state add x + a start add x + catch {grammar::fa::op::optional a} res + a destroy + set res +} {Unable to make a FA without start/final states optional} + + +test faop-optional-${setimpl}-1.5 {optional, error} { + grammar::fa a + a state add x + a final add x + catch {grammar::fa::op::optional a} res + a destroy + set res +} {Unable to make a FA without start/final states optional} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code st fin result} { + 00 datom x y + {grammar::fa @ {x {0 0 {@ y}} y {0 0 {{} f.0}} s.0 {1 0 {{} {x f.0}}} f.0 {0 1 {}}}} + + 01 dalt u z + {grammar::fa {@ =} {u {0 0 {{} {v w}}} v {0 0 {@ x}} w {0 0 {= y}} x {0 0 {{} z}} y {0 0 {{} z}} z {0 0 {{} f.0}} s.0 {1 0 {{} {u f.0}}} f.0 {0 1 {}}}} + + 02 daltb u z + {grammar::fa {@ =} {u {0 0 {{} {v w}}} v {0 0 {@ x}} w {0 0 {= y}} x {0 0 {{} z}} y {0 0 {{} z}} z {0 0 {{} {u f.0}}} s.0 {1 0 {{} {u f.0}}} f.0 {0 1 {}}}} + + 03 dopt u x + {grammar::fa @ {u {0 0 {{} {v x}}} v {0 0 {@ w}} w {0 0 {{} x}} x {0 0 {{} f.0}} s.0 {1 0 {{} {u f.0}}} f.0 {0 1 {}}}} + + 04 drep u x + {grammar::fa @ {u {0 0 {{} {v x}}} v {0 0 {@ w}} w {0 0 {{} x}} x {0 0 {{} {u f.0}}} s.0 {1 0 {{} {u f.0}}} f.0 {0 1 {}}}} +} { + set key ${n}.${code} + + test faop-optional-${setimpl}-2.$key {optional} { + grammar::fa a + gen $code + a start add $st + a final add $fin + grammar::fa::op::optional a + set res [validate_serial $result a] + a destroy + set res + } ok + + test faop-optional-${setimpl}-3.$key {optional, as method} { + grammar::fa a + gen $code + a start add $st + a final add $fin + a optional + set res [validate_serial $result a] + a destroy + set res + } ok +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_regex.test b/tcllib/modules/grammar_fa/tests/faop_regex.test new file mode 100644 index 0000000..961e135 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_regex.test @@ -0,0 +1,256 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_regex.test,v 1.7 2007/12/03 21:46:25 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-regex-${setimpl}-1.0 {fromRegex, error} { + catch {grammar::fa::op::fromRegex} res + set res +} {wrong # args: should be "grammar::fa::op::fromRegex fa regex ?over?"} + + +test faop-regex-${setimpl}-1.1 {fromRegex, error} { + catch {grammar::fa::op::fromRegex a b c d} res + set res +} {wrong # args: should be "grammar::fa::op::fromRegex fa regex ?over?"} + + +test faop-regex-${setimpl}-1.2 {fromRegex, error} { + catch {grammar::fa::op::fromRegex a b} res + set res +} {Expected . ! ? * | &, or S, got "b"} + + +test faop-regex-${setimpl}-1.3 {fromRegex, error} { + catch {grammar::fa::op::fromRegex a {S b}} res + set res +} {invalid command name "a"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +foreach {n over re fres} { + 00 {} {} + {grammar::fa {} {}} + + 01 {} {S x} + {grammar::fa x {0 {1 0 {x 1}} 1 {0 1 {}}}} + + 02 {} {. {S x} {S y}} + {grammar::fa {x y} {0 {1 0 {x 1}} 1 {0 0 {{} 2}} 2 {0 0 {y 3}} 3 {0 1 {}}}} + + 03 {} {| {S x} {S y}} + {grammar::fa {x y} {0 {1 0 {{} {2 4}}} 1 {0 1 {}} 2 {0 0 {x 3}} 3 {0 0 {{} 1}} 4 {0 0 {y 5}} 5 {0 0 {{} 1}}}} + + 04 {} {? {S x}} + {grammar::fa x {0 {1 0 {{} {2 1}}} 1 {0 1 {}} 2 {0 0 {x 3}} 3 {0 0 {{} 1}}}} + + 05 {} {* {S x}} + {grammar::fa x {0 {1 1 {{} 1}} 1 {0 0 {x 2}} 2 {0 0 {{} 0}}}} + + 06 {} {+ {S x}} + {grammar::fa x {0 {1 0 {{} 2}} 1 {0 1 {{} 0}} 2 {0 0 {x 3}} 3 {0 0 {{} 1}}}} + + 07 {} {! {S x}} + {grammar::fa x {0 {1 0 {{} 2}} 1 {0 1 {}} 2 {0 0 {x 3 {} 1}} 3 {0 0 {x 6}} 6 {0 0 {x 6 {} 1}}}} + + 08 {/ * { } a} {. {S /} {S *} {+ {! {. {S *} {S /}}}} {S *} {S /}} + {grammar::fa {{ } a * /} {0 {1 0 {/ 1}} 1 {0 0 {{} 2}} 2 {0 0 {* 3}} 3 {0 0 {{} 4}} 4 {0 0 {{} 6}} 5 {0 0 {{} {4 16}}} 6 {0 0 {{} 12}} 7 {0 0 {{} 5}} 12 {0 0 {{ } 15 {} 7 a 15 * 13 / 15}} 13 {0 0 {{ } 15 {} 7 a 15 * 15 / 14}} 14 {0 0 {{ } 15 a 15 * 15 / 15}} 15 {0 0 {{ } 15 {} 7 a 15 * 15 / 15}} 16 {0 0 {* 17}} 17 {0 0 {{} 18}} 18 {0 0 {/ 19}} 19 {0 1 {}}}} + + 09 {} {. {S x}} + {grammar::fa x {0 {1 0 {x 1}} 1 {0 1 {}}}} + + 10 {} {| {S x}} + {grammar::fa x {0 {1 0 {x 1}} 1 {0 1 {}}}} + + 11 {} {& {S x}} + {grammar::fa x {0 {1 0 {x 1}} 1 {0 1 {}}}} + + 12 {} {& {. {S a} {* {S d}} {S c}} {. {S a} {* {S b}} {S c}}} + {grammar::fa {a b c d} {0 {1 0 {{} 2}} 1 {0 1 {}} 2 {0 0 {a 3}} 3 {0 0 {c 4}} 4 {0 0 {{} 1}}}} +} { + set key ${n} + + test faop-regex-${setimpl}-2.$key {fromRegex} { + grammar::fa a + grammar::fa::op::fromRegex a $re $over + set res [validate_serial $fres a] + a destroy + set res + + } ok + + test faop-regex-${setimpl}-3.$key {fromRegex, as method} { + grammar::fa a + a fromRegex $re $over + set res [validate_serial $fres a] + a destroy + set res + } ok +} + +# ------------------------------------------------------------------------- + +test faop-regex-${setimpl}-4.0 {toRegexp, error} { + catch {grammar::fa::op::toRegexp} res + set res +} {wrong # args: should be "grammar::fa::op::toRegexp fa"} + +test faop-regex-${setimpl}-4.1 {toRegexp, error} { + catch {grammar::fa::op::toRegexp a b} res + set res +} {wrong # args: should be "grammar::fa::op::toRegexp fa"} + +test faop-regex-${setimpl}-4.2 {toRegexp, error} { + catch {grammar::fa::op::toRegexp a} res + set res +} {invalid command name "a"} + +test faop-regex-${setimpl}-4.3 {toRegexp} { + grammar::fa a + a state add 0 1 2 + a symbol add a + a symbol add b + a next 0 a --> 1 + a next 0 b --> 2 + a next 1 b --> 0 + a next 2 b --> 0 + a start add 0 + a final add 0 + + set res [grammar::fa::op::toRegexp a] + a destroy + set res +} {* {| {. {S a} {S b}} {. {S b} {S b}}}} + + +test faop-regex-${setimpl}-5.0 {toRegexp2, error} { + catch {grammar::fa::op::toRegexp2} res + set res +} {wrong # args: should be "grammar::fa::op::toRegexp2 fa"} + +test faop-regex-${setimpl}-5.1 {toRegexp2, error} { + catch {grammar::fa::op::toRegexp2 a b} res + set res +} {wrong # args: should be "grammar::fa::op::toRegexp2 fa"} + +test faop-regex-${setimpl}-5.2 {toRegexp2, error} { + catch {grammar::fa::op::toRegexp2 a} res + set res +} {invalid command name "a"} + +test faop-regex-${setimpl}-5.3 {toRegexp2} { + grammar::fa a + a state add 0 1 2 + a symbol add a + a symbol add b + a next 0 a --> 1 + a next 0 b --> 2 + a next 1 b --> 0 + a next 2 b --> 0 + a start add 0 + a final add 0 + + set res [grammar::fa::op::toRegexp2 a] + a destroy + set res +} {* {| {. {S a} {S b}} {. {S b} {S b}}}} + +# ------------------------------------------------------------------------- + +test faop-regex-${setimpl}-6.0 {toTclRegexp, error} { + catch {grammar::fa::op::toTclRegexp} res + set res +} {wrong # args: should be "grammar::fa::op::toTclRegexp re symdict"} + +test faop-regex-${setimpl}-6.1 {toTclRegexp, error} { + catch {grammar::fa::op::toTclRegexp a b c} res + set res +} {wrong # args: should be "grammar::fa::op::toTclRegexp re symdict"} + +test faop-regex-${setimpl}-6.2 {toTclRegexp, error} { + catch {grammar::fa::op::toTclRegexp a {}} res + set res +} {invalid command name "a"} + +test faop-regex-${setimpl}-6.3 {toTclRegexp} { + grammar::fa::op::toTclRegexp {* {| {. {S a} {S b}} {. {S b} {S b}}}} {} +} {(ab|bb)*} + +# ------------------------------------------------------------------------- + +test faop-regex-${setimpl}-7.0 {simplifyRegexp, error} { + catch {grammar::fa::op::simplifyRegexp} res + set res +} {wrong # args: should be "grammar::fa::op::simplifyRegexp RE0"} + +test faop-regex-${setimpl}-7.1 {simplifyRegexp, error} { + catch {grammar::fa::op::simplifyRegexp a b} res + set res +} {wrong # args: should be "grammar::fa::op::simplifyRegexp RE0"} + +test faop-regex-${setimpl}-7.2 {simplifyRegexp} { + set re {* {. {| {S a} {S b}} {S b}}} + grammar::fa::op::simplifyRegexp $re +} {* {. {| {S a} {S b}} {S b}}} + +test faop-regex-${setimpl}-7.3 {simplifyRegexp} { + set re {* {| {. {S a} {S b}} {. {S b} {S b}}}} + grammar::fa::op::simplifyRegexp $re +} {* {. {| {S a} {S b}} {S b}}} + +# ------------------------------------------------------------------------- +## Two larger examples + +test faop-regex-${setimpl}-8.0 {to(Tcl)Regexp, match 2 mod 3, decimal} { + set fa [grammar::fa decimal_2_mod_3] + $fa state add 0 1 2 + $fa symbol add 0 1 2 3 4 5 6 7 8 9 + foreach state [$fa states] { + foreach digit [$fa symbols] { + $fa next $state $digit --> [expr {(10*$state + $digit) % 3}] + } + } + $fa start add 0 + $fa final add 2 + set RE ^([grammar::fa::op::toTclRegexp [grammar::fa::op::toRegexp $fa] {}])\$ + # Check the generated regex for correctness. Should match all ints 2 mod 3. + set res {} + for {set n 0} {$n<1000} {incr n} { + if {[regexp $RE $n] != ($n % 3 == 2)} { + lappend res $n + } + } + $fa destroy + set res +} {} + +test faop-regex-${setimpl}-8.1 {to(Tcl)Regexp, match 1 mod 8, octal} { + + set fa [grammar::fa octal_1_mod_3] + $fa state add 0 1 2 + $fa symbol add 0 1 2 3 4 5 6 7 + foreach state [$fa states] { + foreach digit [$fa symbols] { + $fa next $state $digit --> [expr {(8*$state + $digit) % 3}] + } + } + $fa start add 0 + $fa final add 1 + set RE ^([grammar::fa::op::toTclRegexp [grammar::fa::op::toRegexp $fa] {}])\$ + set res {} + for {set n 0} {$n<4096} {incr n} { + if {[regexp $RE [format %o $n]] != ($n % 3 == 1)} { + lappend res $n + } + } + $fa destroy + set res +} {} + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_remeps.test b/tcllib/modules/grammar_fa/tests/faop_remeps.test new file mode 100644 index 0000000..4951fad --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_remeps.test @@ -0,0 +1,158 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_remeps.test,v 1.5 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-remove-${setimpl}-eps-1.0 {remove-eps, error} { + catch {grammar::fa::op::remove_eps} res + set res +} {wrong # args: should be "grammar::fa::op::remove_eps fa"} + + +test faop-remove-${setimpl}-eps-1.1 {remove-eps, error} { + catch {grammar::fa::op::remove_eps a b} res + set res +} {wrong # args: should be "grammar::fa::op::remove_eps fa"} + + +test faop-remove-${setimpl}-eps-1.2 {remove-eps, error} { + catch {grammar::fa::op::remove_eps a} res + set res +} {invalid command name "a"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code result} { + 00 x id + 01 x- id + 02 xe {grammar::fa {} {x {0 0 {}}}} + 03 xy id + 04 xy- id + 05 xye {grammar::fa {} {x {0 0 {}} y {0 0 {}}}} + 06 xyee {grammar::fa {} {x {0 0 {}} y {0 0 {}}}} + 07 xye- {grammar::fa @ {x {0 0 {@ {x y}}} y {0 0 {@ {x y}}}}} + 08 xy-- id + 09 xy-= id + 10 xyz/ee {grammar::fa {} {x {0 0 {}} y {0 0 {}} z {0 0 {}}}} + 11 xyz/e- {grammar::fa @ {x {0 0 {@ y}} y {0 0 {}} z {0 0 {}}}} + 12 xyz/-- id + 13 xyz/-= id + 14 xyz|ee {grammar::fa {} {x {0 0 {}} y {0 0 {}} z {0 0 {}}}} + 15 xyz|e- {grammar::fa @ {x {0 0 {@ z}} y {0 0 {}} z {0 0 {}}}} + 16 xyz|-- id + 17 xyz|-= id + 18 xyz+eee {grammar::fa {} {x {0 0 {}} y {0 0 {}} z {0 0 {}}}} + 19 xyz+ee- {grammar::fa @ {x {0 0 {@ {x y z}}} y {0 0 {@ {x y z}}} z {0 0 {@ {x y z}}}}} + 20 xyz+e-- {grammar::fa @ {x {0 0 {@ z}} y {0 0 {@ z}} z {0 0 {@ {x y}}}}} + 21 xyz+e-= {grammar::fa {@ =} {x {0 0 {@ z}} y {0 0 {@ z}} z {0 0 {= {x y}}}}} + 22 xyz+--- id + 23 xyz+--= id + 24 xyz+-=_ id + 25 xyz&eee {grammar::fa {} {x {0 0 {}} y {0 0 {}} z {0 0 {}}}} + 26 xyz&ee- {grammar::fa @ {x {0 0 {@ z}} y {0 0 {@ z}} z {0 0 {}}}} + 27 xyz&e-- {grammar::fa @ {x {0 0 {@ z}} y {0 0 {@ z}} z {0 0 {}}}} + 28 xyz&e-= {grammar::fa {@ =} {x {0 0 {= z @ z}} y {0 0 {= z}} z {0 0 {}}}} + 29 xyz&--- id + 30 xyz&--= id + 31 xyz&-=_ id + 32 xyz!ee {grammar::fa {} {x {0 0 {}} y {0 0 {}} z {0 0 {}}}} + 33 xyz!e- {grammar::fa @ {x {0 0 {@ z}} y {0 0 {@ z}} z {0 0 {}}}} + 34 xyz!-- id + 35 xyz!-= id + 36 xyz!-e {grammar::fa @ {x {0 0 {@ {y z}}} y {0 0 {}} z {0 0 {}}}} +} { + set key ${n}.${code} + if {$result eq "id"} { + grammar::fa a + gen $code + set result [a serialize] + a destroy + } + + test faop-remove-${setimpl}-eps-2.$key {remove-eps} { + grammar::fa a + gen $code + grammar::fa::op::remove_eps a + set res [a is epsilon-free] + lappend res [validate_serial $result a] + a destroy + set res + } {1 ok} + + test faop-remove-${setimpl}-eps-3.$key {second remove eps is null operation} { + grammar::fa a + gen $code + grammar::fa::op::remove_eps a + set res [a serialize] + grammar::fa::op::remove_eps a + set res [validate_serial $res a] + a destroy + set res + } ok + + test faop-remove-${setimpl}-eps-4.$key {remove-eps, as method} { + grammar::fa a + gen $code + a remove_eps + set res [a is epsilon-free] + lappend res [validate_serial $result a] + a destroy + set res + } {1 ok} + + test faop-remove-${setimpl}-eps-5.$key {second remove eps is null operation, as method} { + grammar::fa a + gen $code + a remove_eps + set res [a serialize] + a remove_eps + set res [validate_serial $res a] + a destroy + set res + } ok +} + + +foreach {n code st fin stnew finnew} { + 00 datom x y x y + 01 dalt u z {u v w} {x y z} + 02 dopt u x {u v x} {u w x} + 03 drep u x {u v x} {u w x} +} { + test faop-remove-${setimpl}-eps-6.$n.$code {remove epsilon, start/final propagation} { + grammar::fa a + gen $code + a start add $st + a final add $fin + grammar::fa::op::remove_eps a + + set res {} + lappend res [string equal $stnew [lsort [a startstates]]] + lappend res [string equal $finnew [lsort [a finalstates]]] + a destroy + set res + } {1 1} + + test faop-remove-${setimpl}-eps-7.$n.$code {remove epsilon, start/final propagation, as method} { + grammar::fa a + gen $code + a start add $st + a final add $fin + a remove_eps + + set res {} + lappend res [string equal $stnew [lsort [a startstates]]] + lappend res [string equal $finnew [lsort [a finalstates]]] + a destroy + set res + } {1 1} +} + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests diff --git a/tcllib/modules/grammar_fa/tests/faop_reverse.test b/tcllib/modules/grammar_fa/tests/faop_reverse.test new file mode 100644 index 0000000..d997707 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_reverse.test @@ -0,0 +1,95 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_reverse.test,v 1.5 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-reverse-${setimpl}-1.0 {reverse, error} { + catch {grammar::fa::op::reverse} res + set res +} {wrong # args: should be "grammar::fa::op::reverse fa"} + + +test faop-reverse-${setimpl}-1.1 {reverse, error} { + catch {grammar::fa::op::reverse a b} res + set res +} {wrong # args: should be "grammar::fa::op::reverse fa"} + + +test faop-reverse-${setimpl}-1.2 {reverse, error} { + catch {grammar::fa::op::reverse a} res + set res +} {invalid command name "a"} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n code result} { + 00 x {grammar::fa {} {x {0 0 {}}}} + 01 x- {grammar::fa @ {x {0 0 {@ x}}}} + 02 xe {grammar::fa {} {x {0 0 {{} x}}}} + 03 xy {grammar::fa {} {x {0 0 {}} y {0 0 {}}}} + 04 xy- {grammar::fa @ {x {0 0 {}} y {0 0 {@ x}}}} + 05 xye {grammar::fa {} {x {0 0 {}} y {0 0 {{} x}}}} + 06 xyee {grammar::fa {} {x {0 0 {{} y}} y {0 0 {{} x}}}} + 07 xyz/ee {grammar::fa {} {x {0 0 {}} y {0 0 {{} x}} z {0 0 {{} x}}}} + 08 xyz/-= {grammar::fa {@ =} {x {0 0 {}} y {0 0 {@ x}} z {0 0 {= x}}}} + 09 xyz|ee {grammar::fa {} {x {0 0 {}} y {0 0 {}} z {0 0 {{} {x y}}}}} + 10 xyz|-= {grammar::fa {@ =} {x {0 0 {}} y {0 0 {}} z {0 0 {@ x = y}}}} + 11 xyz+eee {grammar::fa {} {x {0 0 {{} z}} y {0 0 {{} x}} z {0 0 {{} y}}}} + 12 xyz+-=_ {grammar::fa {@ % =} {x {0 0 {% z}} y {0 0 {@ x}} z {0 0 {= y}}}} + 13 xyz&eee {grammar::fa {} {x {0 0 {}} y {0 0 {{} x}} z {0 0 {{} {x y}}}}} + 14 xyz&-=_ {grammar::fa {@ % =} {x {0 0 {}} y {0 0 {@ x}} z {0 0 {= x % y}}}} + 15 xyz!ee {grammar::fa {} {x {0 0 {}} y {0 0 {{} x}} z {0 0 {{} y}}}} + 16 xyz!-= {grammar::fa {@ % =} {x {0 0 {}} y {0 0 {@ x}} z {0 0 {= y}}}} +} { + set key ${n}.${code} + + test faop-reverse-${setimpl}-2.$key {reverse} { + grammar::fa a + gen $code + grammar::fa::op::reverse a + set res [validate_serial $result a] + a destroy + set res + } ok + + test faop-reverse-${setimpl}-3.$key {double reverse is identity} { + grammar::fa a + gen $code + set res [a serialize] + grammar::fa::op::reverse a + grammar::fa::op::reverse a + set res [validate_serial $res a] + a destroy + set res + } ok + + test faop-reverse-${setimpl}-4.$key {reverse, as method} { + grammar::fa a + gen $code + a reverse + set res [validate_serial $result a] + a destroy + set res + } ok + + test faop-reverse-${setimpl}-5.$key {double reverse is identity, for method} { + grammar::fa a + gen $code + set res [a serialize] + a reverse + a reverse + set res [validate_serial $res a] + a destroy + set res + } ok +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests 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 diff --git a/tcllib/modules/grammar_fa/tests/faop_union.test b/tcllib/modules/grammar_fa/tests/faop_union.test new file mode 100644 index 0000000..86b1c67 --- /dev/null +++ b/tcllib/modules/grammar_fa/tests/faop_union.test @@ -0,0 +1,113 @@ +# -*- tcl -*- +# fa_operations.test: tests for the FA operations. +# +# Copyright (c) 2004-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# RCS: @(#) $Id: faop_union.test,v 1.4 2007/04/12 03:43:15 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +test faop-union-${setimpl}-1.0 {union, error} { + catch {grammar::fa::op::union} res + set res +} {wrong # args: should be "grammar::fa::op::union fa fb ?mapvar?"} + + +test faop-union-${setimpl}-1.1 {union, error} { + catch {grammar::fa::op::union a b c d} res + set res +} {wrong # args: should be "grammar::fa::op::union fa fb ?mapvar?"} + + +test faop-union-${setimpl}-1.2 {union, error} { + catch {grammar::fa::op::union a b} res + set res +} {invalid command name "a"} + + +test faop-union-${setimpl}-1.3 {union, error} { + grammar::fa a + catch {grammar::fa::op::union a b} res + a destroy + set res +} {invalid command name "b"} + + +test faop-union-${setimpl}-1.4 {union, error} { + grammar::fa a + grammar::fa b + catch {grammar::fa::op::union a b} res + a destroy + b destroy + set res +} {Unable to union FAs without start/final states} + + +test faop-union-${setimpl}-1.5 {union, error} { + grammar::fa a + grammar::fa b + a state add x + a start add x + catch {grammar::fa::op::union a b} res + a destroy + b destroy + set res +} {Unable to union FAs without start/final states} + + +test faop-union-${setimpl}-1.6 {union, error} { + grammar::fa a + grammar::fa b + a state add x + a final add x + catch {grammar::fa::op::union a b} res + a destroy + b destroy + set res +} {Unable to union FAs without start/final states} + + +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +foreach {n fa fb fres rmap} { + 0 + {grammar::fa @ {x {1 0 {@ y}} y {0 1 {}}}} + {grammar::fa = {u {1 0 {= v}} v {0 1 {}}}} + {grammar::fa {= @} {x {0 0 {@ y}} y {0 0 {{} f.0}} u {0 0 {= v}} v {0 0 {{} f.0}} s.0 {1 0 {{} {x u}}} f.0 {0 1 {}}}} + {} + + 1 + {grammar::fa @ {x {1 0 {@ y}} y {0 1 {}}}} + {grammar::fa = {x {1 0 {= y}} y {0 1 {}}}} + {grammar::fa {= @} {x {0 0 {@ y}} y {0 0 {{} f.0}} 0 {0 0 {= 1}} 1 {0 0 {{} f.0}} s.0 {1 0 {{} {x 0}}} f.0 {0 1 {}}}} + {0 x 1 y} +} { + set key ${n} + + test faop-union-${setimpl}-2.$key {union} { + grammar::fa a deserialize $fa + grammar::fa b deserialize $fb + grammar::fa::op::union a b map + set res [validate_serial $fres a] + lappend res [string equal $rmap [dictsort $map]] + a destroy + b destroy + set res + } {ok 1} + + test faop-union-${setimpl}-3.$key {union, as method} { + grammar::fa a deserialize $fa + grammar::fa b deserialize $fb + a union b map + set res [validate_serial $fres a] + lappend res [string equal $rmap [dictsort $map]] + a destroy + b destroy + set res + } {ok 1} +} + + +# ------------------------------------------------------------------------- +::tcltest::cleanupTests |