--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCOverlappingTokensTest.st Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,192 @@
+"{ 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:'
+! !
+