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

cleanClass
    | parserClass scannerClass |
    parserClass := (Smalltalk at: arguments parserName ifAbsent: [nil]).
    parserClass notNil ifTrue:[ 
        parserClass removeFromSystem
    ].

    scannerClass := (Smalltalk at: arguments scannerName ifAbsent: [nil]).
    scannerClass notNil ifTrue:[ 
        scannerClass removeFromSystem
    ].
!

compileTokenizer: aNode
    tokenizer := visitor visit: aNode	
!

compileTree: root
        
    | configuration  |

    configuration := PPCPluggableConfiguration on: [ :_self | 
        _self cacheFirstFollow.
        _self generateScanner.
        _self generate.
        
    ].
    configuration arguments: arguments.
    configuration base: PPCConfiguration tokenizing.
    parser := configuration compile: root.
    
!

compileWs: aNode
    whitespace := visitor visit: aNode	
!

context	
    ^ context := PPCProfilingContext new
!

setUp
    arguments := PPCArguments default
        profile: true;
        yourself.	

    self cleanClass.
    
    compiler := PPCTokenizingCodeGen new.
    compiler arguments: arguments.
    
    visitor := PPCTokenizingCodeGenerator new.
    visitor compiler: compiler.
    visitor arguments: arguments.
!

tearDown
    "nothing to do now"
! !

!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  tokenNode 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.
        
    tokenNode := PPCListNode new
        children: { token1 . token2 . eof };
        name: 'nextToken';
        yourself.
        
    wsNode := PPCTokenStarSeparatorNode new
        name: 'consumeWhitespace';
        child: PPCNilNode new;
        yourself.
        
    node := PPCTokenizingParserNode new
        tokens: tokenNode;
        whitespace: wsNode;
        parser: choiceNode;
        yourself.
    
    self compileTree: node.
    
    parser := parser class new.
    self assert: parser parse: 'foo'.
    self assert: result inputValue = 'foo'.

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

    parser := parser class new.
    self assert: parser fail: 'baz'.	
!

testTokenizingParserNode
    |  tokenNode tokenizerNode consumeNode eof wsNode |
    tokenNode := (self tokenNodeForLiteral: 'bar') yourself.
    eof := (self tokenNodeForEOF) yourself.	
        
    tokenizerNode := PPCListNode 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;
        tokens: tokenizerNode;
        whitespace: wsNode;
        yourself.

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

    parser := parser class new.
    self assert: parser fail: 'foo'.
!

testTrimmingToken1
    | token tokenConsume tokensNode eof  wsNode |

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

    tokensNode := PPCListNode new
        children: { token . eof };
        name: 'nextToken';
        yourself.
    
    wsNode := PPCTokenStarSeparatorNode new
        name: 'consumeWhitespace';
        child: PPCNilNode new;
        yourself.

    node := PPCTokenizingParserNode new
        tokens: tokensNode;
        whitespace: wsNode;
        parser: tokenConsume;
        yourself.
    
    
    self compileTree: node.

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

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


    parser := parser class new.
    self assert: parser fail: 'baz'.	
! !