"{ 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 := PPCPluggableConfiguration on: [ :_self | 

    ].

    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 arguments: arguments.

    visitor := PPCTokenizingCodeGenerator new.

    visitor compiler: compiler.

    visitor arguments: arguments.

!

tearDown

! !

!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 := (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.

        children: { token1 . token2 . eof };

        name: 'nextToken';

        yourself.

    wsNode := PPCTokenStarSeparatorNode new

        name: 'consumeWhitespace';

        yourself.

    self assert: parser parse: 'foo'.

    self assert: result inputValue = 'foo'.

    self assert: parser parse: 'bar'.

    self assert: result inputValue = 'bar'.

    self assert: parser fail: 'baz'.	

!

testTokenizingParserNode

    |  tokenNode tokenizerNode consumeNode eof wsNode |

    tokenNode := (self tokenNodeForLiteral: 'bar') yourself.

    eof := (self tokenNodeForEOF) yourself.	

        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;

        whitespace: wsNode;

        yourself.

    self compileTree: node.

    self assert: parser parse: 'bar'.

    self assert: result inputValue = 'bar'.

    self assert: parser fail: 'foo'.

!

testTrimmingToken1

    token := self trimmingTokenNode: (self literalNode: 'foo').

    eof := (self tokenNodeForEOF) yourself.

    tokenConsume := PPCTokenConsumeNode new

                            child: token;

                            yourself.

        children: { token . eof };

        name: 'nextToken';

        yourself.

    wsNode := PPCTokenStarSeparatorNode new

        name: 'consumeWhitespace';

        yourself.

    self assert: parser parse: ' foo'.

    self assert: result inputValue = 'foo'.

    self assert: parser parse: ' foo  '.

    self assert: result inputValue = 'foo'.

    self assert: parser fail: 'baz'.	

! !