"{ Package: 'stx:goodies/petitparser/compiler/tests' }"

"{ NameSpace: Smalltalk }"

TestCase subclass:#PPCTokenDetectorTest

	instanceVariableNames:'node result visitor'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Tests-Visitors'

!

!PPCTokenDetectorTest methodsFor:'as yet unclassified'!

assert: object type: class

    self assert: object class == class

!

setUp

    visitor := PPCTokenDetector new.

!

testNestedTrimmingTokenJava

    |  trueToken falseToken booleanLiteral literal abc notBoolean id idSeq javaToken resultId resultBooleanLiteral resultIdBooleanLiteral |

    "

     This USE case is based on JavaToken

     javaToken := id / literal

     id := (not booleanLiteral, 'abc') token

     literal := booleanLiteral

     booleanLiteral := 'true' token / 'false' token

    "

    trueToken := 'true' asParser token asCompilerTree.

    falseToken := 'false' asParser token asCompilerTree.

    abc := 'abc' asParser asCompilerTree.

    booleanLiteral := PPCChoiceNode new

        children: { trueToken . falseToken }; yourself.

    literal := PPCForwardNode new

        name: #literal;

        child: booleanLiteral; yourself.

    notBoolean := PPCNotNode new

        child: booleanLiteral; yourself.

    idSeq := PPCSequenceNode new

        children: { notBoolean . abc }; yourself.

    id := PPCTokenNode new

        child: idSeq; yourself.

    javaToken := PPCChoiceNode new

        children: { id . literal }; yourself.

    result := visitor visit: javaToken.	

    resultId := result firstChild.

    resultBooleanLiteral := result secondChild child.	

    resultIdBooleanLiteral := resultId child firstChild  child.	

    self assert: result type: PPCChoiceNode.

    self assert: resultId type: PPCTokenNode.

    self assert: resultBooleanLiteral type: PPCChoiceNode.

    self assert: resultIdBooleanLiteral firstChild type: PPCLiteralNode.

    self assert: resultIdBooleanLiteral secondChild type: PPCLiteralNode.

    self assert: resultBooleanLiteral firstChild type: PPCTokenNode.

    self assert: resultBooleanLiteral secondChild type: PPCTokenNode.

!

testToken

    | characterNode token |

    characterNode := PPCCharacterNode new.

    token := PPCTokenNode new 

        child: characterNode;

        tokenClass: #foo;

        yourself.

    node := PPCForwardNode new

        child: token;

        yourself.	

    result := visitor visit: node.

    self assert: result type: PPCForwardNode.

    self assert: result child type: PPCTokenNode.

    self assert: result child child = characterNode.

!

testToken2

    | characterNode  inToken forwardNode |

    characterNode := PPCCharacterNode new.

    forwardNode := PPCForwardNode new

        child: characterNode;

        yourself.	

    inToken := PPCTokenNode new 

        child: forwardNode;

        tokenClass: #foo;

        name: 'inToken';

        yourself.

    node := PPCTokenNode new

        child: inToken	;

        tokenClass: #bar;

        name: 'token';

        yourself.

    result := visitor visit: node.

    self assert: result type: PPCTokenNode.

    self assert: result child type: PPCForwardNode.

    self assert: result child name = 'inToken'.

    self assert: result child child = characterNode.

!

testToken3

    | characterNode  inToken forwardNode |

    characterNode := PPCCharacterNode new.

    forwardNode := PPCForwardNode new

        child: characterNode;

        name: 'forward';

        yourself.	

    inToken := PPCTokenNode new 

        child: forwardNode;

        tokenClass: #foo;

        name: 'inToken';

        yourself.

    node := PPCTokenNode new

        child: inToken	;

        tokenClass: #bar;

        name: 'token';

        yourself.

    result := visitor visit: node.

    self assert: result type: PPCTokenNode.

    self assert: result child type: PPCForwardNode.

    self assert: result child name = 'inToken'.

    self assert: result child child type: PPCForwardNode.

    self assert: result child child name = 'forward'.

!

testTrimToken1

    | literalNode tokenNode |

    literalNode := PPCLiteralNode new

        literal: 'foo'.

    tokenNode := PPCTokenNode new

        child: literalNode; 

        tokenClass: #foo;

        yourself.

    node := PPCTrimNode new 

        child: tokenNode;

        yourself.

    result := visitor visit: node.

    self assert: result type: PPCTrimmingTokenNode.

    self assert: result whitespace type: PPCStarNode.

    self assert: result tokenClass = #foo.

    self assert: result child type: PPCLiteralNode.

    self assert: result child literal = 'foo'.

!

testTrimmingToken

    | seq characterNode ws token |

    characterNode := PPCCharacterNode new.

    token := PPCTokenNode new 

        child: characterNode;

        tokenClass: #foo;

        yourself.

    ws := PPCSentinelNode new.

    seq := PPCSequenceNode new

        children: { ws . token . ws };

        yourself.

    node := PPCActionNode new

        child: seq;

        propertyAt: #trimmingToken put: true;

        yourself.

    result := visitor visit: node.

    self assert: result type: PPCTrimmingTokenNode.

    self assert: result child type: PPCCharacterNode.

    self assert: result child = characterNode.

    self assert: result whitespace type: PPCSentinelNode.

!

testTrimmingToken2

    | seq characterNode ws token tokenIn |

    characterNode := PPCCharacterNode new.

    tokenIn := PPCTokenNode new 

        child: characterNode;

        tokenClass: #foo;

        yourself.

    token := PPCTokenNode new

        child: tokenIn;

        tokenClass: #bar;

        yourself.

    ws := PPCSentinelNode new.

    seq := PPCSequenceNode new

        children: { ws . token . ws };

        yourself.

    node := PPCActionNode new

        child: seq;

        propertyAt: #trimmingToken put: true;

        yourself.

    result := visitor visit: node.

    self assert: result type: PPCTrimmingTokenNode.

    self assert: result child type: PPCCharacterNode.

    self assert: result child = characterNode.

    self assert: result whitespace type: PPCSentinelNode.

! !