--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaInterpretTest.st Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,442 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaInterpretTest
+ instanceVariableNames:'fsa a b c result d interpreter e'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-FSA'
+!
+
+!PEGFsaInterpretTest 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.
+ anFsa fixFinalStatePriorities.
+
+ result := interpreter interpret: anFsa on: stream.
+
+ self assert: result isEmpty not.
+ self assert: (result values anySatisfy: [ :pos | pos = end ]) description: 'wrong position'.
+
+ ^ result
+!
+
+assert: anFsa parse: input retval: name
+ ^ self assert: anFsa parse: input retval: name end: input size
+!
+
+assert: anFsa parse: input retval: name end: end
+ | stream |
+ stream := input asPetitStream.
+ anFsa fixFinalStatePriorities.
+
+ result := interpreter interpret: anFsa on: stream.
+
+ self assert: result isEmpty not.
+ self assert: ((result at: name) = end) description: 'wrong position'.
+
+ ^ result
+!
+
+assert: name position: pos
+ ^ self assert: ((result at: name) = pos)
+!
+
+assertFail: name
+ self assert: (result includesKey: name) not
+!
+
+assertPass: name
+ self assert: (result includesKey: name)
+!
+
+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.
+
+ interpreter := PEGFsaInterpret new
+ yourself.
+!
+
+testAB
+ 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: $b.
+
+ self assert: fsa parse: 'ab' retval: #c.
+ self assert: fsa parse: 'abc' retval: #c end: 2.
+
+ self assert: fsa fail: 'ac'.
+!
+
+testABPlus
+ 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: a on: $b.
+ fsa addTransitionFrom: b to: c on: $b.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'ababab'.
+ self assert: fsa parse: 'abababc' end: 6.
+
+ self assert: fsa fail: 'ac'.
+!
+
+testAOptional
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ c priority: -1.
+ b priority: 0.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c priority: -1.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'ab' end: 1.
+ self assert: fsa parse: 'b' end: 0.
+!
+
+testAPlusA
+ 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: c to: d on: $a.
+ fsa addTransitionFrom: c to: d on: $b.
+
+ b priority: 0.
+ d priority: -1.
+ fsa addTransitionFrom: b to: a. "a-loop"
+ fsa addTransitionFrom: b to: c priority: -1. "sequence"
+
+
+ self assert: fsa parse: 'aaab'.
+ self assert: fsa fail: 'aaaa'.
+!
+
+testAPlusB
+ 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: $b.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'aaaab'.
+ self assert: fsa parse: 'abc' end: 2.
+
+ self assert: fsa fail: 'ac'.
+!
+
+testChoice
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ fsa addTransitionFrom: a to: b on: $b.
+ fsa addTransitionFrom: a to: c on: $c.
+
+ self assert: fsa parse: 'b'.
+ self assert: fsa parse: 'c'.
+
+ self assert: fsa fail: 'a'
+!
+
+testChoice2
+ 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.
+
+ self assert: fsa parse: 'a'.
+ self assert: #b position: 1.
+ self assert: #c position: 1.
+
+ self assert: fsa fail: 'b'
+!
+
+testEmpty
+ fsa addState: a.
+ fsa startState: a.
+ fsa finalState: a.
+
+" fsa addTransitionFrom: a to: b.
+"
+ self assert: fsa parse: '' retval: #a.
+!
+
+testEpsilonChoice
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa addState: e.
+ fsa startState: a.
+ fsa finalState: c.
+ fsa finalState: e.
+
+ fsa addTransitionFrom: b to: c on: $c.
+ fsa addTransitionFrom: d to: e on: $e.
+
+ fsa addTransitionFrom: a to: b.
+ fsa addTransitionFrom: a to: d.
+
+ self assert: fsa parse: 'c'.
+ self assert: fsa parse: 'e'.
+
+ self assert: fsa fail: 'a'
+!
+
+testEpsilonChoice2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa addState: e.
+ fsa startState: a.
+ fsa finalState: c.
+ fsa finalState: e.
+
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: d to: e on: $a.
+
+ fsa addTransitionFrom: a to: b.
+ fsa addTransitionFrom: a to: d.
+
+ self assert: fsa parse: 'a'.
+ self assert: #c position: 1.
+ self assert: #e position: 1.
+
+ self assert: fsa fail: 'b'
+!
+
+testOverlap
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ b priority: -1.
+ c priority: -1.
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a priority: -1.
+
+ self assert: fsa parse: 'aa'.
+ self assertPass: #b.
+ self assertPass: #c.
+
+ self assert: fsa parse: 'ac' end: 1.
+ self assertPass: #b.
+ self assertFail: #c.
+!
+
+testOverlap2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ b priority: 0.
+ c priority: -1.
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a priority: -1.
+
+ self assert: fsa parse: 'aa' end: 1.
+ self assertPass: #b.
+ self assertFail: #c.
+
+ self assert: fsa parse: 'ac' end: 1.
+ self assertPass: #b.
+ self assertFail: #c.
+!
+
+testPriorityChoice
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ b priority: 0.
+ c priority: -1.
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: a to: c on: $a priority: -1.
+
+ self assert: fsa parse: 'a'.
+ self assert: #b position: 1.
+ self assert: (result includesKey: #b).
+ self assert: (result includesKey: #c) not.
+
+ self assert: fsa fail: 'b'
+!
+
+testPriorityChoice2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+ fsa finalState: c.
+
+ b priority: -1.
+ c priority: 0.
+ fsa addTransitionFrom: a to: b on: $a priority: -1.
+ fsa addTransitionFrom: a to: c on: $a.
+
+ self assert: fsa parse: 'a'.
+ self assert: #c position: 1.
+ self assert: (result includesKey: #b) not.
+ self assert: (result includesKey: #c).
+
+ self assert: fsa fail: 'b'
+!
+
+testPriorityContinuation
+ 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: b to: c on: $a priority: -1.
+
+ b retval: PEGFsaFailure new.
+ b priority: 0.
+ c priority: -1.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'
+!
+
+testPriorityEpsilonChoice
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa addState: e.
+ fsa startState: a.
+ fsa finalState: c.
+ fsa finalState: e.
+
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: d to: e on: $a.
+
+ c priority: 0.
+ e priority: -1.
+ fsa addTransitionFrom: a to: b.
+ fsa addTransitionFrom: a to: d priority: -1.
+
+ self assert: fsa parse: 'a'.
+ self assert: #c position: 1.
+ self assertPass: #c.
+ self assertFail: #e.
+
+ self assert: fsa fail: 'b'
+!
+
+testPriorityEpsilonChoice2
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa addState: d.
+ fsa addState: e.
+ fsa startState: a.
+ fsa finalState: c.
+ fsa finalState: e.
+
+ fsa addTransitionFrom: b to: c on: $a.
+ fsa addTransitionFrom: d to: e on: $a.
+
+ c priority: -1.
+ e priority: 0.
+ fsa addTransitionFrom: a to: b priority: -1.
+ fsa addTransitionFrom: a to: d.
+
+ self assert: fsa parse: 'a'.
+ self assert: #e position: 1.
+ self assertPass: #e.
+ self assertFail: #c.
+
+ self assert: fsa fail: 'b'
+!
+
+testPriorityReturn
+ fsa addState: a.
+ fsa addState: b.
+ fsa addState: c.
+ fsa startState: a.
+ fsa finalState: b.
+
+ fsa addTransitionFrom: a to: b on: $a.
+ fsa addTransitionFrom: b to: c on: $a.
+
+ b priority: -1.
+ c priority: 0.
+
+ self assert: fsa parse: 'a'.
+ self assert: #b position: 1.
+
+ self assert: fsa fail: 'aa'
+! !
+