--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaTest.st Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,616 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaTest
+ instanceVariableNames:'fsa a b c d e result newFsa'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaTest methodsFor:'as yet unclassified'!
+
+assert: col allSatisfy: block
+ self assert: (col allSatisfy: block).
+!
+
+assert: col anySatisfy: block
+ self assert: (col anySatisfy: block).
+!
+
+setUp
+ a := PEGFsaState new name: #a; retval: #a; yourself.
+ b := PEGFsaState new name: #b; retval: #b; yourself.
+ c := PEGFsaState new name: #c; retval: #c; yourself.
+ d := PEGFsaState new name: #d; retval: #d; yourself.
+ e := PEGFsaState new name: #e; retval: #e; yourself.
+
+ fsa := PEGFsa new.
+!
+
+testBackTransitions
+ fsa addState: a.
+ fsa addState: b.
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: a on: $a.
+ fsa addTransitionFrom: a to: b on: $a.
+
+ result := fsa backTransitions.
+
+ self assert: result size = 1.
+ self assert: result anyOne destination = a.
+!
+
+testBackTransitions2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: a on: $a.
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: c to: a.
+
+ result := fsa backTransitions.
+
+ self assert: result size = 2.
+ self assert: result allSatisfy: [:t | t destination = a ].
+!
+
+testBackTransitions3
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa startState: a.
+ fsa finalState: d.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+ fsa addTransitionFrom: b to: d on: $a.
+ fsa addTransitionFrom: c to: d on: $a.
+ fsa addTransitionFrom: d to: b on: $a.
+ fsa addTransitionFrom: d to: c on: $a.
+ result := fsa backTransitions.
+
+ self assert: result size = 2.
+
+ d transitions allSatisfy: [ :t | result includes: t ].
+!
+
+testBackTransitions4
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+
+ result := fsa backTransitions.
+
+ self assert: result size = 0.
+!
+
+testBackTransitions5
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: c on: $a.
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+
+ result := fsa backTransitions.
+
+ self assert: result size = 0.
+!
+
+testDeterminize
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+
+ fsa determinize.
+
+ self assert: fsa states size = 2.
+ self assert: a transitions size = 1.
+ self assert: a transitions anyOne destination retval = #c.
+!
+
+testDeterminize2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+
+ fsa determinize.
+
+ self assert: fsa states size = 2.
+ self assert: a transitions size = 1.
+ self assert: a transitions anyOne destination retval = #b.
+!
+
+testDeterminize3
+ | merged |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa addState: e.
+
+ fsa startState: a.
+ fsa finalState: e.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+ fsa addTransitionFrom: b to: e on: $e.
+ fsa addTransitionFrom: c to: d on: $d.
+ fsa addTransitionFrom: d to: e on: $e.
+
+ fsa determinize.
+ merged := a transitions anyOne destination.
+
+ self assert: fsa states size = 4.
+ self assert: a transitions size = 1.
+ self assert: merged transitions size = 2.
+ self assert: (merged transitions anySatisfy: [ :t | (t accepts: $d) and: [ t destination = d ]]).
+ self assert: (merged transitions anySatisfy: [ :t | (t accepts: $e) and: [ t destination = e ]]).
+!
+
+testDeterminize4
+ | merged |
+ fsa addState: a.
+ fsa addState: b.
+
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: a on: $a.
+ fsa addTransitionFrom: a to: b on: $a.
+
+ fsa determinize.
+ merged := a transitions anyOne destination.
+
+ self assert: fsa states size = 2.
+ self assert: a transitions size = 1.
+ self assert: merged transitions size = 1.
+ self assert: ((merged name = #'a-b') or: [merged name = #'b-a']).
+ self assert: (merged transitions anySatisfy: [ :t | (t accepts: $a) and: [ t destination = merged ]]).
+!
+
+testDeterminize5
+ | merged |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa startState: a.
+ fsa finalState: d.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: a.
+ fsa addTransitionFrom: b to: c priority: -1.
+ fsa addTransitionFrom: c to: d on: $a.
+ b priority: 0.
+
+ fsa determinize.
+ merged := b transitions anyOne destination.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 3.
+
+
+ self assert: a transitions size = 1.
+ self assert: b transitions size = 1.
+ self assert: (fsa states noneSatisfy: [ :s | s isFinal ]).
+!
+
+testDeterminize6
+ | merged |
+ fsa addState: a.
+ fsa addState: b.
+
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: a on: $a.
+ fsa addTransitionFrom: a to: b on: $a priority: -1.
+
+ fsa determinize.
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 2.
+
+
+ self assert: a transitions size = 1.
+ self assert: a isFinal not.
+
+ merged := a transitions anyOne destination.
+ self assert: merged transitions size = 1.
+ self assert: merged isFinal.
+!
+
+testIsDeterministic
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b on: $b.
+ fsa addTransitionFrom: a to: c on: $c.
+
+ self assert: fsa isDeterministic.
+!
+
+testIsDeterministic2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+
+ self assert: fsa isDeterministic not.
+!
+
+testIsWithoutEpsilons
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b.
+ fsa addTransitionFrom: b to: c on: $c.
+
+ self assert: fsa isWithoutEpsilons not.
+!
+
+testMergeTransitions
+ fsa addState: a.
+ fsa addState: b.
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: b on: $b.
+
+ fsa mergeTransitions.
+
+ self assert: a transitions size = 1.
+ self assert: (a transitions anyOne accepts: $a).
+ self assert: (a transitions anyOne accepts: $b).
+!
+
+testMergeTransitions2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $b.
+
+ fsa mergeTransitions.
+
+ self assert: a transitions size = 2.
+!
+
+testMinimize
+ | merged |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa startState: a.
+ fsa finalState: d.
+
+ fsa addTransitionFrom: a to: b on: $b.
+ fsa addTransitionFrom: a to: c on: $c.
+
+ fsa addTransitionFrom: b to: d on: $a.
+ fsa addTransitionFrom: c to: d on: $a.
+ b retval: nil.
+ c retval: nil.
+
+ fsa minimize.
+
+ self assert: fsa states size = 3.
+ self assert: a transitions size = 1.
+
+ merged := a transitions anyOne destination.
+ self assert: merged transitions size = 1.
+ self assert: merged transitions anyOne destination = d.
+ self assert: (merged transitions anyOne accepts: $a).
+!
+
+testMinimze2
+ | merged |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa addState: e.
+
+ fsa startState: a.
+ fsa finalState: e.
+
+ "states c and d are equivalent"
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $c priority: -1.
+ fsa addTransitionFrom: b to: d on: $d priority: -2.
+ fsa addTransitionFrom: c to: e on: $e priority: -3.
+ fsa addTransitionFrom: d to: e on: $e priority: -4.
+
+ c retval: nil.
+ d retval: nil.
+
+ fsa minimize.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 4.
+
+ self assert: b transitions size = 1.
+
+ merged := b destination.
+ self assert: merged transitions size = 1.
+ self assert: merged destination isFinal.
+!
+
+testRemoveEpsilons
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b.
+ fsa addTransitionFrom: b to: c on: $c.
+
+ fsa removeEpsilons.
+
+ self assert: a transitions size = 1.
+ self assert: b transitions size = 1.
+ self assert: a transitions anyOne isEpsilon not.
+ self assert: (a transitions anyOne accepts: $c).
+ self assert: (fsa isReachableState: c).
+ self assert: (fsa isReachableState: b) not.
+ self assert: fsa isWithoutEpsilons.
+!
+
+testRemoveEpsilons2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b.
+ fsa addTransitionFrom: a to: b on: $b.
+ fsa addTransitionFrom: b to: c on: $c.
+
+ fsa removeEpsilons.
+
+ self assert: a transitions size = 2.
+ self assert: b transitions size = 1.
+ self assert: (a transitions noneSatisfy: [:t | t isEpsilon ]).
+ self assert: (a transitions anySatisfy: [:t | t accepts: $c ]).
+ self assert: (a transitions anySatisfy: [:t | t accepts: $b ]).
+!
+
+testRemoveEpsilons3
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa startState: a.
+ fsa finalState: d.
+
+ fsa addTransitionFrom: a to: b.
+ fsa addTransitionFrom: b to: c.
+ fsa addTransitionFrom: c to: d on: $d.
+
+ fsa removeEpsilons.
+
+ self assert: a transitions size = 1.
+
+ self assert: a transitions anyOne isEpsilon not.
+ self assert: (a transitions anyOne accepts: $d).
+ self assert: (fsa isReachableState: d).
+ self assert: (fsa isReachableState: b) not.
+ self assert: (fsa isReachableState: c) not.
+!
+
+testRemoveEpsilons4
+ fsa addState: a.
+ fsa addState: b.
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: b.
+
+ fsa removeEpsilons.
+
+ self assert: a isFinal.
+!
+
+testRemoveEpsilons5
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+
+
+ fsa startState: a.
+ fsa finalState: d.
+
+ c priority: 0.
+ d priority: 0.
+
+ fsa addTransitionFrom: a to: b priority: -1.
+ fsa addTransitionFrom: a to: c on: $c.
+ fsa addTransitionFrom: b to: d on: $d.
+ fsa addTransitionFrom: c to: d on: $d.
+
+ fsa removeEpsilons.
+
+ self assert: c priority = 0.
+ self assert: d priority = -1.
+ self assert: (a transitions anySatisfy: [:t | t accepts: $d ]).
+!
+
+testRemoveEpsilons6
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa startState: a.
+ fsa finalState: d.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: a.
+ fsa addTransitionFrom: b to: c priority: -1.
+ fsa addTransitionFrom: c to: d on: $b.
+
+ d priority: 0.
+
+ fsa removeEpsilons.
+
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: a transitions size = 1.
+ self assert: b transitions size = 2.
+ self assert: b transitions anySatisfy: [ :t | (t accepts: $a) and: [t destination = b]].
+ self assert: b transitions anySatisfy: [ :t | (t accepts: $b) and: [t destination = d]].
+
+ self assert: d priority = -1.
+!
+
+testRemoveEpsilons7
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa startState: a.
+ fsa finalState: d.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: a.
+
+ fsa removeEpsilons.
+
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: a transitions size = 1.
+ self assert: b transitions size = 1.
+ self assert: (a transitions anyOne == b transitions anyOne) not.
+!
+
+testRemoveLowPriorityTransitions
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ b priority: 0.
+ fsa addTransitionFrom: a to: b on: $a priority: -1.
+ fsa addTransitionFrom: b to: c on: $b priority: -1.
+
+ fsa removeLowPriorityTransitions.
+
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: a transitions size = 1.
+ self assert: b transitions size = 0.
+!
+
+testRemoveUnreachableStates
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: c.
+ fsa addTransitionFrom: b to: c.
+
+ fsa removeUnreachableStates.
+
+ self assert: fsa states size = 2.
+!
+
+testTopologicalOrder
+ | |
+ fsa addState: a.
+ fsa addState: b.
+
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: a on: $a.
+ fsa addTransitionFrom: a to: b on: $a.
+
+ result := fsa topologicalOrder.
+
+ self assert: result first == a.
+ self assert: result second == b.
+! !
+
+!PEGFsaTest methodsFor:'tests - copy'!
+
+testCopy
+ | newA newC |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+
+ fsa finalState: c.
+ fsa startState: a.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $b priority: -1.
+ fsa addTransitionFrom: c to: a priority: -2.
+
+ newFsa := fsa copy.
+
+ self assert: (fsa isIsomorphicTo: newFsa).
+
+ newA := newFsa states detect: [ :s | s canBeIsomorphicTo: a ].
+
+ self assert: newFsa startState = newA.
+ self assert: (a == newA) not.
+ self assert: (newA transitions anyOne canBeIsomorphicTo: a transitions anyOne).
+ self assert: (newA transitions anyOne == a transitions anyOne) not.
+ self assert: newA destination destination destination == newA.
+
+ newC := newA destination destination.
+ self assert: (newC == c) not.
+ self assert: newC isFinal.
+ self assert: newC retval = #c.
+! !
+