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

"{ NameSpace: Smalltalk }"

PPAbstractParserTest subclass:#PPCTokenizingCodeGeneratorTest
	instanceVariableNames:'visitor node result compiler parser context arguments tokenizer
		whitespace'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Tests-Visitors'
!

!PPCTokenizingCodeGeneratorTest methodsFor:'setup'!

compileTokenizer: aNode
    tokenizer := visitor visit: aNode	
!

compileTree: root
        
    | configuration |

    configuration := PPCPluggableConfiguration on: [ :_self | 
        result := (visitor visit: _self ir).
        compiler compileParser startSymbol: result methodName.
        parser := compiler compileParser new.
        _self ir: parser
    ].
    configuration arguments: arguments.
    parser := configuration compile: root.
    
!

compileWs: aNode
    whitespace := visitor visit: aNode	
!

context	
    ^ context := PPCProfilingContext new
!

setUp
    arguments := PPCArguments default
        profile: true;
        yourself.	
            
    compiler := PPCTokenizingCompiler new.
    compiler arguments: arguments.
    
    visitor := PPCTokenizingCodeGenerator new.
    visitor compiler: compiler.
    visitor arguments: arguments.
!

tearDown
    | class |

    class := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
    class notNil ifTrue:[ 
        class removeFromSystem
    ].
! !

!PPCTokenizingCodeGeneratorTest methodsFor:'support'!

assert: whatever parse: input
    result := super assert: whatever parse: input.
!

assert: whatever recognizesToken: input
    whatever startSymbol: #nextToken.
    
    self assert: whatever parse: input.
    self assert: (result isKindOf: PPToken).
    
    whatever startSymbol: #start
!

assert: whatever rejectsToken: input
    whatever startSymbol: #nextToken.
    
    self assert: whatever fail: input.
    
    whatever startSymbol: #start
!

literalNode: literal
    ^ PPCLiteralNode new
        literal: literal;
        yourself
!

tokenNode: child
    child markForInline.

    ^ PPCTokenNode new
        child: child;
        tokenClass: PPToken;
        yourself
!

tokenNodeForEOF
    | eof |
    eof := PPCEndOfFileNode new
        yourself;
        markForInline.
        
    ^ PPCTokenNode new
        child: eof;
        tokenClass: PPToken;
        yourself.
!

tokenNodeForLiteral: literal
    | literalNode |
    literalNode := self literalNode: literal.
    ^ self trimmingTokenNode: literalNode
!

trimmingTokenNode: child
    | ws |
    ws := PPCStarNode new
        child: (PPCMessagePredicateNode new
            message: #isSeparator ;
            markForInline ;
            yourself);
        yourself.

    child markForInline.
    
    ^ PPCTrimmingTokenNode new
        child: child;
        whitespace: ws;
        tokenClass: PPToken;
        yourself
! !

!PPCTokenizingCodeGeneratorTest methodsFor:'testing'!

testSimpleChoice1
    | token1 token2 token1Consume token2Consume  tokenizerNode eof choiceNode wsNode |

    token1 := (self tokenNodeForLiteral: 'foo') yourself.
    token2 := (self tokenNodeForLiteral: 'bar') yourself.
    eof := (self tokenNodeForEOF) yourself.
    
    token1Consume := PPCTokenConsumeNode new
                            child: token1;
                            yourself.
    token2Consume := PPCTokenConsumeNode new
                            child: token2;
                            yourself.

    choiceNode := PPCDeterministicChoiceNode new
        children: { token1Consume . token2Consume };
        yourself.
        
    tokenizerNode := PPCTokenChoiceNode new
        children: { token1 . token2 . eof };
        name: 'nextToken';
        yourself.
        
    wsNode := PPCTokenStarSeparatorNode new
        name: 'consumeWhitespace';
        yourself.
    
    self compileWs: wsNode.
    self compileTokenizer: tokenizerNode.
    self compileTree: choiceNode.
    
    parser := compiler compiledParser new.
    self assert: parser parse: 'foo'.
    self assert: result inputValue = 'foo'.

    parser := compiler compiledParser new.
    self assert: parser parse: 'bar'.
    self assert: result inputValue = 'bar'.

    parser := compiler compiledParser new.
    self assert: parser fail: 'baz'.	
!

testTokenizingParserNode
    |  tokenNode tokenizerNode consumeNode eof wsNode |
    tokenNode := (self tokenNodeForLiteral: 'bar') yourself.
    eof := (self tokenNodeForEOF) yourself.	
        
    tokenizerNode := PPCTokenChoiceNode new
        children: { tokenNode . eof };
        name: 'nextToken';
        yourself.
    consumeNode := PPCTokenConsumeNode new
                            child: tokenNode;
                            yourself.
    wsNode := PPCTokenStarSeparatorNode new
        name: 'consumeWhitespace';
        child: PPCSentinelNode instance;
        yourself.
    
    node := PPCTokenizingParserNode new
        parser: consumeNode;
        tokenizer: tokenizerNode;
        whitespace: wsNode;
        yourself.

    
    self compileTree: node.
    
    parser := compiler compiledParser new.
    self assert: parser parse: 'bar'.
    self assert: result inputValue = 'bar'.

    parser := compiler compiledParser new.
    self assert: parser fail: 'foo'.
!

testTrimmingToken1
    | token tokenConsume tokenizerNode eof  wsNode |

    token := self trimmingTokenNode: (self literalNode: 'foo').
    eof := (self tokenNodeForEOF) yourself.
    
    tokenConsume := PPCTokenConsumeNode new
                            child: token;
                            yourself.

    tokenizerNode := PPCTokenChoiceNode new
        children: { token . eof };
        name: 'nextToken';
        yourself.
    
    wsNode := PPCTokenStarSeparatorNode new
        name: 'consumeWhitespace';
        yourself.
    
    self compileWs: wsNode.
    self compileTokenizer: tokenizerNode.
    self compileTree: tokenConsume.

    
    parser := compiler compiledParser new.
    self assert: parser parse: ' foo'.
    self assert: result inputValue = 'foo'.

    
    parser := compiler compiledParser new.
    self assert: parser parse: ' foo  '.
    self assert: result inputValue = 'foo'.


    parser := compiler compiledParser new.
    self assert: parser fail: 'baz'.	
! !