"{ 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.
! !

!PPCTokenDetectorTest class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !