--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaSequenceDeterminizationTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,511 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaSequenceDeterminizationTest
+ instanceVariableNames:'fsa a b c result d interpreter e t1 t2 state anotherState parser
+ generator'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaSequenceDeterminizationTest methodsFor:'as yet unclassified'!
+
+assert: anFsa fail: input
+ | stream |
+ stream := input asPetitStream.
+
+ result := interpreter interpret: anFsa on: stream.
+
+ self assert: result isEmpty.
+ ^ result
+!
+
+assert: anFsa parse: input
+ ^ self assert: anFsa parse: input end: input size
+!
+
+assert: anFsa parse: input end: end
+ | stream |
+ stream := input asPetitStream.
+
+ result := interpreter interpret: anFsa on: stream.
+
+ self assert: result size = 1.
+ self assert: ((result anyOne) = end) description: 'wrong position'.
+
+ ^ result anyOne
+!
+
+determinizator
+ ^ PEGFsaSequenceDeterminizator new
+!
+
+determinize: anFsa
+ ^ self determinizator determinize: anFsa
+!
+
+fsaFrom: aNode
+ ^ (aNode accept: generator)
+ yourself
+!
+
+joinState: s1 with: s2
+ ^ self determinizator joinState: s1 with: s2
+!
+
+setUp
+ a := PEGFsaState new name: #a; retval: #token; yourself.
+ b := PEGFsaState new name: #b; retval: #token; yourself.
+ c := PEGFsaState new name: #c; retval: #token; yourself.
+ d := PEGFsaState new name: #d; retval: #token; yourself.
+ e := PEGFsaState new name: #e; retval: #token; yourself.
+
+ state := PEGFsaState new name: #state; retval: #token; yourself.
+ anotherState := PEGFsaState new name: #anotherState; retval: #token; yourself.
+
+ t1 := PEGFsaCharacterTransition new.
+ t2 := PEGFsaCharacterTransition new.
+
+ fsa := PEGFsa new.
+ generator := PEGFsaGenerator new.
+
+ interpreter := PEGFsaInterpret new
+ yourself.
+! !
+
+!PEGFsaSequenceDeterminizationTest methodsFor:'tests'!
+
+testAAplusA
+ parser := 'aa' asParser plus, 'a' asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaaa'.
+
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa parse: 'aaaaa'.
+ self assert: fsa parse: 'aaaaaaa'.
+!
+
+testAB
+ parser := $a asParser, $b asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+ self assert: fsa states size = 3.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa startState destination isFinal not.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'abc' end: 2.
+
+ self assert: fsa fail: 'ac'.
+!
+
+testAPlusA
+ parser := $a asParser plus, $a asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+" self assert: fsa states size = 2."
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'b'.
+!
+
+testAPlusB
+ parser := $a asParser plus, $b asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+
+ self assert: fsa states size = 3.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'aaaab'.
+ self assert: fsa parse: 'aaaabc' end: 5.
+
+ self assert: fsa fail: 'b'.
+!
+
+testApriorityOrA
+ parser := $a asParser / $a asParser.
+ fsa := self fsaFrom: parser asCompilerTree.
+
+ self determinize: fsa.
+
+ self assert: fsa states size = 2.
+ self assert: fsa isDeterministic.
+ self assert: fsa isWithoutEpsilons.
+ self assert: fsa finalStates size = 1.
+ self assert: fsa finalStates anyOne isMultivalue not.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa fail: 'b'.
+!
+
+testDeterminizeFsa
+ 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 determinize: fsa.
+
+ self assert: fsa states size = 2.
+ self assert: a transitions size = 1.
+!
+
+testDeterminizeFsa2
+ | |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+ fsa finalState: d.
+
+ a priority: 0.
+ b priority: 0.
+ c priority: 0.
+ d priority: 0.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: c to: d on: $a.
+
+ fsa addTransitionFrom: b to: a on: $a.
+ fsa addTransitionFrom: c to: a on: $a.
+ fsa addTransitionFrom: d to: a on: $a.
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+!
+
+testDeterminizeFsa3
+ | 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.
+
+ self determinize: fsa.
+
+ 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 ]]).
+!
+
+testDeterminizeFsa4
+ | 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.
+
+ b priority: -1.
+ a priority: 0.
+
+ self determinize: fsa.
+ merged := a 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 ]]).
+!
+
+testDeterminizeFsa5
+ | 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.
+ fsa addTransitionFrom: c to: d on: $a.
+ b priority: 0.
+ d priority: -1.
+
+ self determinize: fsa.
+
+ merged := b 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 ]).
+!
+
+testDeterminizeFsa6
+ | merged |
+ 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 priority: -1.
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 2.
+
+ self assert: a transitions size = 1.
+ self assert: a isFinal not.
+
+ merged := a destination.
+ self assert: merged isFinal.
+ self assert: merged priority = 0.
+!
+
+testDeterminizeFsa7
+ | merged |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a priority: -1.
+
+ b priority: 0.
+ c priority: -1.
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+ self assert: fsa states size = 2.
+
+ self assert: a transitions size = 1.
+ self assert: a isFinal not.
+
+ merged := a destination.
+ self assert: merged isFinal.
+ self assert: merged priority = 0.
+!
+
+testDeterminizeFsa8
+ | |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ a priority: 0.
+ b priority: 0.
+ c priority: 0.
+
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a.
+
+ fsa addTransitionFrom: b to: a on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+
+ fsa addTransitionFrom: c to: a on: $a.
+ fsa addTransitionFrom: c to: b on: $a.
+
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+!
+
+testDeterminizeFsa9
+ | |
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+ fsa finalState: d.
+
+ a priority: 0.
+ b priority: 0.
+ c priority: 0.
+ d priority: 0.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: c to: d on: $a.
+
+ fsa addTransitionFrom: b to: a on: $a.
+ fsa addTransitionFrom: c to: a on: $a.
+ fsa addTransitionFrom: d to: a on: $a.
+
+ self determinize: fsa.
+ self assert: fsa isDeterministic.
+! !
+
+!PEGFsaSequenceDeterminizationTest methodsFor:'tests - joining'!
+
+testJoinState
+ | newState |
+ state addTransition: t1.
+ anotherState addTransition: t2.
+ state final: true.
+
+ t1 destination: (PEGFsaState named: #t1).
+ t2 destination: (PEGFsaState named: #t2).
+
+ newState := self joinState: state with: anotherState.
+
+ self assert: (newState transitions contains: [ :t | t = t1 ]).
+ self assert: (newState transitions contains: [ :t | t = t2 ]).
+ self assert: (newState isFinal).
+!
+
+testJoinState2
+ | newState |
+ state addTransition: t1.
+ anotherState addTransition: t2.
+ state final: true.
+
+ t1 destination: (PEGFsaState named: #t1).
+ t2 destination: (PEGFsaState named: #t2).
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState transitions contains: [ :t | t = t1 ]).
+ self assert: (newState transitions contains: [ :t | t = t2 ]).
+ self assert: (newState isFinal).
+!
+
+testJoinState3
+ | newState |
+ state final: true.
+ state retval: #foo.
+ state priority: -1.
+
+ anotherState final: true.
+ anotherState retval: #foo.
+ anotherState failure: true.
+ anotherState priority: 0.
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState isMultivalue not).
+ self assert: (newState retval value = #foo).
+ self assert: (newState isFinal).
+ self assert: (newState priority = 0).
+ self assert: (newState isFsaFailure).
+!
+
+testJoinState5
+ | newState |
+ state final: true.
+ state retval: #foo.
+ state priority: 0.
+
+ anotherState final: true.
+ anotherState retval: #foo.
+ anotherState priority: -1.
+
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState retval = #foo).
+ self assert: (newState isFinal).
+ self assert: (newState priority = 0).
+!
+
+testJoinState6
+ | newState |
+ state final: true.
+ state priority: 0.
+
+ anotherState final: true.
+ anotherState priority: -1.
+ anotherState failure: true.
+
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState isMultivalue not).
+ self assert: (newState isFinal).
+ self assert: (newState priority = 0).
+ self assert: (newState isFsaFailure not).
+!
+
+testJoinState7
+ | newState |
+ state final: true.
+ state retval: #foo.
+ state priority: -1.
+
+ anotherState final: true.
+ anotherState retval: #foo.
+ anotherState failure: true.
+ anotherState priority: 0.
+
+ newState := self joinState: anotherState with: state.
+
+ self assert: (newState isMultivalue not).
+ self assert: (newState retval value = #foo).
+ self assert: (newState isFinal).
+ self assert: (newState priority = 0).
+ self assert: (newState isFsaFailure).
+! !
+