--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PEGFsaGeneratorTest.st Fri Jul 24 15:06:54 2015 +0100
@@ -0,0 +1,466 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PEGFsaGeneratorTest
+ instanceVariableNames:'result node fsa generator interpreter'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-FSA'
+!
+
+
+!PEGFsaGeneratorTest methodsFor:'as yet unclassified'!
+
+assert: anFsa fail: input
+ | stream |
+ stream := input asPetitStream.
+
+ result := interpreter interpret: anFsa on: stream.
+
+ self assert: result isEmpty.
+ ^ result
+!
+
+assert: interpret parse: input
+ ^ self assert: interpret parse: input end: input size
+!
+
+assert: anFsa parse: input end: end
+ | stream |
+ stream := input asPetitStream.
+
+ result := interpreter interpret: anFsa on: stream.
+
+ self assert: result isEmpty not.
+ self assert: (result values anySatisfy: [ :pos | pos = end ]) description: 'wrong position'.
+
+ ^ result
+!
+
+fsaFrom: aNode
+ ^ (aNode accept: generator)
+ compact;
+ yourself
+!
+
+setUp
+ super setUp.
+ generator := PEGFsaGenerator new.
+ interpreter := PEGFsaInterpret new.
+!
+
+testAAA_Aplusnot
+ | parser |
+ parser := 'aaa' asParser not, $a asParser plus.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa fail: ''.
+ self assert: fsa fail: 'aaa'.
+ self assert: fsa fail: 'aaaa'.
+ self assert: fsa fail: 'aaaaa'.
+!
+
+testAAplusA
+ | parser |
+ parser := 'aa' asParser plus, $a asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aaa'.
+ self assert: fsa parse: 'aaaaa'.
+ self assert: fsa parse: 'aaaaaaa'.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaaa'.
+!
+
+testAAplusB
+ | parser |
+ parser := 'aa' asParser plus, $b asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'aab'.
+ self assert: fsa parse: 'aaaab'.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaaa'.
+ self assert: fsa fail: 'aaaac'.
+!
+
+testAB
+ | parser |
+ parser := $a asParser, $b asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'b'.
+ self assert: fsa fail: 'ac'.
+!
+
+testA_Boptional
+ | parser |
+ parser := $a asParser, $b asParser optional.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'ac' end: 1.
+ self assert: fsa parse: 'a'.
+ self assert: fsa fail: 'b'.
+!
+
+testA_Boptionaloptional
+ | parser |
+ parser := ($a asParser, $b asParser optional) optional.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: ''.
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'b' end: 0.
+!
+
+testA_BorC_D
+ | parser |
+ parser := $a asParser, ($b asParser / $c asParser), $d asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'abd'.
+ self assert: fsa parse: 'acd'.
+ self assert: fsa fail: 'abc'.
+ self assert: fsa fail: 'add'.
+ self assert: fsa fail: 'ad'.
+!
+
+testAorAA
+ | parser |
+ parser := 'a' asParser / 'aa' asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'aa' end: 1.
+ self assert: fsa parse: 'aaaaaaa' end: 1.
+ self assert: fsa fail: ''.
+ self assert: fsa fail: 'b'.
+!
+
+testAorAX_X
+ | parser |
+ parser := ('a' asParser / 'ax' asParser), $x asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'ax'.
+ self assert: fsa parse: 'axx' end: 2.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'x'.
+ self assert: fsa fail: ''.
+!
+
+testAorBC_X
+ | parser |
+ parser := ('a' asParser / 'bc' asParser), $x asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'ax'.
+ self assert: fsa parse: 'bcx' end: 3.
+ self assert: fsa fail: 'bx'.
+ self assert: fsa fail: 'cx'.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'bc'.
+!
+
+testAorB_Coptionaloptional
+ | parser |
+ parser := (($a asParser / $b asParser), $c asParser optional) optional.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: ''.
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'b'.
+ self assert: fsa parse: 'ac'.
+ self assert: fsa parse: 'bc'.
+ self assert: fsa parse: 'ad' end: 1.
+ self assert: fsa parse: 'bd' end: 1.
+ self assert: fsa parse: 'd' end: 0.
+ self assert: fsa parse: 'c' end: 0.
+!
+
+testAstarA
+ | parser |
+ parser := $a asParser star, $a asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'aa'.
+ self assert: fsa fail: 'aaa'.
+!
+
+testAstarB
+ | parser |
+ parser := $a asParser star, $b asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'b'.
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'aaab'.
+ self assert: fsa fail: 'a'.
+ self assert: fsa fail: 'ac'.
+ self assert: fsa fail: 'aac'.
+!
+
+testCharSet
+ | parser |
+ parser := #letter asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'z'.
+ self assert: fsa parse: 'A'.
+ self assert: fsa parse: 'Z'.
+ self assert: fsa fail: '_'.
+ self assert: fsa fail: '()'.
+ self assert: fsa fail: ''.
+!
+
+testCharSetPredicateNode
+ node := PPCCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e = $a ]);
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a' end: 1.
+ self assert: fsa parse: 'ab' end: 1.
+ self assert: fsa fail: 'b'.
+!
+
+testCharSetPredicateNode2
+ node := PPCCharSetPredicateNode new
+ predicate: (PPCharSetPredicate on: [ :e | e isDigit ]);
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: '1' end: 1.
+ self assert: fsa parse: '0' end: 1.
+ self assert: fsa parse: '5' end: 1.
+ self assert: fsa fail: 'a'.
+!
+
+testCharacterNode
+ node := PPCCharacterNode new
+ character: $a;
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a' end: 1.
+ self assert: fsa parse: 'ab' end: 1.
+ self assert: fsa fail: 'b'.
+!
+
+testChoiceNode
+ | literal1 literal2 |
+ literal1 := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ literal2 := PPCLiteralNode new
+ literal: 'bar';
+ yourself.
+
+ node := PPCChoiceNode new
+ children: { literal1 . literal2 };
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'foo'.
+ self assert: fsa parse: 'bar'.
+self assert: fsa fail: 'fof'.
+!
+
+testChoicePriorities
+ | parser |
+ parser := ($a asParser optional, $b asParser optional) / $a asParser.
+ node := parser asCompilerTree.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'ab'.
+ self assert: fsa parse: 'a' end: 1.
+ self assert: fsa parse: 'b' end: 1.
+ self assert: fsa parse: ''.
+ self assert: fsa parse: 'c' end: 0.
+!
+
+testLiteralNode
+ node := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'foo' end: 3.
+ self assert: fsa parse: 'foobar' end: 3.
+ self assert: fsa fail: 'fox'.
+ self assert: fsa fail: 'bar'.
+!
+
+testLiteralNode2
+ node := PPCLiteralNode new
+ literal: '';
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: ''.
+!
+
+testNot
+ | parser |
+ parser := 'aaa' asParser not, $a asParser plus.
+ node := parser asCompilerTree.
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'a'.
+ self assert: fsa parse: 'aa'.
+ self assert: fsa fail: 'aaa'.
+ self assert: fsa fail: 'aaaa'.
+ self assert: fsa fail: ''.
+!
+
+testNotNode
+ | literal |
+ literal := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ node := PPCNotNode new
+ child: literal;
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'fo' end: 0.
+ self assert: fsa parse: 'z' end: 0.
+ self assert: fsa parse: 'foO' end: 0.
+ self assert: fsa parse: 'bar' end: 0.
+ self assert: fsa parse: ''.
+ self assert: fsa fail: 'foo'.
+!
+
+testPlusNode
+ | literal |
+ literal := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ node := PPCPlusNode new
+ child: literal;
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa fail: ''.
+ self assert: fsa parse: 'foo'.
+ self assert: fsa parse: 'foofoofoo'.
+!
+
+testSequenceNode
+ | literal1 literal2 |
+ literal1 := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ literal2 := PPCLiteralNode new
+ literal: 'bar';
+ yourself.
+
+ node := PPCSequenceNode new
+ children: { literal1 . literal2 };
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'foobar'.
+ self assert: fsa fail: 'foo'.
+ self assert: fsa fail: 'bar'.
+!
+
+testSequenceNode2
+ | literal1 literal2 literal3 |
+ literal1 := PPCLiteralNode new
+ literal: 'b';
+ yourself.
+ literal2 := PPCLiteralNode new
+ literal: 'a';
+ yourself.
+ literal3 := PPCLiteralNode new
+ literal: 'z';
+ yourself.
+
+ node := PPCSequenceNode new
+ children: { literal1 . literal2 . literal3 };
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: 'baz'.
+ self assert: fsa fail: 'bar'.
+ self assert: fsa fail: 'faz'.
+ self assert: fsa fail: 'boz'.
+!
+
+testStarNode
+ | literal |
+ literal := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ node := PPCStarNode new
+ child: literal;
+ yourself.
+
+ fsa := self fsaFrom: node.
+
+ self assert: fsa parse: ''.
+ self assert: fsa parse: 'foo'.
+ self assert: fsa parse: 'foofoofoo'.
+! !
+
+!PEGFsaGeneratorTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+