"{ 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> $'

! !