"{ 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)

        determinize;

        minimize;

        yourself

!

setUp

    super setUp.

    generator := PEGFsaGenerator new.

    interpreter := PEGFsaInterpret new.	

! !

!PEGFsaGeneratorTest methodsFor:'basic'!

testAnyNode

    node := PPCAnyNode new

        yourself.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'a'.

    self assert: fsa parse: 'b'.

    self assert: fsa parse: String cr.

    self assert: fsa parse: String tab.

!

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'.		

!

testEndOfFileNode

    node := PPCEndOfFileNode new

        yourself.

    fsa := self fsaFrom: node.

    self assert: fsa parse: '' end: 1.

    self assert: fsa fail: 'a'.	

!

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: ''.

!

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'.				

!

testSequenceNode3

    | literal1 literal2 literal3 choice |

    literal1 := PPCLiteralNode new

        literal: 'a';

        yourself.

    literal2 := PPCLiteralNode new

        literal: 'b';

        yourself.

    literal3 := PPCLiteralNode new

        literal: 'c';

        yourself.

    choice := PPCChoiceNode new

        children: { literal1 . literal2 };

        yourself.

    node := PPCSequenceNode new

        children: { choice . literal3 };

        yourself.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'ac'.

    self assert: fsa parse: 'bc'.

    self assert: fsa fail: 'a'.	

    self assert: fsa fail: 'b'.		

    self assert: fsa fail: 'c'.		

!

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 methodsFor:'complex'!

testAAAAnot_Astar

    | parser |

    parser := 'aaaa' asParser not, ($a asParser star).

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: ''.	

    self assert: fsa parse: 'a'.	

    self assert: fsa parse: 'aa'.	

    self assert: fsa parse: 'aaa'.

    self assert: fsa fail: 'aaaa'.

    self assert: fsa fail: 'aaaaa'.

    self assert: fsa fail: 'aaaaaa'.

    self assert: fsa fail: 'aaaaaaa'.

!

testAAAAorA_AA

    | parser |

    parser := ('aaaaa' asParser / 'a' asParser), 'aa' asParser.

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'aaaaaaa'.	

    self assert: fsa parse: 'aaa'.	

    self assert: fsa parse: 'aaaa' end: 3.

    self assert: fsa fail: 'a'.

    self assert: fsa fail: 'aa'.

    self assert: fsa fail: 'aaaaa'.

    self assert: fsa fail: 'aaaaaa'.

!

testAAAnot_Aplus

    | 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'.

!

testAAAorA_A

    | parser |

    parser := ('aaa' asParser / 'a' asParser), 'a' asParser.

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'aaaa'.	

    self assert: fsa parse: 'aa'.

    self assert: fsa fail: 'aaa'.

    self assert: fsa fail: 'a'.

!

testAAAorA_AA

    | parser |

    parser := ('aaa' asParser / 'a' asParser), 'aa' asParser.

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'aaaaa'.	

    self assert: fsa parse: 'aaaaaa' end: 5.	

    self assert: fsa parse: 'aaaaaaa' end: 5.	

    self assert: fsa fail: 'a'.

    self assert: fsa fail: 'aa'.

    self assert: fsa fail: 'aaa'.

    self assert: fsa fail: 'aaaa'.

!

testAAAorA_Astar

    | parser |

    ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[  

        self skipIf: true description: 'JK, remove this once fixed'.

    ].   

    parser := (('aaa' asParser / 'a' asParser), 'a' asParser) star.

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: ''.

    self assert: fsa parse: 'aa'.

    self assert: fsa parse: 'aaaa'.     

    self assert: fsa parse: 'aaaaaa'.   

    self assert: fsa parse: 'aaaaaaaa'.         

    "So far the FSA cannot handle loops with such as tokens as aaa/a, a"

    self flag: 'not working :('.

    self assert: fsa parse: 'aaaaaaa' end: 4.   

    self assert: fsa fail: 'aaa'.

    self assert: fsa fail: 'a'.

    "Modified: / 08-09-2015 / 01:52:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

testAAAstar_AA

    | parser |

    parser := ('aaa' asParser) star, 'aa' asParser.

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'aa'.

    self assert: fsa parse: 'aaaaa'.	

    self assert: fsa parse: 'aaaaaaaa'.

    self assert: fsa fail: 'a'.

    self assert: fsa fail: 'aaa'.

    self assert: fsa fail: 'aaaa'.

    self assert: fsa fail: 'aaaaaaa'.

!

testAAorA_A

    | parser |

    parser := ('aa' asParser / 'a' asParser), 'a' asParser.

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'aaa'.	

    self assert: fsa fail: 'aa'.

    self assert: fsa fail: 'a'.

!

testAAorA_AAorA

    | parser |

    parser := ('aa' asParser / 'a' asParser), ('aa' asParser / 'a' asParser).

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'aaaa'.	

    self assert: fsa parse: 'aaa'.	

    self assert: fsa fail: ''.

    self assert: fsa fail: 'a'.

    self assert: fsa fail: 'aa'.

!

testAAorA_A_B

    | parser |

    parser := ('aa' asParser / 'a' asParser), 'a' asParser, 'b' asParser.

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'aaab'.	

    self assert: fsa fail: 'aab'.

!

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_Bnot

    | parser |

    parser := $a asParser, $b asParser not.

    node := parser asCompilerTree.

    fsa := self fsaFrom: node.

    self assert: fsa parse: 'a'.

    self assert: fsa parse: 'ac' end: 1.	

    self assert: fsa parse: 'aaa' end: 1.	

    self assert: fsa fail: 'ab'.

    self assert: fsa fail: 'b'.

!