update
authorClaus Gittinger <cg@exept.de>
Tue, 04 Mar 2014 15:34:21 +0100
changeset 191 a66e636f9b0f
parent 190 8fb7bd90b59f
child 192 93558b60e547
update
PPParserTest.st
--- a/PPParserTest.st	Tue Mar 04 15:34:19 2014 +0100
+++ b/PPParserTest.st	Tue Mar 04 15:34:21 2014 +0100
@@ -1,6 +1,6 @@
 "{ Package: 'stx:goodies/petitparser' }"
 
-PPAbstractParseTest subclass:#PPParserTest
+PPAbstractParserTest subclass:#PPParserTest
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
@@ -10,16 +10,6 @@
 
 !PPParserTest methodsFor:'testing'!
 
-testAction
-	| block parser |
-	block := [ :char | char asUppercase ].
-	parser := #any asParser ==> block.
-	self assert: parser block = block.
-
-	self assert: parser parse: 'a' to: $A.
-	self assert: parser parse: 'b' to: $B
-!
-
 testAnd
 	| parser |
 	parser := 'foo' asParser flatten , 'bar' asParser flatten and.
@@ -31,16 +21,6 @@
 	self assert: parser and = parser
 !
 
-testAnswer
-	| parser |
-	parser := $a asParser answer: $b.
-	
-	self assert: parser parse: 'a' to: $b.
-	
-	self assert: parser fail: ''.
-	self assert: parser fail: 'b'
-!
-
 testBlock
 	| parser |
 	parser := [ :s | s next ] asParser.
@@ -87,6 +67,29 @@
 	self assert: parser fail: 'c'
 !
 
+testDelimitedByWithoutSeparators
+	| parser |
+	parser := ($a asParser delimitedBy: $b asParser)
+		withoutSeparators.
+	
+	self assert: parser parse: 'a' to: #($a).
+	self assert: parser parse: 'aba' to: #($a $a).
+	self assert: parser parse: 'ababa' to: #($a $a $a).
+
+	self assert: parser parse: 'ab' to: #($a).
+	self assert: parser parse: 'abab' to: #($a $a).
+	self assert: parser parse: 'ababab' to: #($a $a $a).
+	
+	self assert: parser parse: 'ac' to: #($a) end: 1.
+	self assert: parser parse: 'abc' to: #($a) end: 2.
+	self assert: parser parse: 'abac' to: #($a $a) end: 3.
+	self assert: parser parse: 'ababc' to: #($a $a) end: 4.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'.
+	self assert: parser fail: 'c'
+!
+
 testEndOfInput
 	| parser |
 	parser := PPEndOfInputParser on: $a asParser.
@@ -129,17 +132,6 @@
 	self assert: result printString = 'Plonk at 0'
 !
 
-testFlatten
-	| parser |
-	parser := $a asParser flatten.
-	
-	self assert: parser parse: 'a' to: 'a'.
-	self assert: parser parse: #($a) to: #($a).
-	
-	self assert: parser fail: ''.
-	self assert: parser fail: 'b'
-!
-
 testLiteralObject
 	| parser |
 	parser := PPLiteralObjectParser 
@@ -208,6 +200,52 @@
 	self assert: (parser printString endsWith: '[0, 2]')
 !
 
+testMaxGreedy
+	| parser |
+	parser := #word asParser max: 2 greedy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abc'.
+	
+	self assert: parser parse: '1' to: #() end: 0.
+	self assert: parser parse: 'a1' to: #($a) end: 1.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc1'.
+	
+	self assert: parser parse: '12' to: #($1) end: 1.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc12'.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc123'
+!
+
+testMaxLazy
+	| parser |
+	parser := #word asParser max: 2 lazy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abc'.
+	
+	self assert: parser parse: '1' to: #() end: 0.
+	self assert: parser parse: 'a1' to: #($a) end: 1.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc1'.
+	
+	self assert: parser parse: '12' to: #() end: 0.
+	self assert: parser parse: 'a12' to: #($a) end: 1.
+	self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc12'.
+	
+	self assert: parser parse: '123' to: #() end: 0.
+	self assert: parser parse: 'a123' to: #($a) end: 1.
+	self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc123'
+!
+
 testMemoized
 	| count parser twice |
 	count := 0.
