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

"{ NameSpace: Smalltalk }"

TestCase subclass:#PPCInliningVisitorTest
	instanceVariableNames:'node result visitor'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Tests-Visitors'
!

!PPCInliningVisitorTest methodsFor:'as yet unclassified'!

assert: object type: class
    self assert: object class == class
!

setUp
    visitor := PPCInliningVisitor new.
!

testCharacterNode
    node := PPCCharacterNode new
        character: $a;
        yourself.
    result := visitor visit: node.
    
    self assert: result type: PPCCharacterNode.
    self assert: result isMarkedForInline not.
    self assert: result character = $a.
!

testCharacterNode2
    | charNode |
    charNode := PPCCharacterNode new
        character: $a;
        yourself.
    node := PPCStarNode new
        child: charNode;
        yourself.
    result := visitor visit: node.
    
    self assert: result child type: PPCCharacterNode.
    self assert: result child isMarkedForInline.
    self assert: result child character = $a.
!

testLiteralNode
    | literalNode |
    literalNode := PPCLiteralNode new
        literal: 'foo';
        yourself.
    node := PPCOptionalNode new
        child: literalNode;
        yourself.

    result := visitor visit: node.
    
    self assert: result child type: PPCLiteralNode.
    self assert: result child isMarkedForInline.
    self assert: result child literal = 'foo'.
!

testNil
    node := PPCNilNode new.
    result := visitor visit: node.

    self assert: result type: PPCNilNode.
    self assert: result isMarkedForInline not.
!

testNil2
    node := PPCStarNode new
        child: PPCNilNode new;
        yourself.
    result := visitor visit: node.

    self assert: result type: PPCStarNode.
    self assert: result child type: PPCNilNode.
    self assert: result child isMarkedForInline.
!

testNotLiteralNode
    | notLiteralNode |

    notLiteralNode := PPCNotLiteralNode new
        literal: 'foo';
        yourself.

    node := PPCOptionalNode new
        child: notLiteralNode;
        yourself.

    result := visitor visit: node.
    
    self assert: result child type: PPCNotLiteralNode.
    self assert: result child isMarkedForInline.
    self assert: result child literal = 'foo'.
!

testPluggable
    | pluggableNode |
    pluggableNode := PPCPluggableNode new
        block: [:ctx | nil] asParser.
    node := PPCSequenceNode new
        children: { pluggableNode  };
        yourself.

    result := visitor visit: node.
        
    ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[  
        self skipIf: true description: 'skipped test, inlining of pluggable nodes not supported!!'.
    ].

    self assert: result children first type: PPCPluggableNode.
    self assert: result children first isMarkedForInline.

    "Modified: / 01-05-2015 / 14:22:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testSequenceInline
    | charNode1 charNode2 |
    charNode1 := PPCCharacterNode new
        character: $a;
        yourself.
    charNode2 := PPCCharacterNode new
        character: $b;
        yourself.

    node := PPCSequenceNode new
        children: { charNode1 . charNode2 };
        yourself.
    result := visitor visit: node.
    
    self assert: result type: PPCSequenceNode .
    self assert: result children first type: PPCCharacterNode.
    self assert: result children second type: PPCCharacterNode.	
!

testTokenStarMessagePredicateNode
    | tokenNode |
    tokenNode := (PPCTokenStarMessagePredicateNode new)
        child: PPCSentinelNode new;
        yourself.
    node := PPCForwardNode new
        child: tokenNode;
        yourself.	
    result := visitor visit: node.
    
    self assert: result child type: PPCTokenStarMessagePredicateNode.
    self assert: result child isMarkedForInline.
!

testTokenStarSeparatorNode
    | tokenNode |
    tokenNode := (PPCTokenStarSeparatorNode new)
        name: #name;
        message: #message;
        child: PPCNilNode new;
        yourself.

    node := PPCForwardNode new
        child: tokenNode;
        yourself.	

        
    result := visitor visit: node.
    
    self assert: result child type: PPCTokenStarSeparatorNode.
    self assert: result child isMarkedForInline.
    self assert: result child child type: PPCNilNode.
! !