1601 lines
43 KiB
Smalltalk
1601 lines
43 KiB
Smalltalk
Class {
|
|
#name : 'PPParserTest',
|
|
#superclass : 'PPAbstractParserTest',
|
|
#category : 'PetitTests-Tests'
|
|
}
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> testAction [
|
|
| block parser |
|
|
block := [ :char | char asUppercase ].
|
|
parser := #any asParser ==> block.
|
|
self assert: parser block equals: block.
|
|
self assert: parser parse: 'a' to: $A.
|
|
self assert: parser parse: 'b' to: $B
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testAnd [
|
|
| parser |
|
|
parser := 'foo' asParser flatten , 'bar' asParser flatten and.
|
|
self
|
|
assert: parser
|
|
parse: 'foobar'
|
|
to: #('foo' 'bar')
|
|
end: 3.
|
|
self assert: parser fail: 'foobaz'.
|
|
parser := 'foo' asParser and.
|
|
self assert: parser and equals: parser
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> testAnswer [
|
|
| parser |
|
|
parser := $a asParser answer: $b.
|
|
|
|
self assert: parser parse: 'a' to: $b.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'b'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testBlock [
|
|
| parser |
|
|
parser := [ :s | s next ] asParser.
|
|
|
|
self assert: parser parse: 'ab' to: $a end: 1.
|
|
self assert: parser parse: 'b' to: $b.
|
|
self assert: parser parse: '' to: nil
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testChildren [
|
|
| p1 p2 p3 |
|
|
p1 := #lowercase asParser.
|
|
p2 := p1 ==> #asUppercase.
|
|
p3 := PPUnresolvedParser new.
|
|
p3 def: p2 / p3.
|
|
self assert: p1 children isEmpty.
|
|
self assert: p2 children size equals: 1.
|
|
self assert: p3 children size equals: 2
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testChoice [
|
|
| parser |
|
|
parser := $a asParser / $b asParser.
|
|
|
|
self assert: parser parse: 'a' to: $a.
|
|
self assert: parser parse: 'b' to: $b.
|
|
|
|
self assert: parser parse: 'ab' to: $a end: 1.
|
|
self assert: parser parse: 'ba' to: $b end: 1.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'c'.
|
|
self assert: parser fail: 'ca'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testDelimitedBy [
|
|
| parser |
|
|
parser := $a asParser delimitedBy: $b asParser.
|
|
|
|
self assert: parser parse: 'a' to: #($a).
|
|
self assert: parser parse: 'aba' to: #($a $b $a).
|
|
self assert: parser parse: 'ababa' to: #($a $b $a $b $a).
|
|
|
|
self assert: parser parse: 'ab' to: #($a $b).
|
|
self assert: parser parse: 'abab' to: #($a $b $a $b).
|
|
self assert: parser parse: 'ababab' to: #($a $b $a $b $a $b).
|
|
|
|
self assert: parser parse: 'ac' to: #($a) end: 1.
|
|
self assert: parser parse: 'abc' to: #($a $b) end: 2.
|
|
self assert: parser parse: 'abac' to: #($a $b $a) end: 3.
|
|
self assert: parser parse: 'ababc' to: #($a $b $a $b) end: 4.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'b'.
|
|
self assert: parser fail: 'c'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testEndOfInput [
|
|
| parser |
|
|
parser := PPEndOfInputParser on: $a asParser.
|
|
self assert: parser end equals: parser.
|
|
self assert: parser parse: 'a' to: $a.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'aa'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testEndOfInputAfterMatch [
|
|
| parser |
|
|
parser := 'stuff' asParser end.
|
|
self assert: parser parse: 'stuff' to: 'stuff'.
|
|
self assert: parser fail: 'stufff'.
|
|
self assert: parser fail: 'fluff'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testEpsilon [
|
|
| parser |
|
|
parser := nil asParser.
|
|
|
|
self assert: parser parse: '' to: nil.
|
|
|
|
self assert: parser parse: 'a' to: nil end: 0.
|
|
self assert: parser parse: 'ab' to: nil end: 0
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testFailing [
|
|
| parser result |
|
|
parser := PPFailingParser message: 'Plonk'.
|
|
self assert: parser message equals: 'Plonk'.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser fail: 'aa'.
|
|
result := parser parse: 'a'.
|
|
self assert: result message equals: 'Plonk'.
|
|
self assert: result printString equals: 'Plonk at 0'
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testFailure [
|
|
| failure |
|
|
failure := PPFailure message: 'Error' context: PPContext new at: 3.
|
|
self assert: failure message equals: 'Error'.
|
|
self assert: failure position equals: 3.
|
|
self assert: failure isPetitFailure.
|
|
self deny: 4 isPetitFailure.
|
|
self deny: 'foo' isPetitFailure
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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)
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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)
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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))))
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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))
|
|
]
|
|
|
|
{ #category : 'testing-properties' }
|
|
PPParserTest >> testHasProperty [
|
|
| parser |
|
|
parser := PPParser new.
|
|
self deny: (parser hasProperty: #foo).
|
|
parser propertyAt: #foo put: 123.
|
|
self assert: (parser hasProperty: #foo)
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testListConstructor [
|
|
| p1 p2 p3 |
|
|
p1 := PPChoiceParser with: $a asParser.
|
|
p2 := PPChoiceParser with: $a asParser with: $b asParser.
|
|
p3 := PPChoiceParser withAll: (Array with: $a asParser with: $b asParser with: $c asParser).
|
|
self assert: p1 children size equals: 1.
|
|
self assert: p2 children size equals: 2.
|
|
self assert: p3 children size equals: 3
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testLiteralObject [
|
|
| parser |
|
|
parser := PPLiteralObjectParser on: $a message: 'letter "a" expected'.
|
|
self assert: parser literal equals: $a.
|
|
self assert: parser message equals: 'letter "a" expected'.
|
|
self assert: parser parse: 'a' to: $a.
|
|
self assert: parser fail: 'b'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testLiteralObjectCaseInsensitive [
|
|
| parser |
|
|
parser := $a asParser caseInsensitive.
|
|
|
|
self assert: parser parse: 'a' to: $a.
|
|
self assert: parser parse: 'A' to: $A.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'b'.
|
|
self assert: parser fail: 'B'
|
|
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testLiteralSequence [
|
|
| parser |
|
|
parser := PPLiteralSequenceParser on: 'abc' message: 'sequence "abc" expected'.
|
|
self assert: parser size equals: 3.
|
|
self assert: parser literal equals: 'abc'.
|
|
self assert: parser message equals: 'sequence "abc" expected'.
|
|
self assert: parser parse: 'abc' to: 'abc'.
|
|
self assert: parser fail: 'ab'.
|
|
self assert: parser fail: 'abd'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testLiteralSequenceCaseInsensitive [
|
|
| parser |
|
|
parser := 'abc' asParser caseInsensitive.
|
|
|
|
self assert: parser parse: 'abc' to: 'abc'.
|
|
self assert: parser parse: 'ABC' to: 'ABC'.
|
|
self assert: parser parse: 'abC' to: 'abC'.
|
|
self assert: parser parse: 'AbC' to: 'AbC'.
|
|
|
|
self assert: parser fail: 'ab'.
|
|
self assert: parser fail: 'abd'
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> testMap1 [
|
|
| parser |
|
|
parser := #any asParser
|
|
map: [ :a | Array with: a ].
|
|
|
|
self assert: parser parse: #(a) to: #(a)
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> testMap2 [
|
|
| parser |
|
|
parser := (#any asParser , #any asParser)
|
|
map: [ :a :b | Array with: b with: a ].
|
|
|
|
self assert: parser parse: #(a b) to: #(b a)
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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)
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> testMapFail1 [
|
|
self
|
|
should: [ #any asParser map: [ ] ]
|
|
raise: Error.
|
|
self
|
|
should: [ #any asParser map: [ :a :b | ] ]
|
|
raise: Error
|
|
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> testMapFail2 [
|
|
self
|
|
should: [ (#any asParser , #any asParser) map: [ :a | ] ]
|
|
raise: Error.
|
|
self
|
|
should: [ (#any asParser , #any asParser) map: [ :a :b :c | ] ]
|
|
raise: Error
|
|
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testMatches [
|
|
| parser |
|
|
parser := $a asParser.
|
|
|
|
self assert: (parser matches: 'a').
|
|
self deny: (parser matches: 'b').
|
|
|
|
self assert: (parser matches: 'a' readStream).
|
|
self deny: (parser matches: 'b' readStream)
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testMatchesIn [
|
|
| parser result |
|
|
parser := $a asParser.
|
|
result := parser matchesIn: 'abba'.
|
|
self assert: result size equals: 2.
|
|
self assert: result first equals: $a.
|
|
self assert: result last equals: $a.
|
|
result := parser matchesIn: 'baaah'.
|
|
self assert: result size equals: 3.
|
|
self assert: result first equals: $a.
|
|
self assert: result last equals: $a
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testMatchesInEmpty [
|
|
"Empty matches should properly advance and match at each position and at the end."
|
|
|
|
| parser result |
|
|
parser := [ :stream | stream position ] asParser.
|
|
result := parser matchesIn: '123'.
|
|
self assert: result asArray equals: #(0 1 2 3)
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testMatchesInOverlapping [
|
|
"Matches that overlap should be properly reported."
|
|
|
|
| parser result |
|
|
parser := #digit asParser , #digit asParser.
|
|
result := parser matchesIn: 'a123b'.
|
|
self assert: result size equals: 2.
|
|
self assert: result first equals: #($1 $2).
|
|
self assert: result last equals: #($2 $3)
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testMatchesSkipIn [
|
|
| parser result |
|
|
parser := $a asParser.
|
|
result := parser matchesSkipIn: 'abba'.
|
|
self assert: result size equals: 2.
|
|
self assert: result first equals: $a.
|
|
self assert: result last equals: $a.
|
|
result := parser matchesSkipIn: 'baaah'.
|
|
self assert: result size equals: 3.
|
|
self assert: result first equals: $a.
|
|
self assert: result last equals: $a
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testMatchesSkipInOverlapping [
|
|
"Matches that overlap should be properly reported."
|
|
|
|
| parser result |
|
|
parser := #digit asParser , #digit asParser.
|
|
result := parser matchesSkipIn: 'a123b'.
|
|
self assert: result size equals: 1.
|
|
self assert: result first equals: #($1 $2)
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testMatchingRangesIn [
|
|
| input parser result |
|
|
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 equals: 3.
|
|
self assert: result first equals: '12'.
|
|
self assert: result second equals: '2'.
|
|
self assert: result last equals: '3'
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> 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 equals: 2.
|
|
self assert: result first equals: '12'.
|
|
self assert: result last equals: '3'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testMax [
|
|
| parser printString suffix |
|
|
parser := $a asParser max: 2.
|
|
self assert: parser min equals: 0.
|
|
self assert: parser max equals: 2.
|
|
self assert: parser parse: '' to: #().
|
|
self assert: parser parse: 'a' to: #($a).
|
|
self assert: parser parse: 'aa' to: #($a $a).
|
|
self
|
|
assert: parser
|
|
parse: 'aaa'
|
|
to: #($a $a)
|
|
end: 2.
|
|
self
|
|
assert: parser
|
|
parse: 'aaaa'
|
|
to: #($a $a)
|
|
end: 2.
|
|
printString := parser printString.
|
|
suffix := printString copyFrom: printString size - 5 to: printString size.
|
|
self assert: suffix = '[0, 2]'
|
|
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testMemoized [
|
|
| count parser twice |
|
|
count := 0.
|
|
parser := [ :s |
|
|
count := count + 1.
|
|
s next ] asParser memoized.
|
|
twice := parser and , parser.
|
|
count := 0.
|
|
self assert: parser parse: 'a' to: $a.
|
|
self assert: count equals: 1.
|
|
count := 0.
|
|
self assert: twice parse: 'a' to: #($a $a).
|
|
self assert: count equals: 1.
|
|
self assert: parser memoized equals: parser
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testMin [
|
|
| parser printString suffix |
|
|
parser := $a asParser min: 2.
|
|
self assert: parser min equals: 2.
|
|
self assert: parser max > parser min.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser parse: 'aa' to: #($a $a).
|
|
self assert: parser parse: 'aaa' to: #($a $a $a).
|
|
self assert: parser parse: 'aaaa' to: #($a $a $a $a).
|
|
printString := parser printString.
|
|
suffix := printString copyFrom: printString size - 5 to: printString size.
|
|
self assert: suffix = '[2, *]'
|
|
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> 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
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> 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
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testMinMax [
|
|
| parser printString suffix |
|
|
parser := $a asParser min: 2 max: 4.
|
|
self assert: parser min equals: 2.
|
|
self assert: parser max equals: 4.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser parse: 'aa' to: #($a $a).
|
|
self assert: parser parse: 'aaa' to: #($a $a $a).
|
|
self assert: parser parse: 'aaaa' to: #($a $a $a $a).
|
|
self
|
|
assert: parser
|
|
parse: 'aaaaa'
|
|
to: #($a $a $a $a)
|
|
end: 4.
|
|
self
|
|
assert: parser
|
|
parse: 'aaaaaa'
|
|
to: #($a $a $a $a)
|
|
end: 4.
|
|
printString := parser printString.
|
|
suffix := printString copyFrom: printString size - 5 to: printString size.
|
|
self assert: suffix = '[2, 4]'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing-accessing' }
|
|
PPParserTest >> testNamed [
|
|
| parser |
|
|
parser := PPSequenceParser new.
|
|
self assert: parser name isNil.
|
|
parser := PPChoiceParser named: 'choice'.
|
|
self assert: parser name equals: 'choice'.
|
|
parser := $* asParser name: 'star'.
|
|
self assert: parser name equals: 'star'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testNegate [
|
|
| parser |
|
|
parser := 'foo' asParser negate.
|
|
|
|
self assert: parser parse: 'f' to: $f end: 1.
|
|
self assert: parser parse: 'fo' to: $f end: 1.
|
|
self assert: parser parse: 'fob' to: $f end: 1.
|
|
self assert: parser parse: 'ffoo' to: $f end: 1.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'foo'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testNot [
|
|
| parser |
|
|
parser := 'foo' asParser flatten , 'bar' asParser flatten not.
|
|
|
|
self assert: parser parse: 'foobaz' to: #('foo' nil) end: 3.
|
|
self assert: parser fail: 'foobar'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testOptional [
|
|
| parser |
|
|
parser := $a asParser optional.
|
|
|
|
self assert: parser parse: '' to: nil.
|
|
self assert: parser parse: 'a' to: $a.
|
|
|
|
self assert: parser parse: 'aa' to: $a end: 1.
|
|
self assert: parser parse: 'ab' to: $a end: 1.
|
|
self assert: parser parse: 'b' to: nil end: 0.
|
|
self assert: parser parse: 'bb' to: nil end: 0.
|
|
self assert: parser parse: 'ba' to: nil end: 0
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testParse [
|
|
| parser result |
|
|
parser := $a asParser.
|
|
self assert: (parser parse: 'a') equals: $a.
|
|
self assert: (result := parser parse: 'b') isPetitFailure.
|
|
self assert: result message includesSubstring: $a printString.
|
|
self assert: result message includesSubstring: 'expected'.
|
|
self assert: result position equals: 0.
|
|
self assert: (parser parse: 'a' readStream) equals: $a.
|
|
self assert: (result := parser parse: 'b' readStream) isPetitFailure.
|
|
self assert: result message includesSubstring: $a printString.
|
|
self assert: result message includesSubstring: 'expected'.
|
|
self assert: result position equals: 0
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testParseOnError0 [
|
|
| parser result seen |
|
|
parser := $a asParser.
|
|
result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
|
|
self assert: result equals: $a.
|
|
result := parser parse: 'b' onError: [ seen := true ].
|
|
self assert: result.
|
|
self assert: seen
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testParseOnError1 [
|
|
| parser result seen |
|
|
parser := $a asParser.
|
|
result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
|
|
self assert: result equals: $a.
|
|
result := parser
|
|
parse: 'b'
|
|
onError: [ :failure |
|
|
self assert: failure position equals: 0.
|
|
self assert: failure message includesSubstring: $a printString.
|
|
self assert: failure message includesSubstring: 'expected'.
|
|
seen := true ].
|
|
self assert: result.
|
|
self assert: seen
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testParseOnError2 [
|
|
| parser result seen |
|
|
parser := $a asParser.
|
|
result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
|
|
self assert: result equals: $a.
|
|
result := parser
|
|
parse: 'b'
|
|
onError: [ :msg :pos |
|
|
self assert: msg includesSubstring: $a printString.
|
|
self assert: msg includesSubstring: 'expected'.
|
|
self assert: pos equals: 0.
|
|
seen := true ].
|
|
self assert: result.
|
|
self assert: seen
|
|
]
|
|
|
|
{ #category : 'testing-utilities' }
|
|
PPParserTest >> testParser [
|
|
| parser |
|
|
parser := PPParser new.
|
|
|
|
self assert: parser isPetitParser.
|
|
|
|
self deny: 4 isPetitParser.
|
|
self deny: 'foo' isPetitParser
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testPluggable [
|
|
| block parser |
|
|
block := [ :stream | stream position ].
|
|
parser := block asParser.
|
|
self assert: parser block equals: block
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testPlus [
|
|
| parser |
|
|
parser := $a asParser plus.
|
|
self assert: parser min equals: 1.
|
|
self assert: parser max > parser min.
|
|
self assert: parser parse: 'a' to: #($a).
|
|
self assert: parser parse: 'aa' to: #($a $a).
|
|
self assert: parser parse: 'aaa' to: #($a $a $a).
|
|
self
|
|
assert: parser
|
|
parse: 'ab'
|
|
to: #($a)
|
|
end: 1.
|
|
self
|
|
assert: parser
|
|
parse: 'aab'
|
|
to: #($a $a)
|
|
end: 2.
|
|
self
|
|
assert: parser
|
|
parse: 'aaab'
|
|
to: #($a $a $a)
|
|
end: 3.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'b'.
|
|
self assert: parser fail: 'ba'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testPlusGreedy [
|
|
| limit parser |
|
|
limit := #digit asParser.
|
|
parser := #word asParser plusGreedy: limit.
|
|
self assert: parser min equals: 1.
|
|
self assert: parser max > parser min.
|
|
self assert: parser limit equals: limit.
|
|
self assert: parser children size equals: 2.
|
|
self assert: parser children last equals: limit.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: '1'.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser fail: 'ab'.
|
|
self
|
|
assert: parser
|
|
parse: 'a1'
|
|
to: #($a)
|
|
end: 1.
|
|
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: '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: '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
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testPlusLazy [
|
|
| limit parser |
|
|
limit := #digit asParser.
|
|
parser := #word asParser plusLazy: limit.
|
|
self assert: parser min equals: 1.
|
|
self assert: parser max > parser min.
|
|
self assert: parser limit equals: limit.
|
|
self assert: parser children size equals: 2.
|
|
self assert: parser children last equals: limit.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: '1'.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser fail: 'ab'.
|
|
self
|
|
assert: parser
|
|
parse: 'a1'
|
|
to: #($a)
|
|
end: 1.
|
|
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: 'a12'
|
|
to: #($a)
|
|
end: 1.
|
|
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: 'a123'
|
|
to: #($a)
|
|
end: 1.
|
|
self
|
|
assert: parser
|
|
parse: 'ab123'
|
|
to: #($a $b)
|
|
end: 2.
|
|
self
|
|
assert: parser
|
|
parse: 'abc123'
|
|
to: #($a $b $c)
|
|
end: 3
|
|
]
|
|
|
|
{ #category : 'testing-properties' }
|
|
PPParserTest >> testPostCopy [
|
|
| parser copy |
|
|
parser := PPParser new.
|
|
parser propertyAt: #foo put: true.
|
|
copy := parser copy.
|
|
copy propertyAt: #foo put: false.
|
|
self assert: (parser propertyAt: #foo).
|
|
self deny: (copy propertyAt: #foo)
|
|
]
|
|
|
|
{ #category : 'testing-accessing' }
|
|
PPParserTest >> 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 printString.
|
|
|
|
parser := PPFailingParser message: 'error'.
|
|
self assert: parser printString includesSubstring: 'error'.
|
|
|
|
parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'.
|
|
self assert: parser printString includesSubstring: 'error'
|
|
]
|
|
|
|
{ #category : 'testing-properties' }
|
|
PPParserTest >> testPropertyAt [
|
|
| parser |
|
|
parser := PPParser new.
|
|
self should: [ parser propertyAt: #foo ] raise: Error.
|
|
parser propertyAt: #foo put: true.
|
|
self assert: (parser propertyAt: #foo)
|
|
]
|
|
|
|
{ #category : 'testing-properties' }
|
|
PPParserTest >> testPropertyAtIfAbsent [
|
|
| parser |
|
|
parser := PPParser new.
|
|
self assert: (parser propertyAt: #foo ifAbsent: [ true ]).
|
|
parser propertyAt: #foo put: true.
|
|
self assert: (parser propertyAt: #foo ifAbsent: [ false ])
|
|
]
|
|
|
|
{ #category : 'testing-properties' }
|
|
PPParserTest >> testPropertyAtIfAbsentPut [
|
|
| parser |
|
|
parser := PPParser new.
|
|
self assert: (parser propertyAt: #foo ifAbsentPut: [ true ]).
|
|
self assert: (parser propertyAt: #foo ifAbsentPut: [ false ])
|
|
]
|
|
|
|
{ #category : 'testing-properties' }
|
|
PPParserTest >> testRemoveProperty [
|
|
| parser |
|
|
parser := PPParser new.
|
|
self should: [ parser removeProperty: #foo ] raise: Error.
|
|
parser propertyAt: #foo put: true.
|
|
self assert: (parser removeProperty: #foo)
|
|
]
|
|
|
|
{ #category : 'testing-properties' }
|
|
PPParserTest >> testRemovePropertyIfAbsent [
|
|
| parser |
|
|
parser := PPParser new.
|
|
self assert: (parser removeProperty: #foo ifAbsent: [ true ]).
|
|
parser propertyAt: #foo put: true.
|
|
self assert: (parser removeProperty: #foo ifAbsent: [ false ])
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testSeparatedBy [
|
|
| parser |
|
|
parser := $a asParser separatedBy: $b asParser.
|
|
|
|
self assert: parser parse: 'a' to: #($a).
|
|
self assert: parser parse: 'aba' to: #($a $b $a).
|
|
self assert: parser parse: 'ababa' to: #($a $b $a $b $a).
|
|
|
|
self assert: parser parse: 'ab' to: #($a) end: 1.
|
|
self assert: parser parse: 'abab' to: #($a $b $a) end: 3.
|
|
self assert: parser parse: 'ac' to: #($a) end: 1.
|
|
self assert: parser parse: 'abac' to: #($a $b $a) end: 3.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'c'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testSequence [
|
|
| parser |
|
|
parser := $a asParser , $b asParser.
|
|
|
|
self assert: parser parse: 'ab' to: #($a $b).
|
|
|
|
self assert: parser parse: 'aba' to: #($a $b) end: 2.
|
|
self assert: parser parse: 'abb' to: #($a $b) end: 2.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser fail: 'aa'.
|
|
self assert: parser fail: 'ba'.
|
|
self assert: parser fail: 'bab'
|
|
]
|
|
|
|
{ #category : 'testing-fixtures' }
|
|
PPParserTest >> testSideEffectChoice [
|
|
"Adding another element to a choice should create a copy, otherwise we get unwanted side-effects."
|
|
|
|
| p1 p2 p3 |
|
|
p1 := $a asParser.
|
|
p2 := p1 / $b asParser.
|
|
p3 := p1 / $c asParser.
|
|
|
|
self assert: p1 parse: 'a'.
|
|
self assert: p1 fail: 'b'.
|
|
self assert: p1 fail: 'c'.
|
|
|
|
self assert: p2 parse: 'a'.
|
|
self assert: p2 parse: 'b'.
|
|
self assert: p2 fail: 'c'.
|
|
|
|
self assert: p3 parse: 'a'.
|
|
self assert: p3 fail: 'b'.
|
|
self assert: p3 parse: 'c'
|
|
]
|
|
|
|
{ #category : 'testing-fixtures' }
|
|
PPParserTest >> testSideEffectListCopy [
|
|
| old new |
|
|
old := $a asParser , $b asParser.
|
|
new := old copy.
|
|
|
|
self deny: old == new.
|
|
self deny: old children == new children.
|
|
self assert: old children first == new children first.
|
|
self assert: old children last == new children last
|
|
]
|
|
|
|
{ #category : 'testing-fixtures' }
|
|
PPParserTest >> testSideEffectSequence [
|
|
"Adding another element to a sequence should create a copy, otherwise we get unwanted side-effects."
|
|
|
|
| p1 p2 p3 |
|
|
p1 := $a asParser.
|
|
p2 := p1 , $b asParser.
|
|
p3 := p1 , $c asParser.
|
|
|
|
self assert: p1 parse: 'a'.
|
|
self assert: p1 parse: 'ab' end: 1.
|
|
self assert: p1 parse: 'ac' end: 1.
|
|
|
|
self assert: p2 fail: 'a'.
|
|
self assert: p2 parse: 'ab'.
|
|
self assert: p2 fail: 'ac'.
|
|
|
|
self assert: p3 fail: 'a'.
|
|
self assert: p3 fail: 'ab'.
|
|
self assert: p3 parse: 'ac'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testStar [
|
|
| parser |
|
|
parser := $a asParser star.
|
|
self assert: parser min equals: 0.
|
|
self assert: parser max > parser min.
|
|
self assert: parser parse: '' to: #().
|
|
self assert: parser parse: 'a' to: #($a).
|
|
self assert: parser parse: 'aa' to: #($a $a).
|
|
self assert: parser parse: 'aaa' to: #($a $a $a).
|
|
self
|
|
assert: parser
|
|
parse: 'b'
|
|
to: #()
|
|
end: 0.
|
|
self
|
|
assert: parser
|
|
parse: 'ab'
|
|
to: #($a)
|
|
end: 1.
|
|
self
|
|
assert: parser
|
|
parse: 'aab'
|
|
to: #($a $a)
|
|
end: 2.
|
|
self
|
|
assert: parser
|
|
parse: 'aaab'
|
|
to: #($a $a $a)
|
|
end: 3
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testStarGreedy [
|
|
| limit parser |
|
|
limit := #digit asParser.
|
|
parser := #word asParser starGreedy: limit.
|
|
self assert: parser min equals: 0.
|
|
self assert: parser max > parser min.
|
|
self assert: parser limit equals: limit.
|
|
self assert: parser children size equals: 2.
|
|
self assert: parser children last equals: limit.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser fail: 'ab'.
|
|
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
|
|
parse: 'abc1'
|
|
to: #($a $b $c)
|
|
end: 3.
|
|
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 $1)
|
|
end: 3.
|
|
self
|
|
assert: parser
|
|
parse: 'abc12'
|
|
to: #($a $b $c $1)
|
|
end: 4.
|
|
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
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testStarLazy [
|
|
| limit parser |
|
|
limit := #digit asParser.
|
|
parser := #word asParser starLazy: limit.
|
|
self assert: parser min equals: 0.
|
|
self assert: parser max > parser min.
|
|
self assert: parser limit equals: limit.
|
|
self assert: parser children size equals: 2.
|
|
self assert: parser children last equals: limit.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser fail: 'ab'.
|
|
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
|
|
parse: 'abc1'
|
|
to: #($a $b $c)
|
|
end: 3.
|
|
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
|
|
parse: 'abc12'
|
|
to: #($a $b $c)
|
|
end: 3.
|
|
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
|
|
parse: 'abc123'
|
|
to: #($a $b $c)
|
|
end: 3
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testTimes [
|
|
| parser |
|
|
parser := $a asParser times: 2.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'a'.
|
|
self assert: parser parse: 'aa' to: #($a $a).
|
|
self assert: parser parse: 'aaa' to: #($a $a) end: 2
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> testToken [
|
|
| parser |
|
|
parser := $a asParser token.
|
|
self assert: parser tokenClass equals: 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 equals: PPToken.
|
|
self
|
|
assert: parser
|
|
parse: 'a'
|
|
toToken: 1
|
|
stop: 1.
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'b'
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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'.
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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'
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testUnresolved [
|
|
| parser |
|
|
parser := PPUnresolvedParser new.
|
|
|
|
self assert: parser isUnresolved.
|
|
self should: [ parser parse: '' ] raise: Error.
|
|
self should: [ parser parse: 'a' ] raise: Error.
|
|
self should: [ parser parse: 'ab' ] raise: Error.
|
|
|
|
parser := nil asParser.
|
|
self deny: parser isUnresolved
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testWrapped [
|
|
| parser |
|
|
parser := $a asParser wrapped.
|
|
|
|
self assert: parser parse: 'a' to: $a.
|
|
self assert: parser fail: 'b'.
|
|
|
|
parser := (($a asParser , $b asParser ) wrapped , $c asParser).
|
|
self assert: parser parse: 'abc' to: #(#($a $b) $c)
|
|
]
|
|
|
|
{ #category : 'testing-mapping' }
|
|
PPParserTest >> 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 equals: 0.
|
|
self assert: result second isPetitFailure.
|
|
self assert: result last equals: 0
|
|
]
|
|
|
|
{ #category : 'testing' }
|
|
PPParserTest >> testXor [
|
|
| parser |
|
|
parser := ($a asParser / $b asParser)
|
|
| ($b asParser / $c asParser).
|
|
|
|
self assert: parser parse: 'a' to: $a.
|
|
self assert: parser parse: 'c' to: $c.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'b'.
|
|
self assert: parser fail: 'd'.
|
|
|
|
" truly symmetric "
|
|
parser := ($b asParser / $c asParser)
|
|
| ($a asParser / $b asParser).
|
|
|
|
self assert: parser parse: 'a' to: $a.
|
|
self assert: parser parse: 'c' to: $c.
|
|
|
|
self assert: parser fail: ''.
|
|
self assert: parser fail: 'b'.
|
|
self assert: parser fail: 'd'
|
|
]
|