@@ -240,6 +278,78 @@
 	self assert: (parser printString endsWith: '[2, *]')
 !
 
+testMinGreedy
+	| parser |
+	parser := #word asParser min: 2 greedy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abcde'.
+	
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a1'.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde1' to: #($a $b $c $d $e) end: 5.
+	
+	self assert: parser fail: '12'.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
+	self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
+	self assert: parser parse: 'abcd12' to: #($a $b $c $d $1) end: 5.
+	self assert: parser parse: 'abcde12' to: #($a $b $c $d $e $1) end: 6.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
+	self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
+	self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5.
+	self assert: parser parse: 'abcd123' to: #($a $b $c $d $1 $2) end: 6.
+	self assert: parser parse: 'abcde123' to: #($a $b $c $d $e $1 $2) end: 7.
+	
+	self assert: parser parse: '1234' to: #($1 $2 $3) end: 3.
+	self assert: parser parse: 'a1234' to: #($a $1 $2 $3) end: 4.
+	self assert: parser parse: 'ab1234' to: #($a $b $1 $2 $3) end: 5.
+	self assert: parser parse: 'abc1234' to: #($a $b $c $1 $2 $3) end: 6.
+	self assert: parser parse: 'abcd1234' to: #($a $b $c $d $1 $2 $3) end: 7.
+	self assert: parser parse: 'abcde1234' to: #($a $b $c $d $e $1 $2 $3) end: 8
+!
+
+testMinLazy
+	| parser |
+	parser := #word asParser min: 2 lazy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abcde'.
+	
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a1'.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde1' to: #($a $b $c $d $e) end: 5.
+	
+	self assert: parser fail: '12'.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde12' to: #($a $b $c $d $e) end: 5.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc123' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde123' to: #($a $b $c $d $e) end: 5.
+	
+	self assert: parser parse: '1234' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a1234' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab1234' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1234' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde1234' to: #($a $b $c $d $e) end: 5
+!
+
 testMinMax
 	| parser |
 	parser := $a asParser min: 2 max: 4.
@@ -257,6 +367,78 @@
 	self assert: (parser printString endsWith: '[2, 4]')
 !
 
+testMinMaxGreedy
+	| parser |
+	parser := #word asParser min: 2 max: 4 greedy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abcde'.
+	
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a1'.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde1'.
+	
+	self assert: parser fail: '12'.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
+	self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
+	self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde12'.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
+	self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
+	self assert: parser parse: 'abc123' to: #($a $b $c $1) end: 4.
+	self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde123'.
+	
+	self assert: parser parse: '1234' to: #($1 $2 $3) end: 3.
+	self assert: parser parse: 'a1234' to: #($a $1 $2 $3) end: 4.
+	self assert: parser parse: 'ab1234' to: #($a $b $1 $2) end: 4.
+	self assert: parser parse: 'abc1234' to: #($a $b $c $1) end: 4.
+	self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde1234'
+!
+
+testMinMaxLazy
+	| parser |
+	parser := #word asParser min: 2 max: 4 lazy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abcde'.
+	
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a1'.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde1'.
+	
+	self assert: parser fail: '12'.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde12'.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc123' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde123'.
+	
+	self assert: parser parse: '1234' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a1234' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab1234' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1234' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde1234'
+!
+
 testNegate
 	| parser |
 	parser := 'foo' asParser negate.
@@ -292,22 +474,6 @@
 	self assert: parser parse: 'ba' to: nil end: 0
 !
 
