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

"{ NameSpace: Smalltalk }"

PPAbstractParserTest subclass:#PPCOverlappingTokensTest
	instanceVariableNames:'parser result context node arguments configuration fooToken
		idToken keywordToken p unaryToken assignmentToken'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Tests-Core-Tokenizing'
!

!PPCOverlappingTokensTest methodsFor:'as yet unclassified'!

assert: p parse: whatever
    ^ result := super assert: p parse: whatever.
!

assert: p parse: whatever end: end
    ^ result := super assert: p parse: whatever end: end
!

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
    ].
!

compile: aPPParser
    parser := aPPParser compileWithConfiguration: configuration
!

context	
    ^ context := PPCProfilingContext new
!

setUp
    arguments := PPCArguments default
        profile: true;
        yourself.
        
    configuration := PPCTokenizingConfiguration new
        arguments: arguments;
        yourself.
        
    self cleanClass.
    
    fooToken := 'foo' asParser token trim name: 'foo'; yourself.
    idToken := (#word asParser plus) token trim name: 'id'; yourself.
    unaryToken := (#word asParser plus, $: asParser not) token trim name: 'unary'; yourself.
    keywordToken := (#word asParser plus, $: asParser) token trim name: 'kw'; yourself.
    assignmentToken := (':=' asParser) token trim name: 'assignment'; yourself.	
!

tearDown
    "self cleanClass"
!

testOverlappingSmalltalkLike
    p := (keywordToken, idToken) star, idToken, assignmentToken, idToken.
    self compile: p.
    
    self assert: parser parse: 'foo: bar 
        id := another'.
    self assert: result first size = 1..
    self assert: result second inputValue = 'id'.
    self assert: result third inputValue = ':='.
    self assert: result last inputValue = 'another'.
!

testOverlappingSmalltalkLike2
    p := (keywordToken, idToken) star, idToken, assignmentToken, idToken.
    self compile: p.
    
    self assert: parser parse: 'foo: bar 
        id:=another'.
    self assert: result first size = 1..
    self assert: result second inputValue = 'id'.
    self assert: result third inputValue = ':='.
    self assert: result last inputValue = 'another'.
    
    self assert: context tokenReadCount == 2 description: 'too many token reads?'. 
!

testOverlappingToken
    p := (unaryToken ==> [ :e | #unary ]) / (keywordToken ==> [:e | #kw ]).
    self compile: p.
    
    self assert: parser parse: 'foo:'.
    self assert: result == #kw.

    self assert: parser parse: 'foo '.
    self assert: result == #unary.	
!

testOverlappingToken2
    p := (idToken ==> [ :e | #id ]) / (keywordToken ==> [:e | #kw ]).
    self compile: p.
    
    self assert: parser parse: 'foo:' end: 3.
    self assert: result == #id.

    self assert: parser parse: 'foo '.
    self assert: result == #id.	
!

testOverlappingToken3
    p := (unaryToken ==> [ :e | #unary ]) / (keywordToken ==> [:e | #kw ]).
    self compile: p.
    
    self assert: parser parse: 'foo:'.
    self assert: result == #kw.

    self assert: parser parse: 'foo '.
    self assert: result == #unary.	
!

testOverlappingTokenStar
    p := (fooToken ==> [ :e | #foo ]) / (idToken ==> [:e | #id ]).
    self compile: p star.
    
    self assert: parser parse: 'foo bar foo bar'.
    self assert: result first = #foo.
    self assert: result second = #id.
    self assert: result third = #foo.
    self assert: result last = #id.
    
    self assert: context tokenReadCount == 1 description: 'too many token reads?'.
!

testOverlappingTokenStar2
    p := (fooToken / idToken).
    self compile: p star.
    
    self assert: parser parse: '  foo   bar    foo bar'.
    self assert: result first inputValue = 'foo'.
    self assert: result second inputValue = 'bar'.
    self assert: result third inputValue = 'foo'.
    self assert: result last inputValue = 'bar'.
    
    self assert: context tokenReadCount == 1 description: 'too many token reads?'.
!

testSanityAsignment
    self compile: assignmentToken.
    self assert: parser parse: ':='.
    self assert: result inputValue = ':='.
    self assert: parser fail: ':f'
!

testSanityFoo
    self compile: fooToken.
    self assert: parser parse: 'foo'.
    self assert: result inputValue = 'foo'.
    self assert: parser parse: 'foobar' end: 3.
    self assert: result inputValue = 'foo'.
    self assert: parser fail: 'bar'.
!

testSanityId
    self compile: idToken.
    self assert: parser parse: 'hi'.
    self assert: result inputValue = 'hi'.
    self assert: parser parse: 'foo'.
    self assert: result inputValue = 'foo'.
    self assert: parser parse: 'hi:' end: 2.
    self assert: result inputValue = 'hi'.
!

testSanityKeyword
    self compile: keywordToken .
    self assert: parser parse: 'hi:'.
    self assert: result inputValue = 'hi:'.
    self assert: parser fail: 'hi'.	
!

testSanityUnary
    self compile: unaryToken.
    self assert: parser parse: 'hi'.
    self assert: result inputValue = 'hi'.
    self assert: parser parse: 'foo'.
    self assert: result inputValue = 'foo'.
    self assert: parser fail: 'hi:'
! !