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

"{ NameSpace: Smalltalk }"

TestCase subclass:#PPCNodeTest
	instanceVariableNames:'node configuration'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Tests-Nodes'
!


!PPCNodeTest methodsFor:'as yet unclassified'!

testAllNodesDo1
    | node1 node2 parser allChildren |
    node1 := #letter asParser asCompilerNode.
    node2 := #letter asParser asCompilerNode.
    parser := PPChoiceParser new
        setParsers: { node1 . node2 };
        yourself. 
        
    node := PPCUnknownNode new
        parser: parser;
        yourself.

    self assert: node parser children first == node1.
    self assert: node parser children second == node2.	

    allChildren := OrderedCollection new.
    node allNodesDo: [ :e |
        allChildren add: e.
    ].
    self assert: allChildren size = 3.
    
!

testCopy
    | newNode |
    node := PPCDelegateNode new
        child: #foo;
        yourself.
    newNode := node copy.
    self assert: (node = newNode).
    self assert: (node hash = newNode hash).
    
    newNode child: #bar.
    self assert: (node = newNode) not.
!

testCopy2
    |  newNode |
    node := PPCSequenceNode new
        children: { #foo . #bar }
        yourself.
    newNode := node copy.

    self assert: (node = newNode).
    self assert: (node hash = newNode hash).
    
    node children at: 1 put: #zorg.
    self assert: (node = newNode) not.
!

testCopy3
    | newNode |
    node := PPCMessagePredicateNode new
        predicate: #block;
        message: #message;
        yourself.
        
    newNode := node copy.
    
    self assert: (node == newNode) not.
    self assert: (node = newNode).
    self assert: node hash = newNode hash.
!

testCopy4
    | node1 node2 |
    node1 := #letter asParser asCompilerNode.
    node2 := #letter asParser asCompilerNode.
    
    self assert: (node == node2) not.
    self assert: (node1 = node2).
    self assert: node1 hash = node2 hash.
!

testCopy5
    | node1 newNode |
    node1 := #letter asParser asCompilerNode.

    node := PPCUnknownNode new
        parser: node1;
        yourself.

    self assert: node parser == node1.
    newNode := node copy.
    self assert: (newNode parser == node1) not.	
    self assert: newNode parser = node1.	
!

testEquals
    self assert: (PPCNode new = PPCNode new).
!

testEquals2
    | n1 n2 n3 |
    n1 := PPCDelegateNode new
        child: #foo;
        yourself.
    n2 := PPCDelegateNode new
        child: #bar;
        yourself.
    n3 := PPCDelegateNode new
        child: #foo;
        yourself.
        
    self assert: (n1 = n3).
    self assert: (n1 = n2) not.
!

testReplaceNode
    | literalNode anotherLiteralNode |
    literalNode := PPCLiteralNode new
        literal: 'foo';
        yourself.
        
    anotherLiteralNode := PPCLiteralNode new
        literal: 'bar';
        yourself.
        
    node := PPCForwardNode new
        child: literalNode;
        yourself.
    
    self assert: node child == literalNode.
    node replace: literalNode with: anotherLiteralNode.
    self assert: node child == anotherLiteralNode.
    self assert: (node child == literalNode) not.
! !

!PPCNodeTest methodsFor:'test support'!

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

setUp
    configuration := PPCConfiguration default.
    configuration arguments generate: false.
!

treeFrom: parser
    ^ parser compileWithConfiguration: configuration
! !

!PPCNodeTest methodsFor:'tests - converting'!

testConvertBlock
    | parser tree |
    parser := [ :ctx | [ctx atEnd] whileFalse ] asParser.
    tree := parser asCompilerTree.
    
    self assert: tree type: PPCPluggableNode.
        ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[  
    self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'.
        ]

    "Modified: / 05-05-2015 / 16:24:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

testConvertChoice
    | parser tree |
    parser := 'foo' asParser / $b asParser.
    tree := parser asCompilerTree.
    
    self assert: tree type: PPCChoiceNode.
    self assert: tree children size = 2.
    self assert: tree children first type: PPCLiteralNode.
    self assert: tree children second type: PPCCharacterNode.
!

testConvertNil
    | parser tree |
    parser := nil asParser.
    tree := parser asCompilerTree.
    
    self assert: tree type: PPCNilNode.
!

testConvertSequence
    | parser tree |
    parser := 'foo' asParser, $b asParser.
    tree := parser asCompilerTree.
    
    self assert: tree type: PPCSequenceNode.
    self assert: tree children size = 2.
    self assert: tree children first type: PPCLiteralNode.
    self assert: tree children second type: PPCCharacterNode.
!

testConvertToken
    | parser tree |
    parser := 'foo' asParser token.
    tree := parser asCompilerTree.
    
    self assert: tree type: PPCTokenNode.
    self assert: tree child type: PPCLiteralNode.

    parser := ('foo' asParser, $b asParser) token.
    tree := parser asCompilerTree.
    
    self assert: tree type: PPCTokenNode.
    self assert: tree child type: PPCSequenceNode.
    
    parser := $d asParser token star.
    tree := parser asCompilerTree.
    
    self assert: tree type: PPCStarNode.
    self assert: tree child type: PPCTokenNode.
    self assert: tree child child type: PPCCharacterNode.
!

testConvertTrimmingToken
    | parser tree |
    parser := 'foo' asParser trimmingToken.
    tree := self treeFrom: parser.
    
    self assert: tree type: PPCTrimmingTokenNode.
    self assert: tree child type: PPCLiteralNode.
    self assert: tree child isMarkedForInline.
    self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
!

testConvertTrimmingToken2
    | parser tree |
    parser := ('foo' asParser, $b asParser) trimmingToken.
    tree := self treeFrom: parser.
    
    self assert: tree type: PPCTrimmingTokenNode.
    self assert: tree child type: PPCRecognizingSequenceNode.
    self assert: tree whitespace type: PPCTokenStarSeparatorNode.
    self assert: tree whitespace isMarkedForInline.
!

testConvertTrimmingToken3
    | parser tree |
    
    parser := $d asParser trimmingToken star.
    tree := self treeFrom: parser.
    
    self assert: tree type: PPCStarNode.
    self assert: tree child type: PPCTrimmingTokenNode.
    self assert: tree child child type: PPCCharacterNode.	
    self assert: tree child child isMarkedForInline.
! !

!PPCNodeTest methodsFor:'tests - epsilon'!

testActionAcceptsEpsilon
    | tree |
    tree := ('foo' asParser token optional ==> [ :e | e ]) asCompilerTree.
    self assert: tree acceptsEpsilon.
!

testChoiceAcceptsEpsilon
    | tree |
    tree := ($a asParser / $b asParser star) asCompilerTree.
    self assert: tree acceptsEpsilon.
!

testLiteralAcceptsEpsilon
    | tree |
    tree := 'foo' asParser asCompilerTree.
    self assert: tree acceptsEpsilon not.
    
    tree := '' asParser asCompilerTree.
    self assert: tree acceptsEpsilon.
!

testPlusAcceptsEpsilon
    | tree |
    tree := ($b asParser plus) asCompilerTree.
    self assert: tree acceptsEpsilon not.
    
    tree := #letter asParser plus asCompilerTree.
    self assert: tree acceptsEpsilon not.
!

testSequenceAcceptsEpsilon
    | tree parser |
    parser := 'foo' asParser token optional, 'bar' asParser token star, ($a asParser / $b asParser star).
    tree := parser asCompilerTree.
    self assert: tree acceptsEpsilon.
!

testStarAcceptsEpsilon
    | tree |
    tree := $b asParser star asCompilerTree.
    self assert: tree acceptsEpsilon.
!

testTokenAcceptsEpsilon
    | tree |
    tree := ($a asParser / $b asParser plus) token asCompilerTree.
    self assert: tree acceptsEpsilon not.
    
    tree := ($a asParser / $b asParser star) token asCompilerTree.
    self assert: tree acceptsEpsilon.
!

testTrimNode
    | tree |
    tree := $a asParser trim asCompilerTree.
    self assert: tree type: PPCTrimNode.
    self assert: tree child type: PPCCharacterNode.
    self assert: tree trimmer type: PPCStarNode.
! !

!PPCNodeTest methodsFor:'tests - recognized sentences'!

assert: array anySatisfy: block
    self assert: (array anySatisfy: block)
!

testOverlapCharacterNode
    |  node1 node2 |
    node1 := $a asParser asCompilerTree.
    node2 := $b asParser asCompilerTree.
            
    self assert: (node1 overlapsWith: node2) not.
!

testOverlapCharacterNode2
    |  node1 node2 |
    node1 := $a asParser asCompilerTree.
    node2 := $a asParser asCompilerTree.
            
    self assert: (node1 overlapsWith: node2).
!

testOverlapNode1
    |  node1 node2 |
    node1 := $a asParser asCompilerTree.
    node2 := $a asParser asCompilerTree.
            
    self assert: (node1 overlapsWith: node2).
!

testOverlapNode2
    |  node1 node2 |
    node1 := $a asParser asCompilerTree.
    node2 := 'a' asParser asCompilerTree.
            
    self assert: (node1 overlapsWith: node2).
!

testOverlapNode3
    |  node1 node2 |
    node1 := ($a asParser / $b asParser) asCompilerTree.
    node2 := ('c' asParser / 'd' asParser) asCompilerTree.
            
    self assert: (node1 overlapsWith: node2) not.
!

testOverlapNode4
    |  node1 node2 |
    node1 := ($a asParser / $b asParser) asCompilerTree.
    node2 := ('c' asParser / #any asParser) asCompilerTree.
            
    self assert: (node1 overlapsWith: node2).
!

testOverlapNode5
    |  node1 node2 |
    node1 := ($a asParser, $b asParser) asCompilerTree.
    node2 := ('ab' asParser) asCompilerTree.
            
    self assert: (node1 overlapsWith: node2).
!

testOverlapNode6
    |  node1 node2 |
    node1 := ($a asParser, $b asParser, $c asParser) asCompilerTree.
    node2 := ('ab' asParser) asCompilerTree.
            
    self flag: 'Not sure about this test...'.
    self assert: (node1 overlapsWith: node2) not.
!

testOverlapNode7
    |  node1 node2 |
    node1 := ($a asParser) asCompilerTree.
    node2 := (#digit asParser) asCompilerTree.
            
    self assert: (node1 overlapsWith: node2) not.
!

testOverlapNode8
    |  node1 node2 |
    node1 := ($a asParser) asCompilerTree.
    node2 := (#digit asParser plus) asCompilerTree.
            
    self assert: (node1 overlapsWith: node2) not.
!

testOverlapNode9
    |  node1 node2 |
    node1 := ($a asParser) asCompilerTree.
    node2 := (#letter asParser plus) asCompilerTree.
            
    self assert: (node1 overlapsWith: node2).
!

testOverlapTokenNode
    |  node1 node2 |
    node1 := $a asParser token asCompilerTree.
    node2 := $b asParser token asCompilerTree.
            
    self assert: (node1 overlapsWith: node2) not.
!

testOverlapTokenNode2
    |  node1 node2 |
    node1 := $a asParser token asCompilerTree.
    node2 := $a asParser token asCompilerTree.
            
    self assert: (node1 overlapsWith: node2).
!

testOverlapTrimmingTokenNode
    |  node1 node2 |
    node1 := $a asParser token trim asCompilerTree.
    node2 := $b asParser token trim asCompilerTree.
            
    self assert: (node1 overlapsWith: node2) not.
!

testOverlapTrimmingTokenNode1
    |  node1 node2 |
    node1 := PPCTrimmingTokenNode new
        child: (PPCCharacterNode new character: $a; yourself);
        yourself.
    node2 := PPCTrimmingTokenNode new
        child: (PPCCharacterNode new character: $b; yourself);
        yourself.
            
    self assert: (node1 overlapsWith: node2) not.
!

testOverlapTrimmingTokenNode2
    |  node1 node2 |
    node1 := PPCTrimmingTokenNode new
        child: (PPCCharacterNode new character: $a; yourself);
        yourself.
    node2 := PPCTrimmingTokenNode new
        child: (PPCCharacterNode new character: $a; yourself);
        yourself.
            
    self assert: (node1 overlapsWith: node2).
!

testRSCharacterNode
    | sentences |
    node := PPCCharacterNode new 
        character: $f;
        yourself.
        
    self assert: node hasFiniteLanguage.

    sentences := node recognizedSentences.
    self assert: sentences size = 1.
    self assert: sentences anyOne = 'f'.
!

testRSChoiceNode
    | sentences |
    node := ('a' asParser / 'b' asParser) asCompilerTree.
        
    self assert: node hasFiniteLanguage.
        
    sentences := node recognizedSentences.
    self assert: sentences size = 2.
    self assert: sentences anySatisfy: [ :e | e = 'a' ].
    self assert: sentences anySatisfy: [ :e | e = 'b' ].	
!

testRSChoiceNode2
    | sentences |
    node := ('a' asParser / 'a' asParser) asCompilerTree.
        
    self assert: node hasFiniteLanguage.
        
    sentences := node recognizedSentences.
    self assert: sentences size = 1.
    self assert: sentences anySatisfy: [ :e | e = 'a' ].
!

testRSLiteralNode
    | sentences |
    node := PPCLiteralNode new 
        literal: 'foo';
        yourself.
    self assert: node hasFiniteLanguage.
        
    sentences := node recognizedSentences.
    self assert: sentences size = 1.
    self assert: sentences anyOne = 'foo'.
!

testRSPredicateNode
    | sentences |
    node := PPCPredicateNode new 
        predicate: (PPCharSetPredicate on: [:e | e isDigit]);
        yourself.
        
    self assert: node hasFiniteLanguage.
        
    sentences := node recognizedSentences.
    self assert: sentences size = 10.
    self assert: sentences anySatisfy: [ :e | e = '0' ].
!

testRSSequenceNode
    | sentences |
    node := ('a' asParser, 'b' asParser) asCompilerTree.
        
    self assert: node hasFiniteLanguage.
        
    sentences := node recognizedSentences.
    self assert: sentences size = 1.
    self assert: sentences anySatisfy: [ :e | e = 'ab' ].
!

testRSSequenceNode2
    | sentences |
    node := ('a' asParser, ('b' asParser / 'c' asParser)) asCompilerTree.
        
    self assert: node hasFiniteLanguage.
        
    sentences := node recognizedSentences.
    self assert: sentences size = 2.
    self assert: sentences anySatisfy: [ :e | e = 'ab' ].
    self assert: sentences anySatisfy: [ :e | e = 'ac' ].	
!

testRSSequenceNode3
    | sentences |
    node := (#digit asParser, #digit asParser) asCompilerTree.
        
    self assert: node hasFiniteLanguage.
        
    sentences := node recognizedSentences.
    self assert: sentences size = 100.
    self assert: sentences anySatisfy: [ :e | e = '00' ].
    self assert: sentences anySatisfy: [ :e | e = '99' ].	
    self assert: sentences anySatisfy: [ :e | e = '38' ].
    
! !

!PPCNodeTest class methodsFor:'documentation'!

version_HG

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