-testPermutation
-	| parser |
-	parser := #any asParser , #any asParser , #any asParser.
-
-	self assert: (parser permutation: #()) parse: '123' to: #().
-	self assert: (parser permutation: #(1)) parse: '123' to: #($1).
-	self assert: (parser permutation: #(1 3)) parse: '123' to: #($1 $3).
-	self assert: (parser permutation: #(3 1)) parse: '123' to: #($3 $1).
-	self assert: (parser permutation: #(2 2)) parse: '123' to: #($2 $2).
-	self assert: (parser permutation: #(3 2 1)) parse: '123' to: #($3 $2 $1).
-	
-	self should: [ parser permutation: #(0) ] raise: Error.
-	self should: [ parser permutation: #(4) ] raise: Error.
-	self should: [ parser permutation: #($2) ] raise: Error
-!
-
 testPluggable
 	| block parser |
 	block := [ :stream | stream position ].
@@ -318,6 +484,7 @@
 testPlus
 	| parser |
 	parser := $a asParser plus.
+	
 	self assert: parser min = 1.
 	self assert: parser max > parser min.
 	
@@ -335,8 +502,15 @@
 !
 
 testPlusGreedy
-	| parser |
-	parser := #word asParser plusGreedy: #digit asParser.
+	| limit parser |
+	limit := #digit asParser.
+	parser := #word asParser plusGreedy: limit.
+	
+	self assert: parser min = 1.
+	self assert: parser max > parser min.	
+	self assert: parser limit = limit.
+	self assert: parser children size = 2.
+	self assert: parser children last = limit.
 
 	self assert: parser fail: ''.
 	self assert: parser fail: '1'.
@@ -355,8 +529,15 @@
 !
 
 testPlusLazy
-	| parser |
-	parser := #word asParser plusLazy: #digit asParser.
+	| limit parser |
+	limit := #digit asParser.
+	parser := #word asParser plusLazy: limit.
+	
+	self assert: parser min = 1.
+	self assert: parser max > parser min.	
+	self assert: parser limit = limit.
+	self assert: parser children size = 2.
+	self assert: parser children last = limit.
 
 	self assert: parser fail: ''.
 	self assert: parser fail: '1'.
@@ -391,6 +572,24 @@
 	self assert: parser fail: 'c'
 !
 
+testSeparatedByWithoutSeparators
+	| parser |
+	parser := ($a asParser separatedBy: $b asParser)
+		withoutSeparators.
+	
+	self assert: parser parse: 'a' to: #($a).
+	self assert: parser parse: 'aba' to: #($a $a).
+	self assert: parser parse: 'ababa' to: #($a $a $a).
+	
+	self assert: parser parse: 'ab' to: #($a) end: 1.
+	self assert: parser parse: 'abab' to: #($a $a) end: 3.
+	self assert: parser parse: 'ac' to: #($a) end: 1.
+	self assert: parser parse: 'abac' to: #($a $a) end: 3.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'c'
+!
+
 testSequence
 	| parser |
 	parser := $a asParser , $b asParser.
@@ -410,6 +609,7 @@
 testStar
 	| parser |
 	parser := $a asParser star.
+	
 	self assert: parser min = 0.
 	self assert: parser max > parser min.
 	
@@ -425,8 +625,15 @@
 !
 
 testStarGreedy
-	| parser |
-	parser := #word asParser starGreedy: #digit asParser.
+	| limit parser |
+	limit := #digit asParser.
+	parser := #word asParser starGreedy: limit.
+	
+	self assert: parser min = 0.
+	self assert: parser max > parser min.
+	self assert: parser limit = limit.
+	self assert: parser children size = 2.
+	self assert: parser children last = limit.
 
 	self assert: parser fail: ''.
 	self assert: parser fail: 'a'.
@@ -447,8 +654,15 @@
 !
 
 testStarLazy
-	| parser |
-	parser := #word asParser starLazy: #digit asParser.
+	| limit parser |
+	limit := #digit asParser.
+	parser := #word asParser starLazy: limit.
+	
+	self assert: parser min = 0.
+	self assert: parser max > parser min.
+	self assert: parser limit = limit.
+	self assert: parser children size = 2.
+	self assert: parser children last = limit.
 
 	self assert: parser fail: ''.
 	self assert: parser fail: 'a'.
@@ -478,100 +692,6 @@
 	self assert: parser parse: 'aaa' to: #($a $a) end: 2
 !
 
-testToken
-	| parser |
-	parser := $a asParser token.
-	self assert: parser tokenClass = PPToken.
-	self assert: parser parse: 'a' toToken: 1 stop: 1.	
-	self assert: parser fail: 'b'.
-	self assert: parser fail: ''.
-	
-	parser := $a asParser token: PPToken.
-	self assert: parser tokenClass = PPToken.
-	self assert: parser parse: 'a' toToken: 1 stop: 1.	
-	self assert: parser fail: ''.
-	self assert: parser fail: 'b'
-!
-
-testTrim
-	| parser |
-	parser := $a asParser token trim.
-	self assert: parser trim = parser.
-	
-	self assert: parser parse: 'a' toToken: 1 stop: 1.
-	self assert: parser parse: 'a ' toToken: 1 stop: 1.
-	self assert: parser parse: 'a	' toToken: 1 stop: 1.
-	self assert: parser parse: 'a  ' toToken: 1 stop: 1.
-	self assert: parser parse: 'a 
-	 ' toToken: 1 stop: 1.
-		
-	self assert: parser parse: 'a' toToken: 1 stop: 1.
-	self assert: parser parse: ' a' toToken: 2 stop: 2.
-	self assert: parser parse: '	a' toToken: 2 stop: 2.
-	self assert: parser parse: '    a' toToken: 5 stop: 5.
-	self assert: parser parse: '   
-a' toToken: 5 stop: 5.
-	
-	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
-	self assert: parser parse: 'a	a' toToken: 1 stop: 1 end: 2.
-	self assert: parser parse: 'a  a' toToken: 1 stop: 1 end: 3.
-	
-	self assert: parser fail: ''.
-	self assert: parser fail: 'b'
-!
-
-testTrimBlanks
-	| parser |
-	parser := $a asParser token trimBlanks.
-	
-	self assert: parser parse: 'a' toToken: 1 stop: 1.
-	self assert: parser parse: 'a ' toToken: 1 stop: 1.
-	self assert: parser parse: 'a	' toToken: 1 stop: 1.
-	self assert: parser parse: 'a  ' toToken: 1 stop: 1.
-	
-	self assert: parser parse: 'a' toToken: 1 stop: 1.
-	self assert: parser parse: ' a' toToken: 2 stop: 2.
-	self assert: parser parse: '	a' toToken: 2 stop: 2.
-	self assert: parser parse: '    a' toToken: 5 stop: 5.
-	
-	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
-	self assert: parser parse: 'a	a' toToken: 1 stop: 1 end: 2.
-	self assert: parser parse: 'a  a' toToken: 1 stop: 1 end: 3.
-	
-	self assert: parser fail: ''.
-	self assert: parser fail: '
-'.
-	self assert: parser fail: '
-a'.
-	self assert: parser fail: 'b'.
-!
-
-testTrimSpaces
-	| parser |
-	parser := $a asParser token trimSpaces.
-	
-	self assert: parser parse: 'a' toToken: 1 stop: 1.
-	self assert: parser parse: 'a ' toToken: 1 stop: 1.
-	self assert: parser parse: 'a	' toToken: 1 stop: 1.
-	self assert: parser parse: 'a  ' toToken: 1 stop: 1.
-	self assert: parser parse: 'a 
-	 ' toToken: 1 stop: 1.
-		
-	self assert: parser parse: 'a' toToken: 1 stop: 1.
-	self assert: parser parse: ' a' toToken: 2 stop: 2.
-	self assert: parser parse: '	a' toToken: 2 stop: 2.
-	self assert: parser parse: '    a' toToken: 5 stop: 5.
-	self assert: parser parse: '   
-a' toToken: 5 stop: 5.
-	
-	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
-	self assert: parser parse: 'a	a' toToken: 1 stop: 1 end: 2.
-	self assert: parser parse: 'a  a' toToken: 1 stop: 1 end: 3.
-	
-	self assert: parser fail: ''.
-	self assert: parser fail: 'b'
-!
-
 testUnresolved
 	| parser |
 	parser := PPUnresolvedParser new.
@@ -596,24 +716,6 @@
 	self assert: parser parse: 'abc' to: #(#($a $b) $c)
 !
 
-testWrapping
-	| parser result |
-	parser := #digit asParser plus >=> [ :stream :cc | 
-		Array 
-			with: stream position 
-			with: cc value 
-			with: stream position ].
-
-	self assert: parser parse: '1' to: #(0 ($1) 1).
-	self assert: parser parse: '12' to: #(0 ($1 $2) 2).
-	self assert: parser parse: '123' to: #(0 ($1 $2 $3) 3).
-	
-	result := parser parse: 'a'.
-	self assert: result first = 0.
-	self assert: result second isPetitFailure.
-	self assert: result last = 0
-!
-
 testXor
 	| parser |
 	parser := ($a asParser / $b asParser)
@@ -653,24 +755,21 @@
 !
 
 testPrint
-        | parser |
-        parser := PPParser new.
-        self assert: (parser printString includesSubString: 'PPParser').
-        
-        parser := PPParser named: 'choice'.
-        self assert: (parser printString includesSubString: 'PPParser(choice').
-        
-        parser := PPLiteralObjectParser on: $a.
-"/        self assert: (parser printString includesSubString: '$a').
-        self assert: (parser printString includesSubString: 'a').
-        
-        parser := PPFailingParser message: 'error'.
-        self assert: (parser printString includesSubString: 'error').
-        
-        parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'.
-        self assert: (parser printString includesSubString: 'error')
-
-    "Modified: / 19-12-2010 / 18:30:54 / Jan Kurs <kurs.jan@post.cz>"
+	| parser |
+	parser := PPParser new.
+	self assert: (parser printString findString: 'PPParser') > 0.
+	
+	parser := PPParser named: 'choice'.
+	self assert: (parser printString findString: 'PPParser(choice') > 0.
+	
+	parser := PPLiteralObjectParser on: $a.
+	self assert: (parser printString findString: '$a') > 0.
+	
+	parser := PPFailingParser message: 'error'.
+	self assert: (parser printString findString: 'error') > 0.
+	
+	parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'.
+	self assert: (parser printString findString: 'error') > 0
 ! !
 
 !PPParserTest methodsFor:'testing-fixtures'!
@@ -728,6 +827,272 @@
 	self assert: p3 parse: 'ac'
 ! !
 
+!PPParserTest methodsFor:'testing-mapping'!
+
+testAction
+	| block parser |
+	block := [ :char | char asUppercase ].
+	parser := #any asParser ==> block.
+	self assert: parser block = block.
+
+	self assert: parser parse: 'a' to: $A.
+	self assert: parser parse: 'b' to: $B
+!
+
+testAnswer
+	| parser |
+	parser := $a asParser answer: $b.
+	
+	self assert: parser parse: 'a' to: $b.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+!
+
+testFlatten
+	| parser |
+	parser := $a asParser flatten.
+	
+	self assert: parser parse: 'a' to: 'a'.
+	self assert: parser parse: #($a) to: #($a).
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+!
+
+testFoldLeft2
+	| parser |
+	parser := #any asParser star 
+		foldLeft: [ :a :b | Array with: a with: b ].
+
+	self assert: parser parse: #(a) to: #a.
+	self assert: parser parse: #(a b) to: #(a b).
+	self assert: parser parse: #(a b c) to: #((a b) c).
+	self assert: parser parse: #(a b c d) to: #(((a b) c) d).
+	self assert: parser parse: #(a b c d e) to: #((((a b) c) d) e)
+!
+
+testFoldLeft3
+	| parser |
+	parser := #any asParser star 
+		foldLeft: [ :a :b :c | Array with: a with: b with: c ].
+
+	self assert: parser parse: #(a) to: #a.
+	self assert: parser parse: #(a b c) to: #(a b c).
+	self assert: parser parse: #(a b c d e) to: #((a b c) d e)
+!
+
+testFoldRight2
+	| parser |
+	parser := #any asParser star 
+		foldRight: [ :a :b | Array with: a with: b ].
+
+	self assert: parser parse: #(a) to: #a.
+	self assert: parser parse: #(a b) to: #(a b).
+	self assert: parser parse: #(a b c) to: #(a (b c)).
+	self assert: parser parse: #(a b c d) to: #(a (b (c d))).
+	self assert: parser parse: #(a b c d e) to: #(a (b (c (d e))))
+!
+
+testFoldRight3
+	| parser |
+	parser := #any asParser star 
+		foldRight: [ :a :b :c | Array with: a with: b with: c ].
+
+	self assert: parser parse: #(a) to: #a.
+	self assert: parser parse: #(a b c) to: #(a b c).
+	self assert: parser parse: #(a b c d e) to: #(a b (c d e))
+!
+
+testMap1
+	| parser |
+	parser := #any asParser 
+		map: [ :a | Array with: a ].
+
+	self assert: parser parse: #(a) to: #(a)
+!
+
+testMap2
+	| parser |
+	parser := (#any asParser , #any asParser) 
+		map: [ :a :b | Array with: b with: a ].
+
+	self assert: parser parse: #(a b) to: #(b a)
+!
+
+testMap3
+	| parser |
+	parser := (#any asParser , #any asParser , #any asParser)
+		map: [ :a :b :c | Array with: c with: b with: a ].
+
+	self assert: parser parse: #(a b c) to: #(c b a)
+!
+
+testMapFail1
+	self
+		should: [ #any asParser map: [  ] ]
+		raise: Error.
+	self
+		should: [ #any asParser map: [ :a :b | ] ]
+		raise: Error
+!
+
+testMapFail2
+	self
+		should: [ (#any asParser , #any asParser) map: [ :a | ] ]
+		raise: Error.
+	self
+		should: [ (#any asParser , #any asParser) map: [ :a :b :c | ] ]
+		raise: Error
+!
+
+testPermutation
+	| parser |
+	parser := #any asParser , #any asParser , #any asParser.
+
+	self assert: (parser permutation: #()) parse: '123' to: #().
+	self assert: (parser permutation: #(1)) parse: '123' to: #($1).
+	self assert: (parser permutation: #(1 3)) parse: '123' to: #($1 $3).
+	self assert: (parser permutation: #(3 1)) parse: '123' to: #($3 $1).
+	self assert: (parser permutation: #(2 2)) parse: '123' to: #($2 $2).
+	self assert: (parser permutation: #(3 2 1)) parse: '123' to: #($3 $2 $1).
+	
+	self should: [ parser permutation: #(0) ] raise: Error.
+	self should: [ parser permutation: #(4) ] raise: Error.
+	self should: [ parser permutation: #($2) ] raise: Error
+!
+
+testToken
+	| parser |
+	parser := $a asParser token.
+	self assert: parser tokenClass = PPToken.
+	self assert: parser parse: 'a' toToken: 1 stop: 1.	
+	self assert: parser fail: 'b'.
+	self assert: parser fail: ''.
+	
+	parser := $a asParser token: PPToken.
+	self assert: parser tokenClass = PPToken.
+	self assert: parser parse: 'a' toToken: 1 stop: 1.	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+!
+
+testTrim
+	| parser |
+	parser := $a asParser token trim.
+	
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: 'a ' toToken: 1 stop: 1.
+	self assert: parser parse: 'a	' toToken: 1 stop: 1.
+	self assert: parser parse: 'a  ' toToken: 1 stop: 1.
+	self assert: parser parse: 'a 
+	 ' toToken: 1 stop: 1.
+		
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: ' a' toToken: 2 stop: 2.
+	self assert: parser parse: '	a' toToken: 2 stop: 2.
+	self assert: parser parse: '    a' toToken: 5 stop: 5.
+	self assert: parser parse: '   
+a' toToken: 5 stop: 5.
+	
+	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+	self assert: parser parse: 'a	a' toToken: 1 stop: 1 end: 2.
+	self assert: parser parse: 'a  a' toToken: 1 stop: 1 end: 3.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+!
+
+testTrimBlanks
+	| parser |
+	parser := $a asParser token trimBlanks.
+	
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: 'a ' toToken: 1 stop: 1.
+	self assert: parser parse: 'a	' toToken: 1 stop: 1.
+	self assert: parser parse: 'a  ' toToken: 1 stop: 1.
+	
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: ' a' toToken: 2 stop: 2.
+	self assert: parser parse: '	a' toToken: 2 stop: 2.
+	self assert: parser parse: '    a' toToken: 5 stop: 5.
+	
+	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+	self assert: parser parse: 'a	a' toToken: 1 stop: 1 end: 2.
+	self assert: parser parse: 'a  a' toToken: 1 stop: 1 end: 3.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: '
+'.
+	self assert: parser fail: '
+a'.
+	self assert: parser fail: 'b'.
+!
+
+testTrimCustom
+	| parser |
+	parser := $a asParser token trim: $b asParser.
+	
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: 'ab' toToken: 1 stop: 1.
+	self assert: parser parse: 'abb' toToken: 1 stop: 1.
+		
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: 'ba' toToken: 2 stop: 2.
+	self assert: parser parse: 'bba' toToken: 3 stop: 3.
+	
+	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+	self assert: parser parse: 'ab' toToken: 1 stop: 1 end: 2.
+	self assert: parser parse: 'abba' toToken: 1 stop: 1 end: 3.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+!
+
+testTrimSpaces
+	| parser |
+	parser := $a asParser token trimSpaces.
+	
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: 'a ' toToken: 1 stop: 1.
+	self assert: parser parse: 'a	' toToken: 1 stop: 1.
+	self assert: parser parse: 'a  ' toToken: 1 stop: 1.
+	self assert: parser parse: 'a 
+	 ' toToken: 1 stop: 1.
+		
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: ' a' toToken: 2 stop: 2.
+	self assert: parser parse: '	a' toToken: 2 stop: 2.
+	self assert: parser parse: '    a' toToken: 5 stop: 5.
+	self assert: parser parse: '   
+a' toToken: 5 stop: 5.
+	
+	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+	self assert: parser parse: 'a	a' toToken: 1 stop: 1 end: 2.
+	self assert: parser parse: 'a  a' toToken: 1 stop: 1 end: 3.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+!
+
+testWrapping
+	| parser result |
+	parser := #digit asParser plus >=> [ :stream :cc | 
+		Array 
+			with: stream position 
+			with: cc value 
+			with: stream position ].
+
+	self assert: parser parse: '1' to: #(0 ($1) 1).
+	self assert: parser parse: '12' to: #(0 ($1 $2) 2).
+	self assert: parser parse: '123' to: #(0 ($1 $2 $3) 3).
+	
+	result := parser parse: 'a'.
+	self assert: result first = 0.
+	self assert: result second isPetitFailure.
+	self assert: result last = 0
+! !
+
 !PPParserTest methodsFor:'testing-properties'!
 
 testHasProperty
@@ -871,36 +1236,70 @@
 	self assert: result last = #($2 $3)
 !
 
+testMatchesSkipIn
+	| parser result |
+	parser := $a asParser.
+	
+	result := parser matchesSkipIn: 'abba'.
+	self assert: result size = 2.
+	self assert: result first = $a.
+	self assert: result last = $a.
+	
+	result := parser matchesSkipIn: 'baaah'.
+	self assert: result size = 3.
+	self assert: result first = $a.
+	self assert: result last = $a
+!
+
+testMatchesSkipInOverlapping
+	"Matches that overlap should be properly reported."
+
+	| parser result |
+	parser := #digit asParser , #digit asParser.
+	
+	result := parser matchesSkipIn: 'a123b'.
+	self assert: result size = 1.
+	self assert: result first = #($1 $2)
+!
+
 testMatchingRangesIn
 	| input parser result |
-	input := 'a12b1'.
+	input := 'a12b3'.
 	parser := #digit asParser plus.
 	result := parser matchingRangesIn: input.
+	result := result collect: [ :each | input copyFrom: each first to: each last ].
 	self assert: result size = 3.
-	result do: [ :each | self assert: (parser matches: (input copyFrom: each first to: each last)) ]
+	self assert: result first = '12'.
+	self assert: result second = '2'.
+	self assert: result last = '3'
+!
+
+testMatchingSkipRangesIn
+	| input parser result |
+	input := 'a12b3'.
+	parser := #digit asParser plus.
+	result := parser matchingSkipRangesIn: input.
+	result := result collect: [ :each | input copyFrom: each first to: each last ].
+	self assert: result size = 2.
+	self assert: result first = '12'.
+	self assert: result last = '3'
 !
 
 testParse
-        | parser result |
-        parser := $a asParser.
-        
-        self assert: (parser parse: 'a') = $a.
-        self assert: (result := parser parse: 'b') isPetitFailure.
-        "is it Character printString differs: we return only 'a', not '$a'"
-        self breakPoint: #petitparser.
-"/        self assert: (result message includesSubString: '$a').
-        self assert: (result message includesSubString: 'a').
-        self assert: (result message includesSubString: 'expected').
-        self assert: (result position = 0).
-        
-        self assert: (parser parse: 'a' readStream) = $a.
-        self assert: (result := parser parse: 'b' readStream) isPetitFailure.
-"/        self assert: (result message includesSubString: '$a').
-        self assert: (result message includesSubString: 'a').
-        self assert: (result message includesSubString: 'expected').
-        self assert: (result position = 0)
-
-    "Modified: / 18-12-2010 / 17:05:13 / Jan Kurs <kurs.jan@post.cz>"
+	| parser result |
+	parser := $a asParser.
+	
+	self assert: (parser parse: 'a') = $a.
+	self assert: (result := parser parse: 'b') isPetitFailure.
+	self assert: (result message findString: '$a') > 0.
+	self assert: (result message findString: 'expected') > 0.
+	self assert: (result position = 0).
+	
+	self assert: (parser parse: 'a' readStream) = $a.
+	self assert: (result := parser parse: 'b' readStream) isPetitFailure.
+	self assert: (result message findString: '$a') > 0.
+	self assert: (result message findString: 'expected') > 0.
+	self assert: (result position = 0)
 !
 
 testParseOnError0
@@ -916,43 +1315,35 @@
 !
 
 testParseOnError1
-        | parser result seen |
-        parser := $a asParser.
-        
-        result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
-        self assert: result = $a.
-        
-        result := parser parse: 'b' onError: [ :failure | 
-                self assert: (failure position = 0).
-                "We don't use $ in ST/X for Characters"
-                self assert: (failure message includesSubString: 'a').
-"/                self assert: (failure message includesSubString: '$a').
-                self assert: (failure message includesSubString: 'expected').
-                seen := true ].
-        self assert: result.
-        self assert: seen
+	| parser result seen |
+	parser := $a asParser.
 
-    "Modified: / 19-12-2010 / 18:18:01 / Jan Kurs <kurs.jan@post.cz>"
+	result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+	self assert: result = $a.
+	
+	result := parser parse: 'b' onError: [ :failure | 
+		self assert: (failure position = 0).
+		self assert: (failure message findString: '$a') > 0.
+		self assert: (failure message findString: 'expected') > 0.
+		seen := true ].
+	self assert: result.
+	self assert: seen
 !
 
 testParseOnError2
-        | parser result seen |
-        parser := $a asParser.
-        
-        result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
-        self assert: result = $a.
+	| parser result seen |
+	parser := $a asParser.
+	
+	result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+	self assert: result = $a.
 
-        result := parser parse: 'b' onError: [ :msg :pos | 
-                "We don't use $ in ST/X for Characters"
-                self assert: (msg includesSubString: 'a').
-"/                self assert: (msg includesSubString: '$a').
-                self assert: (msg includesSubString: 'expected').
-                self assert: pos = 0.
-                seen := true ].
-        self assert: result.
-        self assert: seen
-
-    "Modified: / 19-12-2010 / 18:18:31 / Jan Kurs <kurs.jan@post.cz>"
+	result := parser parse: 'b' onError: [ :msg :pos | 
+		self assert: (msg findString: '$a') > 0.
+		self assert: (msg findString: 'expected') > 0.
+		self assert: pos = 0.
+		seen := true ].
+	self assert: result.
+	self assert: seen
 !
 
 testParser
@@ -968,13 +1359,14 @@
 !PPParserTest class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParserTest.st,v 1.3 2012-05-04 22:04:32 vrany Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParserTest.st,v 1.4 2014-03-04 14:34:21 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParserTest.st,v 1.3 2012-05-04 22:04:32 vrany Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParserTest.st,v 1.4 2014-03-04 14:34:21 cg Exp $'
 !
 
 version_SVN
-    ^ '§Id: PPParserTest.st 5 2010-12-19 17:38:27Z kursjan §'
+    ^ '$Id: PPParserTest.st,v 1.4 2014-03-04 14:34:21 cg Exp $'
 ! !
+