diff -r f6d77fee9811 -r 1e45d3c96ec5 compiler/tests/PEGFsaInterpretTest.st --- /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' +! ! +