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

"{ NameSpace: Smalltalk }"

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


!PPCLL1VisitorTest methodsFor:'as yet unclassified'!

setUp
    visitor := PPCLL1Visitor new.
! !

!PPCLL1VisitorTest methodsFor:'testing'!

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

literalToken: literal
    | literalNode |
    literalNode := PPCLiteralNode new
        literal: literal;
        yourself.
        
    ^ PPCTokenNode new
        child: literalNode;
        yourself
!

testChoiceIsDeterministic
    |   tokenNode1 tokenNode2 literalNode1 literalNode2 |
    literalNode1 := PPCLiteralNode new
        literal: 'foo';
        yourself.	
    literalNode2 := PPCLiteralNode new
        literal: 'bar';
        yourself.	
    tokenNode1 := PPCTokenNode new
        child: literalNode1;
        yourself.
    tokenNode2 := PPCTokenNode new
        child: literalNode2;
        yourself.

    node := PPCChoiceNode new
        children: { tokenNode1 . literalNode1 };
        yourself.	
    self assert: (visitor isDeterministicChoice: node) not.	

    node := PPCChoiceNode new
        children: { tokenNode1 . tokenNode2  };
        yourself.	
    self assert: (visitor isDeterministicChoice: node).	
!

testChoiceIsDeterministic2
    | literalNode tokenNode |
    literalNode := PPCLiteralNode new
        literal: 'foo';
        yourself.	
    tokenNode := PPCTrimmingTokenNode new
        child: literalNode;
        whitespace: PPCSentinelNode new;
        yourself.

    node := PPCChoiceNode new
        children: { tokenNode . literalNode  };
        yourself.	
    self assert: (visitor isDeterministicChoice: node) not.	

    node := PPCChoiceNode new
        children: { tokenNode . tokenNode  };
        yourself.	
    self assert: (visitor isDeterministicChoice: node) not.	
!

testDeterministicChoice1
    | token1 token2 |
    token1 := self literalToken: 'foo'.
    token2 := self literalToken: 'bar'.
    
    node := PPCChoiceNode new
        children: { token1 . token2 }.
        
    result := visitor visit: node.
    
    self assert: result type: PPCDeterministicChoiceNode.
    self assert: result firstChild = token1.
    self assert: result secondChild = token2.
!

testStartsWithToken
    | literalNode tokenNode |
    literalNode := PPCLiteralNode new
        literal: 'foo';
        yourself.	
    tokenNode := PPCTokenNode new
        child: literalNode;
        yourself.

    self assert: (visitor startsWithToken: literalNode) not.
    self assert: (visitor startsWithToken: tokenNode).
    
!

testStartsWithToken2
    | literalNode tokenNode |
    literalNode := PPCLiteralNode new
        literal: 'foo';
        yourself.	
    tokenNode := PPCTokenNode new
        child: literalNode;
        yourself.
    
    self assert: (visitor startsWithToken: (PPCTrimNode new child: literalNode)) not.
    self assert: (visitor startsWithToken: (PPCTrimNode new child: tokenNode)) not.
    
!

testStartsWithToken3
    | literalNode tokenNode ws |
    literalNode := PPCLiteralNode new
        literal: 'foo';
        yourself.	
    tokenNode := PPCTokenNode new
        child: literalNode;
        yourself.
    ws := PPCStarNode new
        child: PPCSentinelNode new;
        yourself.
    
    self assert: (visitor startsWithToken: (PPCTrimmingTokenNode new child: literalNode; whitespace: ws; yourself)).
    self assert: (visitor startsWithToken: (PPCTrimmingTokenNode new child: tokenNode; whitespace: ws; yourself)).
    
! !

!PPCLL1VisitorTest class methodsFor:'documentation'!

version_HG

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