Temporarily disabled #acceptsEpsilon test in PPCTokenizingCodeGenerator>>visitChoiceNode:
JK should have a look and come up with proper solution.
"{ Package: 'stx:goodies/petitparser/analyzer/tests' }"
"{ NameSpace: Smalltalk }"
PPAbstractParserTest subclass:#PPSearcherTest
instanceVariableNames:'searcher'
classVariableNames:''
poolDictionaries:''
category:'PetitAnalyzer-Tests'
!
!PPSearcherTest methodsFor:'running'!
setUp
searcher := PPSearcher new
! !
!PPSearcherTest methodsFor:'testing'!
testAnyPattern
| result |
searcher
matches: PPPattern any
do: [ :parser :answer |
answer
add: parser;
yourself ].
result := searcher execute: $a asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 1.
result := searcher execute: $a asParser star initialAnswer: OrderedCollection new.
self assert: result size equals: 2.
result := searcher execute: $a asParser , $b asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 3
!
testClassPattern
| result |
searcher
matches: (PPPattern class: PPLiteralObjectParser)
do: [ :parser :answer |
answer
add: parser;
yourself ].
result := searcher execute: $a asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 1.
self assert: (result allSatisfy: [ :each | each class = PPLiteralObjectParser ]).
result := searcher execute: 'abc' asParser initialAnswer: OrderedCollection new.
self assert: result isEmpty.
result := searcher execute: #any asParser initialAnswer: OrderedCollection new.
self assert: result isEmpty.
result := searcher execute: $a asParser / #any asParser , $b asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 2.
self assert: (result allSatisfy: [ :each | each class = PPLiteralObjectParser ])
!
testKindPattern
| result |
searcher
matches: (PPPattern kind: PPLiteralParser)
do: [ :parser :answer |
answer
add: parser;
yourself ].
result := searcher execute: $a asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 1.
self assert: (result allSatisfy: [ :each | each class = PPLiteralObjectParser ]).
result := searcher execute: 'abc' asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 1.
self assert: (result allSatisfy: [ :each | each class = PPLiteralSequenceParser ]).
result := searcher execute: #any asParser initialAnswer: OrderedCollection new.
self assert: result isEmpty.
result := searcher execute: $a asParser / #any asParser , $b asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 2.
self assert: (result allSatisfy: [ :each | each class = PPLiteralObjectParser ])
!
testMatchesAny
| result |
searcher
matchesAnyOf: (Array with: $a asParser with: $b asParser)
do: [ :parser :answer |
answer
add: parser;
yourself ].
result := searcher execute: $a asParser , $b asParser , $c asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 2.
self assert: result first literal equals: $a.
self assert: result last literal equals: $b
!
testMultiplePattern
| result |
searcher
matches: $a asParser
do: [ :parser :answer |
answer first add: parser.
answer ].
searcher
matches: PPPattern any
do: [ :parser :answer |
answer second add: parser.
answer ].
result := searcher
execute: $a asParser , $a asParser , $b asParser
initialAnswer: (Array with: OrderedCollection new with: OrderedCollection new).
self assert: result first size equals: 2.
self assert: result first first literal equals: $a.
self assert: result first last literal equals: $a.
self assert: result last size equals: 2.
self assert: result last first class equals: PPSequenceParser.
self assert: result last last literal equals: $b
!
testNamePattern
| result |
searcher
matches: (PPPattern name: 'foo')
do: [ :parser :answer |
answer
add: parser;
yourself ].
result := searcher execute: $a asParser initialAnswer: OrderedCollection new.
self assert: result isEmpty.
result := searcher execute: ($a asParser name: 'foo') initialAnswer: OrderedCollection new.
self assert: result size equals: 1.
self assert: result first name equals: 'foo'.
result := searcher execute: ($a asParser name: 'bar') , ($b asParser name: 'foo') initialAnswer: OrderedCollection new.
self assert: result size equals: 1.
self assert: result first name equals: 'foo'
!
testNewPattern
self
should: [ PPPattern new ]
raise: Error
!
testRecursivePattern
| recursive |
recursive := PPDelegateParser new.
recursive setParser: recursive.
searcher matches: recursive do: [ :parser :answer | parser ].
self assert: (searcher execute: recursive) equals: recursive.
self assert: (searcher execute: $a asParser) isNil.
self assert: (searcher execute: $a asParser / $b asParser star) isNil
!
testRepeatedPattern
| pattern result |
searcher
matches: (pattern := PPPattern any) , pattern
do: [ :parser :answer |
answer
add: parser;
yourself ].
result := searcher execute: $a asParser , $b asParser initialAnswer: OrderedCollection new.
self assert: result isEmpty.
result := searcher execute: $a asParser , $a asParser initialAnswer: OrderedCollection new.
self assert: result size equals: 1.
result := searcher execute: $a asParser , ($a asParser , $b asParser) initialAnswer: OrderedCollection new.
self assert: result isEmpty.
result := searcher execute: $b asParser , ($a asParser , $a asParser) initialAnswer: OrderedCollection new.
self assert: result size equals: 1
! !
!PPSearcherTest methodsFor:'testing-copy'!
testCopyMatchAction
| old new |
old := $a asParser ==> [ :token | $b ].
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchDelegate
| old new |
old := $a asParser token trim.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchEpsilon
| old new |
old := nil asParser.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchFailure
| old new |
old := PPFailingParser message: 'problem'.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchList
| old new |
old := $a asParser , $b asParser , $c asParser.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchLiteral
| old new |
old := $a asParser.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchPluggable
| old new |
old := [ :stream | ] asParser.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchPredicate
| old new |
old := #word asParser.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchPredicateSequence
| old new |
old := 'foo' asParser caseInsensitive.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchRecursiveDelegate
| old new |
old := PPDelegateParser new.
old setParser: old.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchRecursiveList
| old new |
old := PPChoiceParser new.
old setParsers: (Array with: old).
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchRepetition
| old new |
old := #word asParser star.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchRepetitionGreedy
| old new |
old := #word asParser starGreedy: #digit asParser.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchRepetitionLazy
| old new |
old := #word asParser starLazy: #digit asParser.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
!
testCopyMatchRepetitionMinMax
| old new |
old := #word asParser min: 5 max: 10.
new := old copyInContext: Dictionary new.
self assert: (old match: old inContext: Dictionary new).
self assert: (old match: new inContext: Dictionary new).
self deny: (old == new).
! !
!PPSearcherTest methodsFor:'testing-lists'!
testListInfix
| result |
searcher
matches: PPListPattern any , $a asParser , PPListPattern any
do: [ :parser :answer | true ].
result := searcher
execute: $a asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $a asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $b asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $a asParser , $a asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $a asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $a asParser , $b asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $a asParser , $a asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $b asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $a asParser , $b asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $a asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $b asParser , $b asParser
initialAnswer: false.
self deny: result
!
testListPostfix
| result |
searcher
matches: PPListPattern any , $b asParser
do: [ :parser :answer | true ].
result := searcher
execute: $a asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $a asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $b asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $a asParser , $a asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $b asParser , $a asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $a asParser , $b asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $a asParser , $a asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $b asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $a asParser , $b asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $a asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $b asParser , $b asParser
initialAnswer: false.
self assert: result
!
testListPrefix
| result |
searcher
matches: $a asParser , PPListPattern any
do: [ :parser :answer | true ].
result := searcher
execute: $a asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $a asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $b asParser , $b asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $a asParser , $a asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $a asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $a asParser , $b asParser , $a asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $a asParser , $a asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $b asParser , $a asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $a asParser , $b asParser , $b asParser
initialAnswer: false.
self assert: result.
result := searcher
execute: $b asParser , $a asParser , $b asParser
initialAnswer: false.
self deny: result.
result := searcher
execute: $b asParser , $b asParser , $b asParser
initialAnswer: false.
self deny: result
! !
!PPSearcherTest class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/petitparser/analyzer/tests/PPSearcherTest.st,v 1.1 2014-03-04 15:43:09 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/petitparser/analyzer/tests/PPSearcherTest.st,v 1.1 2014-03-04 15:43:09 cg Exp $'
!
version_HG
^ '$Changeset: <not expanded> $'
! !