--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCTokenizingTest.st Thu May 21 14:12:22 2015 +0100
@@ -0,0 +1,389 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCTokenizingTest
+ instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3
+ arguments configuration'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Tests-Core-Tokenizing'
+!
+
+!PPCTokenizingTest 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 |
+ parserClass := (Smalltalk at: arguments name ifAbsent: [nil]).
+ parserClass notNil ifTrue:[
+ self flag: 'uncomment'.
+" parserClass removeFromSystem"
+ ].
+!
+
+context
+ ^ context := PPCProfilingContext new
+!
+
+parse: whatever
+ ^ result := super parse: whatever.
+!
+
+setUp
+ arguments := PPCArguments default
+ profile: true;
+ yourself.
+
+ configuration := PPCTokenizingConfiguration new
+ arguments: arguments;
+ yourself.
+
+ self cleanClass.
+!
+
+tearDown
+ self cleanClass
+!
+
+testChoiceOrder
+ parser := (
+ 'a' asParser token, 'b' asParser token /
+ 'a' asParser token)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'b'.
+
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+
+ self assert: parser fail: '_'.
+
+!
+
+testChoiceOrder2
+ | p1 p2 |
+ p1 := 'a' asParser token, 'b' asParser token.
+ p2 := 'b' asParser token / 'a' asParser token.
+
+ parser := p1 / p2 compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'b'.
+
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+
+ self assert: parser parse: 'b'.
+ self assert: result inputValue = 'b'.
+
+ self assert: parser fail: 'c'.
+
+!
+
+testChoiceOrder3
+ | p1 p2 a1 a2 |
+ a1 := 'a' asParser token name: 't1'; yourself.
+ a2 := 'a' asParser token name: 't2'; yourself.
+
+ p1 := a1, 'b' asParser token.
+ p2 := a2.
+
+ parser := p1 / p2 compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'b'.
+
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+
+ self assert: parser fail: 'b'.
+
+!
+
+testChoiceOrder4
+ | p1 p2 a1 a2 |
+ a1 := 'a' asParser token name: 't1'; yourself.
+ a2 := 'a' asParser token name: 't2'; yourself.
+
+ p1 := a1, 'b' asParser token.
+ p2 := 'b' asParser token / a2.
+
+ parser := p1 / p2 compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'ab'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'b'.
+
+ self assert: parser parse: 'a'.
+ self assert: result inputValue = 'a'.
+
+ self assert: parser parse: 'b'.
+ self assert: result inputValue = 'b'.
+
+ self assert: parser fail: 'c'.
+
+!
+
+testCompileAnd
+ parser := (('foo' asParser token and) / ('bar' asParser token and)), 'bar' asParser token
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'bar'.
+ self assert: result second inputValue = 'bar'.
+!
+
+testCompileChoice
+ parser := ('foo' asParser / 'bar' asParser) token compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
+ self assert: parser fail: '_'.
+
+!
+
+testCompileChoice2
+ parser := ('foo' asParser token trim / 'bar' asParser token trim) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser parse: 'bar'.
+ self assert: result inputValue = 'bar'.
+ self assert: parser fail: '_'.
+
+!
+
+testCompileComplex1
+ parser := ('foo' asParser token, 'bar' asParser token) /
+ ('foo' asParser token, 'baz' asParser token) compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foobar'.
+ self assert: result second inputValue = 'bar'.
+
+ self assert: parser parse: 'foobaz'.
+ self assert: result second inputValue = 'baz'.
+
+ self assert: parser fail: 'foobaq'.
+
+!
+
+testCompileComplex2
+ parser := ('foo' asParser token, 'bar' asParser token) star, 'foo' asParser token
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foobarfoobarfoo'.
+ self assert: parser parse: 'foo'.
+
+ self assert: parser fail: 'bar'.
+
+!
+
+testCompileComplex3
+ parser := ('foo' asParser token, 'bar' asParser token) star, 'foo' asParser token /
+ ('foo' asParser token, 'baz' asParser token)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foobarfoobarfoo'.
+ self assert: parser parse: 'foo'.
+
+ self assert: parser fail: 'bar'.
+
+!
+
+testCompileLiteral
+ parser := 'foo' asParser token compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+ self assert: parser fail: 'boo'.
+!
+
+testCompileSequence
+ parser := ('foo' asParser token), ('bar' asParser token)
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foobar'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'bar'.
+!
+
+testCompileStar
+ parser := 'foo' asParser token star compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result first inputValue = 'foo'.
+
+ self assert: parser parse: 'boo' end: 0.
+ self assert: result isEmpty.
+!
+
+testCompileStar2
+ parser := ('foo' asParser token, 'bar' asParser token) star compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foobar'.
+ self assert: context tokenReads size = 3.
+
+ self assert: parser parse: 'bar' end: 0.
+ self assert: result isEmpty.
+ self assert: context tokenReads size = 1.
+
+!
+
+testCompileTokenComplex2
+ | a b argumentsWith |
+ "based on the PPSmalltlakGrammar>>blockArgumentsWith"
+ a := $| asParser smalltalkToken
+ yourself.
+ b := $] asParser smalltalkToken
+ yourself.
+ argumentsWith := (a / b and ==> [:t | ]) wrapped
+ name: 'argumentsWith';
+ yourself.
+
+ parser := argumentsWith compileWithConfiguration: configuration.
+ self assert: parser parse: '|'.
+
+ parser := argumentsWith compileWithConfiguration: configuration.
+ self assert: parser parse: ']'.
+!
+
+testCompileTokenComplex3
+ | choice1 choice2 a1 b1 a2 b2 tricky |
+ a1 := $| asParser token
+ yourself.
+ b1 := $] asParser token
+ yourself.
+ choice1 := (a1 / b1) wrapped
+ name: 'choice1';
+ yourself.
+
+ a2 := $| asParser token
+ yourself.
+ b2 := $] asParser token
+ yourself.
+ choice2 := (a2 / b2) wrapped
+ name: 'choice1';
+ yourself.
+
+ tricky := (a1 asParser, choice1) / (b2 asParser, choice2).
+
+ parser := tricky compileWithConfiguration: configuration.
+ self assert: parser parse: '||'.
+
+ parser := tricky compileWithConfiguration: configuration.
+ self assert: parser parse: '|]'.
+
+ parser := tricky compileWithConfiguration: configuration.
+ self assert: parser parse: ']|'.
+
+ parser := tricky compileWithConfiguration: configuration.
+ self assert: parser parse: ']]'.
+!
+
+testCompileTrim
+ parser := 'foo' asParser token trim end compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: 'foo '.
+ self assert: result inputValue = 'foo'.
+
+
+ self assert: parser parse: ' foo'.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser parse: ' foo '.
+ self assert: result inputValue = 'foo'.
+
+ self assert: parser fail: 'boo'.
+!
+
+testTokenCharacter
+ | token |
+ token := $a asParser token.
+ parser := token plus
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'a'.
+ self assert: result first inputValue = 'a'.
+ self assert: context invocations size = 5.
+!
+
+testTokenCharacter2
+ | token |
+ token := $a asParser token.
+ parser := token plus
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'aaa'.
+ self assert: result first inputValue = 'a'.
+ self assert: result second inputValue = 'a'.
+ self assert: result third inputValue = 'a'.
+ self assert: context invocations size = 7.
+!
+
+testTokenName
+ | token |
+ token := 'foo' asParser token name: 'fooToken'; yourself.
+ parser := token plus
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: 'foofoo'.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'foo'.
+ self assert: (parser class methodDictionary includesKey: #fooToken).
+!
+
+testWhitespace
+ | token ws trimmingToken |
+ configuration arguments inline: false.
+
+ token := 'foo' asParser token.
+ ws := #blank asParser star name: 'consumeWhitespace'; yourself.
+ trimmingToken := ((ws, token, ws) ==> #second)
+ propertyAt: 'trimmingToken' put: true;
+ yourself.
+
+ parser := trimmingToken plus
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: ' foo '.
+ self assert: result first inputValue = 'foo'.
+
+ self assert: (context invocations select: [:e | e = #consumeWhitespace ]) size = 2.
+!
+
+testWhitespace2
+ | token ws trimmingToken |
+ configuration arguments inline: false.
+
+ token := 'foo' asParser token.
+ ws := #blank asParser star name: 'consumeWhitespace'; yourself.
+ trimmingToken := ((ws, token, ws) ==> #second)
+ propertyAt: 'trimmingToken' put: true;
+ yourself.
+
+ parser := trimmingToken plus
+ compileWithConfiguration: configuration.
+
+ self assert: parser parse: ' foo foo '.
+ self assert: result first inputValue = 'foo'.
+ self assert: result second inputValue = 'foo'.
+
+ self assert: (context invocations select: [:e | e = #consumeWhitespace ]) size = 3.
+! !
+