SystemOrganization addCategory: #'PetitAnalyzer-Tests'! !PPParser methodsFor: '*petitanalyzer-enumerating' stamp: 'lr 11/21/2009 13:48'! allLeafNodes "Answer all the leaf nodes of the receiver." | result | result := OrderedCollection new. self allLeafNodesDo: [ :parser | result addLast: parser ]. ^ result! ! !PPParser methodsFor: '*petitanalyzer-enumerating' stamp: 'TestRunner 11/21/2009 13:51'! allLeafNodesDo: aBlock "Iterate over all the leaf nodes of the receiver." self allNodesDo: [ :each | each isLeaf ifTrue: [ aBlock value: each ] ] seen: IdentitySet new! ! !PPParser methodsFor: '*petitanalyzer-enumerating' stamp: 'lr 11/21/2009 13:48'! allNodes "Answer all the parse nodes of the receiver." | result | result := OrderedCollection new. self allNodesDo: [ :parser | result addLast: parser ]. ^ result! ! !PPParser methodsFor: '*petitanalyzer-enumerating' stamp: 'lr 10/22/2009 17:02'! allNodesDo: aBlock "Iterate over all the parse nodes of the receiver." self allNodesDo: aBlock seen: IdentitySet new! ! !PPParser methodsFor: '*petitanalyzer-enumerating' stamp: 'lr 10/22/2009 17:02'! allNodesDo: aBlock seen: aSet "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet." (aSet includes: self) ifTrue: [ ^ self ]. aSet add: self. aBlock value: self. self children do: [ :each | each allNodesDo: aBlock seen: aSet ]! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 11/19/2009 23:49'! cycleSet "Answer a set of all nodes that are within one or more cycles of left-recursion. This is generally not a problem if at least one of the nodes is memoized, but it might make the grammar very inefficient and should be avoided if possible." | cycles | cycles := IdentitySet new. self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles. ^ cycles! ! !PPParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/19/2009 23:47'! cycleSet: aDictionary "PRIVATE: Answer the children that could be part of a cycle-set with the receiver, subclasses might restrict the number of children returned. aDictionary is pre-calcualted first-sets." ^ self children! ! !PPParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/19/2009 23:49'! cycleSet: aStack firstSets: aDictionary into: aSet "PRIVATE: Try to find a cycle, where aStack contains the previously visited parsers. The method returns quickly when the receiver is a terminal, terminals cannot be part of a cycle. If aStack already contains the receiver, then we are in a cycle. In this case we don't process the children further and add the nodes to aSet." | index | self isLeaf ifTrue: [ ^ self ]. (index := aStack indexOf: self) > 0 ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ]. aStack addLast: self. (self cycleSet: aDictionary) do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ]. aStack removeLast! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 10/22/2009 19:59'! firstSet "Answer the first-set of the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #firstSets to calculate the first-sets at once." ^ self firstSets at: self! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 11/13/2009 11:14'! firstSets "Answer a dictionary with all the parsers reachable from the receiver as key and their first-set as value. The first-set of a parser is the list of terminal parsers that begin the parser derivable from that parser." | firstSets | firstSets := IdentityDictionary new. self allNodesDo: [ :each | firstSets at: each put: (each isLeaf ifTrue: [ IdentitySet with: each ] ifFalse: [ IdentitySet new ]) ]. [ | changed tally | changed := false. firstSets keysAndValuesDo: [ :parser :first | tally := first size. parser firstSets: firstSets into: first. changed := changed or: [ tally ~= first size ] ]. changed ] whileTrue. ^ firstSets! ! !PPParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/12/2009 21:25'! firstSets: aFirstDictionary into: aSet "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary." self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 11/12/2009 21:13'! followSet "Answer the follow-set of the receiver starting at the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #followSets to calculate the follow-sets at once." ^ self followSets at: self! ! !PPParser methodsFor: '*petitanalyzer-querying' stamp: 'lr 11/20/2009 15:30'! followSets "Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser." | current previous continue firstSets followSets | current := previous := 0. firstSets := self firstSets. followSets := IdentityDictionary new. self allNodesDo: [ :each | followSets at: each put: IdentitySet new ]. (followSets at: self) add: nil asParser. [ followSets keysAndValuesDo: [ :parser :follow | parser followSets: followSets firstSets: firstSets into: follow ]. current := followSets inject: 0 into: [ :result :each | result + each size ]. continue := previous < current. previous := current. continue ] whileTrue. ^ followSets! ! !PPParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/12/2009 21:25'! followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet "PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary." self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]! ! !PPParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 11/21/2009 13:52'! isLeaf "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser." ^ self children isEmpty! ! !PPParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 11/12/2009 17:25'! isNullable "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing." ^ false! ! !PPSequenceParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/19/2009 23:46'! cycleSet: aDictionary | firstSet | 1 to: parsers size do: [ :index | firstSet := aDictionary at: (parsers at: index). (firstSet noneSatisfy: [ :each | each isNullable ]) ifTrue: [ ^ parsers copyFrom: 1 to: index ] ]. ^ parsers! ! !PPSequenceParser methodsFor: '*petitanalyzer-private' stamp: 'lr 11/20/2009 15:31'! firstSets: aFirstDictionary into: aSet | nullable | parsers do: [ :parser | nullable := false. (aFirstDictionary at: parser) do: [ :each | each isNullable ifTrue: [ nullable := true ] ifFalse: [ aSet add: each ] ]. nullable ifFalse: [ ^ self ] ]. aSet add: nil asParser! ! !PPSequenceParser methodsFor: '*petitanalyzer-private' stamp: 'lr 10/22/2009 19:39'! followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet parsers withIndexDo: [ :parser :index | | followSet firstSet | followSet := aFollowDictionary at: parser. index = parsers size ifTrue: [ followSet addAll: aSet ] ifFalse: [ (self class withAll: (parsers copyFrom: index + 1 to: parsers size)) firstSets: aFirstDictionary into: (firstSet := IdentitySet new). (firstSet anySatisfy: [ :each | each isNullable ]) ifTrue: [ followSet addAll: aSet ]. followSet addAll: (firstSet reject: [ :each | each isNullable ]) ] ]! ! PPAbstractParseTest subclass: #PPAnalyzerTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitAnalyzer-Tests'! !PPAnalyzerTest class methodsFor: 'accessing' stamp: 'lr 11/19/2009 21:51'! packageNamesUnderTest ^ #('PetitAnalyzer')! ! !PPAnalyzerTest methodsFor: 'utilities' stamp: 'lr 10/22/2009 18:07'! assert: aCollection includes: aString epsilon: aBoolean | parsers checker stream | parsers := aCollection collect: [ :each | each end ]. checker := [ :string | parsers anySatisfy: [ :parser | (parser parse: string asParserStream) isFailure not ] ]. stream := WriteStream on: String new. 32 to: 127 do: [ :index | (checker value: (String with: (Character value: index))) ifTrue: [ stream nextPut: (Character value: index) ] ]. self assert: stream contents = aString description: 'Expected ' , aString printString , ', but got ' , stream contents printString. self assert: (checker value: '') = aBoolean description: 'Expected epsilon to ' , (aBoolean ifTrue: [ 'be' ] ifFalse: [ 'not be' ]) , ' included'! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 11/20/2009 15:29'! grammarA "Güting, Erwig, Übersetzerbau, Springer (p.63)" | grammar | grammar := Dictionary new. " terminals " grammar at: #a put: $a asParser. grammar at: #b put: $b asParser. grammar at: #c put: $c asParser. grammar at: #d put: $d asParser. grammar at: #e put: nil asParser. " non terminals " grammar at: #B put: (grammar at: #b) / (grammar at: #e). grammar at: #A put: (grammar at: #a) / (grammar at: #B). grammar at: #S put: (grammar at: #A) , (grammar at: #B) , (grammar at: #c) , (grammar at: #d). ^ grammar ! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 11/19/2009 23:42'! grammarB "The canonical grammar to exercise first- and follow-set calculation, probably originally from the dragon-book." | grammar | grammar := Dictionary new. #(E Ep T Tp F) do: [ :each | grammar at: each put: (PPUnresolvedParser named: each) ]. (grammar at: #E) def: (grammar at: #T) , (grammar at: #Ep). (grammar at: #Ep) def: ($+ asParser , (grammar at: #T) , (grammar at: #Ep)) optional. (grammar at: #T) def: (grammar at: #F) , (grammar at: #Tp). (grammar at: #Tp) def: ($* asParser , (grammar at: #F) , (grammar at: #Tp)) optional. (grammar at: #F) def: ($( asParser , (grammar at: #E) , $) asParser) / $i asParser. #(E Ep T Tp F) do: [ :each | (grammar at: each) name: each ]. ^ grammar! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 10/22/2009 18:32'! grammarC "A highly recrusive grammar." | grammar | grammar := PPUnresolvedParser new. grammar def: (grammar , $+ asParser , grammar) / $1 asParser. ^ grammar! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 11/19/2009 23:42'! grammarD "A highly ambiguous grammar from: Saichaitanya Jampana. Exploring the problem of ambiguity in context-free grammars. Master?À s thesis, Oklahoma State University, July 2005." | grammar | grammar := Dictionary new. #(S A a B b) do: [ :each | grammar at: each put: (PPUnresolvedParser named: each) ]. (grammar at: #a) def: $a asParser. (grammar at: #b) def: $b asParser. (grammar at: #S) def: (grammar at: #A) , (grammar at: #B) / (grammar at: #a). (grammar at: #A) def: (grammar at: #S) , (grammar at: #B) / (grammar at: #b). (grammar at: #B) def: (grammar at: #B) , (grammar at: #A) / (grammar at: #a). ^ grammar! ! !PPAnalyzerTest methodsFor: 'accessing' stamp: 'lr 11/19/2009 23:52'! grammarE "The most stupid parser, it just references itself and never consumes anything. All algorithms should survive such an attack." | parser | parser := PPDelegateParser new. parser setParser: parser. ^ parser! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 11/21/2009 13:50'! testAllLeafNodes | p1 p2 p3 | p1 := #lowercase asParser. p2 := p1 ==> #asUppercase. p3 := PPUnresolvedParser new. p3 def: p2 / p3. self assert: p1 allLeafNodes size = 1. self assert: p2 allLeafNodes size = 1. self assert: p3 allLeafNodes size = 1! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 11/21/2009 13:49'! testAllNodes | p1 p2 p3 | p1 := #lowercase asParser. p2 := p1 ==> #asUppercase. p3 := PPUnresolvedParser new. p3 def: p2 / p3. self assert: p1 allNodes size = 1. self assert: p2 allNodes size = 2. self assert: p3 allNodes size = 3! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 00:00'! testCycleSetGrammarA self grammarA do: [ :each | self assert: each cycleSet isEmpty ]! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 00:01'! testCycleSetGrammarB self grammarB do: [ :each | self assert: each cycleSet isEmpty ]! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 00:02'! testCycleSetGrammarC | grammar cycleSet | grammar := self grammarC. cycleSet := grammar cycleSet. self assert: (cycleSet size = 2). self assert: (cycleSet includes: grammar)! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'TestRunner 11/20/2009 00:04'! testCycleSetGrammarD | grammar cycleSet | grammar := self grammarD. cycleSet := (grammar at: #S) cycleSet. self assert: (cycleSet size = 4). self assert: (cycleSet includes: (grammar at: #A)). self assert: (cycleSet includes: (grammar at: #S)). cycleSet := (grammar at: #A) cycleSet. self assert: (cycleSet size = 4). self assert: (cycleSet includes: (grammar at: #A)). self assert: (cycleSet includes: (grammar at: #S)). cycleSet := (grammar at: #B) cycleSet. self assert: (cycleSet size = 2). self assert: (cycleSet includes: (grammar at: #B))! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 00:05'! testCycleSetGrammarE | grammar cycleSet | grammar := self grammarE. cycleSet := grammar cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: grammar)! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/19/2009 23:58'! testCycleSetInChoice | parser cycleSet | parser := PPUnresolvedParser new. parser def: parser / $a asParser. cycleSet := parser cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: parser). parser := PPUnresolvedParser new. parser def: $a asParser / parser. cycleSet := parser cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: parser).! ! !PPAnalyzerTest methodsFor: 'testing-cycleset' stamp: 'lr 11/20/2009 15:28'! testCycleSetInSequence | parser cycleSet | parser := PPUnresolvedParser new. parser def: parser , $a asParser. cycleSet := parser cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: parser). parser := PPUnresolvedParser new. parser def: nil asParser , parser. cycleSet := parser cycleSet. self assert: (cycleSet size = 1). self assert: (cycleSet includes: parser). parser := PPUnresolvedParser new. parser def: $a asParser , parser. cycleSet := parser cycleSet. self assert: cycleSet isEmpty! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 10/22/2009 18:10'! testFirstSetExpression | grammar | grammar := PPExpressionParser new. self assert: grammar start firstSet includes: '(-0123456789' epsilon: false. self assert: grammar addition firstSet includes: '(-0123456789' epsilon: false. self assert: grammar factors firstSet includes: '(-0123456789' epsilon: false. self assert: grammar multiplication firstSet includes: '(-0123456789' epsilon: false. self assert: grammar number firstSet includes: '-0123456789' epsilon: false. self assert: grammar parentheses firstSet includes: '(' epsilon: false. self assert: grammar power firstSet includes: '(-0123456789' epsilon: false. self assert: grammar primary firstSet includes: '(-0123456789' epsilon: false. self assert: grammar terms firstSet includes: '(-0123456789' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 11/12/2009 17:53'! testFirstSetGrammarA | grammar | grammar := self grammarA. self assert: (grammar at: #a) firstSet includes: 'a' epsilon: false. self assert: (grammar at: #b) firstSet includes: 'b' epsilon: false. self assert: (grammar at: #c) firstSet includes: 'c' epsilon: false. self assert: (grammar at: #d) firstSet includes: 'd' epsilon: false. self assert: (grammar at: #e) firstSet includes: '' epsilon: true. self assert: (grammar at: #S) firstSet includes: 'abc' epsilon: false. self assert: (grammar at: #A) firstSet includes: 'ab' epsilon: true. self assert: (grammar at: #B) firstSet includes: 'b' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 11/12/2009 17:53'! testFirstSetGrammarB | grammar | grammar := self grammarB. self assert: (grammar at: #E) firstSet includes: '(i' epsilon: false. self assert: (grammar at: #Ep) firstSet includes: '+' epsilon: true. self assert: (grammar at: #T) firstSet includes: '(i' epsilon: false. self assert: (grammar at: #Tp) firstSet includes: '*' epsilon: true. self assert: (grammar at: #F) firstSet includes: '(i' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 11/12/2009 17:53'! testFirstSetGrammarC | grammar | grammar := self grammarC. self assert: grammar firstSet includes: '1' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'TestRunner 11/12/2009 17:55'! testFirstSetGrammarD | grammar | grammar := self grammarD. self assert: (grammar at: #S) firstSet includes: 'ab' epsilon: false. self assert: (grammar at: #A) firstSet includes: 'ab' epsilon: false. self assert: (grammar at: #B) firstSet includes: 'a' epsilon: false. self assert: (grammar at: #a) firstSet includes: 'a' epsilon: false. self assert: (grammar at: #b) firstSet includes: 'b' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 11/19/2009 23:55'! testFirstSetGrammarE self assert: self grammarE firstSet includes: '' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-firstset' stamp: 'lr 10/22/2009 18:10'! testFirstSetLambda | grammar | grammar := PPLambdaParser new. self assert: grammar start firstSet includes: '(ABCDEFGHIJKLMNOPQRSTUVWXYZ\abcdefghijklmnopqrstuvwxyz' epsilon: false. self assert: grammar abstraction firstSet includes: '\' epsilon: false. self assert: grammar application firstSet includes: '(' epsilon: false. self assert: grammar expression firstSet includes: '(ABCDEFGHIJKLMNOPQRSTUVWXYZ\abcdefghijklmnopqrstuvwxyz' epsilon: false. self assert: grammar variable firstSet includes: 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 10/22/2009 19:53'! testFollowSetExampleA | grammar followSets | grammar := self grammarA. followSets := (grammar at: #S) followSets. self assert: (followSets at: (grammar at: #a)) includes: 'bc' epsilon: false. self assert: (followSets at: (grammar at: #b)) includes: 'bc' epsilon: false. self assert: (followSets at: (grammar at: #c)) includes: 'd' epsilon: false. self assert: (followSets at: (grammar at: #d)) includes: '' epsilon: true. self assert: (followSets at: (grammar at: #e)) includes: 'bc' epsilon: false. self assert: (followSets at: (grammar at: #S)) includes: '' epsilon: true. self assert: (followSets at: (grammar at: #A)) includes: 'bc' epsilon: false. self assert: (followSets at: (grammar at: #B)) includes: 'bc' epsilon: false! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 10/22/2009 19:06'! testFollowSetExampleB | grammar followSets | grammar := self grammarB. followSets := (grammar at: #E) followSets. self assert: (followSets at: (grammar at: #E)) includes: ')' epsilon: true. self assert: (followSets at: (grammar at: #Ep)) includes: ')' epsilon: true. self assert: (followSets at: (grammar at: #T)) includes: ')+' epsilon: true. self assert: (followSets at: (grammar at: #Tp)) includes: ')+' epsilon: true. self assert: (followSets at: (grammar at: #F)) includes: ')*+' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 10/22/2009 19:10'! testFollowSetExampleC self assert: self grammarC followSet includes: '+' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 11/12/2009 18:00'! testFollowSetExampleD | grammar followSets | grammar := self grammarD. followSets := (grammar at: #S) followSets. self assert: (followSets at: (grammar at: #S)) includes: 'a' epsilon: true. self assert: (followSets at: (grammar at: #A)) includes: 'ab' epsilon: true. self assert: (followSets at: (grammar at: #B)) includes: 'ab' epsilon: true. self assert: (followSets at: (grammar at: #a)) includes: 'ab' epsilon: true. self assert: (followSets at: (grammar at: #b)) includes: 'ab' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing-followset' stamp: 'lr 11/19/2009 23:54'! testFollowSetExampleE self assert: self grammarE followSet includes: '' epsilon: true! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 11/13/2009 11:16'! testIsLeaf self assert: PPEpsilonParser new isLeaf. self assert: PPFailingParser new isLeaf. self assert: PPPluggableParser new isLeaf. self assert: PPLiteralSequenceParser new isLeaf. self assert: PPLiteralObjectParser new isLeaf. self assert: PPPredicateParser new isLeaf. self deny: PPChoiceParser new isLeaf. self deny: PPSequenceParser new isLeaf. self deny: PPAndParser new isLeaf. self deny: PPTokenParser new isLeaf! ! !PPAnalyzerTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:29'! testIsNullable self assert: $a asParser star isNullable. self assert: nil asParser isNullable. self deny: $a asParser plus isNullable. self deny: PPLiteralSequenceParser new isNullable. self deny: PPLiteralObjectParser new isNullable. self deny: PPPredicateParser new isNullable. self deny: PPChoiceParser new isNullable. self deny: PPSequenceParser new isNullable. self deny: PPAndParser new isNullable. self deny: PPTokenParser new isNullable! ! !PPEpsilonParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 10/21/2009 12:11'! isNullable ^ true! ! !PPRepeatingParser methodsFor: '*petitanalyzer-testing' stamp: 'lr 10/21/2009 12:13'! isNullable ^ min = 0! !