-- HUnit unit tests for Data.FsmActions -- Copyright (c) 2009 Andy Gimblett - http://www.cs.swan.ac.uk/~csandy/ -- BSD Licence (see http://www.opensource.org/licenses/bsd-license.php) module Tests.Data.FsmActions ( tests, fig2 ) where import Prelude hiding (lookup) import Test.HUnit.Base import Data.FsmActions import Data.FsmActions.Graph import Data.FsmActions.WellFormed -- Test subjects. emptyFSM :: FSM Int emptyFSM = fromList [] noStatesFSM :: FSM Int noStatesFSM = fromList [(0, mkAction []), (1, mkAction [])] da1, da2, da3, da4, da5 :: Action da1 = mkDAction [0,1,2] da2 = mkDAction [2,1,0] da3 = mkDAction [1,2,0] da4 = mkDAction [2,0,1] da5 = mkDAction [1,1,0] na1,na2 :: Action na1 = mkAction [[1,2],[1],[0,1]] na2 = mkAction [[0,1],[1],[1,2]] -- Ill-formed because not all actions of same length. badLengthsFSM :: FSM Char badLengthsFSM = fromList [('a', da1) ,('b', da2) ,('c', mkAction [])] -- Ill-formed because actions include out-of-range destinations. hiDestsFSM :: FSM Char hiDestsFSM = fromList [('a', da1) ,('b', da2) ,('c', mkDAction [3,3,3])] -- Ill-formed because actions include negative destinations. negDestsFSM :: FSM Char negDestsFSM = fromList [('a', da1) ,('b', da2) ,('c', mkDAction [1,1,-1])] -- Ill-formed because actions include several bad destinations. Also -- a non-normalised NFSM. badDestsNFSM :: FSM Char badDestsNFSM = fromList [('a', mkAction [[0],[-1],[2]]) ,('b', mkAction [[5],[1,1],[]]) ,('c', mkAction [[1,-2,1],[5,1],[]])] -- Well-formed DFSM. goodDFSM :: FSM Char goodDFSM = fromList [('a', da1) ,('b', da2) ,('c', da5)] -- Well-formed NFSM goodNFSM :: FSM Char goodNFSM = fromList [('a', da1) ,('b', da2) ,('c', mkAction [[1,2],[1],[0,0,1]])] -- Examples from documentation fig2 :: FSM Char fig2 = fromList [('j', mkAction [[0], [2],[2],[0,3]]) ,('k', mkAction [[1,2],[1],[3],[3]]) ] -- Tests for the various functions on FSMs. testAlphabets :: Test testAlphabets = test ["empty" ~: [] ~=? alphabet emptyFSM ,"noStates" ~: [0,1] ~=? alphabet noStatesFSM ,"badLengths" ~: "abc" ~=? alphabet badLengthsFSM ,"hiDests" ~: "abc" ~=? alphabet hiDestsFSM ,"negDests" ~: "abc" ~=? alphabet negDestsFSM ,"badDestsNFSM" ~: "abc" ~=? alphabet badDestsNFSM ,"goodDFSM" ~: "abc" ~=? alphabet goodDFSM ,"goodNFSM" ~: "abc" ~=? alphabet goodNFSM ] testStates :: Test testStates = test ["empty" ~: [] ~=? states emptyFSM ,"noStates" ~: [] ~=? states noStatesFSM -- States check doesn't make sense for BadLengths case. ,"hiDests" ~: [0..2] ~=? states hiDestsFSM ,"negDests" ~: [0..2] ~=? states negDestsFSM ,"badDestsNFSM" ~: [0..2] ~=? states badDestsNFSM ,"goodDFSM" ~: [0..2] ~=? states goodDFSM ,"goodNFSM" ~: [0..2] ~=? states goodNFSM ] testIdentity :: Test testIdentity = test ["goodDFSM" ~: da1 ~=? fsmIdentity goodDFSM ,"goodNFSM" ~: da1 ~=? fsmIdentity goodNFSM -- Next set would probably make good quickcheck candidates. ,"id0" ~: mkDAction [] ~=? identity 0 -- Not really meaningful? ,"id1" ~: mkDAction [0] ~=? identity 1 ,"id2" ~: mkDAction [0,1] ~=? identity 2 ,"id3" ~: mkDAction [0,1,2] ~=? identity 3 ] testIsDFSM :: Test testIsDFSM = test ["empty" ~: True ~=? isDFSM emptyFSM ,"noStates" ~: True ~=? isDFSM noStatesFSM ,"badLengths" ~: True ~=? isDFSM badLengthsFSM ,"hiDests" ~: True ~=? isDFSM hiDestsFSM ,"negDests" ~: True ~=? isDFSM negDestsFSM ,"badDestsNFSM" ~: False ~=? isDFSM badDestsNFSM ,"goodDFSM" ~: True ~=? isDFSM goodDFSM ,"goodNFSM" ~: False ~=? isDFSM goodNFSM ] testNormalise :: Test testNormalise = test ["empty" ~: emptyFSM ~=? normalise emptyFSM ,"noStates" ~: True ~=? isDFSM (normalise noStatesFSM) ,"badLengths" ~: badLengthsFSM ~=? normalise badLengthsFSM ,"hiDests" ~: hiDestsFSM ~=? normalise hiDestsFSM ,"negDests" ~: negDestsFSM ~=? normalise negDestsFSM ,"badDestsNFSM" ~: test ["b is det" ~: Just (mkDAction [5,1,2]) ~=? lookup 'b' (normalise badDestsNFSM) ,"c norm" ~: Just (mkAction [[-2,1],[1,5],[2]]) ~=? lookup 'c' (normalise badDestsNFSM) ,"only a" ~: let only_a = delete 'c' $ delete 'b' badDestsNFSM in (only_a ~=? normalise only_a) ] ,"goodDFSM" ~: goodDFSM ~=? normalise goodDFSM ,"goodNFSM" ~: test ["c norm" ~: Just na1 ~=? lookup 'c' (normalise goodNFSM) ,"no c" ~: let no_c = delete 'c' goodNFSM in (no_c ~=? normalise no_c) ] ] testIsWellFormed :: Test testIsWellFormed = test ["empty" ~: Disconnected [] ~=? isWellFormed emptyFSM ,"noStates" ~: Disconnected [] ~=? isWellFormed noStatesFSM ,"badLengths" ~: BadLengths [('a', 3) ,('b', 3) ,('c', 0)] ~=? isWellFormed badLengthsFSM ,"hiDests" ~: BadActions [('c', mkDAction [3,3,3])] ~=? isWellFormed hiDestsFSM ,"negDests" ~: BadActions [('c', mkDAction [1,1,-1])] ~=? isWellFormed negDestsFSM ,"badDests" ~: BadActions [('a', mkDAction [0,-1,2]) ,('b', mkAction [[5],[1,1],[]]) ,('c', mkAction [[1,-2,1],[5,1],[]])] ~=? isWellFormed badDestsNFSM ,"goodDFSM" ~: WellFormed ~=? isWellFormed goodDFSM ,"goodNFSM" ~: WellFormed ~=? isWellFormed goodNFSM -- XXX Some non-trivial well-formed ones would be good! -- XXX Some non-trivial disconnected ones! -- XXX Add more tests for strongCCs ,"goodDFSM" ~: [[0,2],[1]] ~=? strongCCs goodDFSM ,"goodNFSM" ~: [[0,2],[1]] ~=? strongCCs goodNFSM ] testAppend :: Test testAppend = test ["da1 self-inverse" ~: da1 ~=? da1 `append` da1 ,"da2 self-inverse" ~: da1 ~=? da2 `append` da2 ,"da3 twice" ~: da4 ~=? da3 `append` da3 ,"da3 thrice" ~: da1 ~=? (da3 `append` da3) `append` da3 ,"da1 then da2" ~: da2 ~=? da1 `append` da2 ,"da2 then da1" ~: da2 ~=? da1 `append` da2 ,"da4 then da1" ~: da4 ~=? da4 `append` da1 ,"da1 then na1" ~: na1 ~=? da1 `append` na1 ,"da2 then na1" ~: na2 ~=? da2 `append` na1 ,"na1 then da1" ~: na1 ~=? na1 `append` da1 ,"na1 then da2" ~: na2 ~=? na1 `append` da2 ,"na2 then da1" ~: na2 ~=? na2 `append` da1 ,"na2 then da2" ~: na1 ~=? na2 `append` da2 ,"na1 then na1" ~: na2 ~=? na1 `append` na1 ,"na1 then na2" ~: na1 ~=? na1 `append` na2 ,"na2 then na1" ~: na1 ~=? na2 `append` na1 ,"na2 then na2" ~: na2 ~=? na2 `append` na2 ] tests :: Test tests = test ["alphabet" ~: testAlphabets ,"states" ~: testStates ,"identity" ~: testIdentity ,"isDFSM" ~: testIsDFSM ,"normalise" ~: testNormalise ,"wellformed" ~: testIsWellFormed ,"append" ~: testAppend ]