SystemOrganization addCategory: #'PetitParser-Core'! SystemOrganization addCategory: #'PetitParser-Builder'! SystemOrganization addCategory: #'PetitParser-Tests'! !SequenceableCollection methodsFor: '*petitparser' stamp: 'lr 4/19/2008 19:58'! asParser ^ self inject: PPSequenceParser new into: [ :result :each | result , each asParser ]! ! !Set methodsFor: '*petitparser' stamp: 'lr 4/19/2008 19:58'! asParser ^ self inject: PPChoiceParser new into: [ :result :each | result | each asParser ]! ! !PositionableStream methodsFor: '*petitparser' stamp: 'lr 4/19/2008 13:17'! collection ^ collection! ! !Object methodsFor: '*petitparser' stamp: 'lr 4/20/2008 16:06'! asParser ^ PPPredicateParser expect: self! ! !Object methodsFor: '*petitparser-testing' stamp: 'lr 4/18/2008 13:40'! isFailure ^ false! ! Object subclass: #PPFailure instanceVariableNames: 'reason position' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPFailure class methodsFor: 'instance-creation' stamp: 'lr 4/18/2008 14:17'! reason: aString ^ self new reason: aString! ! !PPFailure class methodsFor: 'instance-creation' stamp: 'lr 4/19/2008 09:24'! reason: aString position: anInteger ^ self new reason: aString; position: anInteger! ! !PPFailure methodsFor: 'testing' stamp: 'lr 4/18/2008 13:41'! isFailure ^ true! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:24'! position ^ position! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:24'! position: anInteger position := anInteger! ! !PPFailure methodsFor: 'printing' stamp: 'lr 4/18/2008 12:04'! printOn: aStream aStream nextPutAll: reason! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:24'! reason ^ reason! ! !PPFailure methodsFor: 'accessing' stamp: 'lr 4/18/2008 14:18'! reason: aString reason := aString! ! Object subclass: #PPParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! PPParser subclass: #PPCompositeParser instanceVariableNames: 'productions' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Builder'! !PPCompositeParser class methodsFor: 'rules' stamp: 'lr 4/20/2008 18:42'! transformParser ^ DSLConditionPattern new if: [ :visitor | visitor tree isMethod and: [ visitor selector isUnary and: [ visitor theClass ~= PPCompositeParser ] ] ] then: (Array with: (DSLSearchPattern new expression: '`#var'; action: [ :visitor | (visitor node value isString or: [ visitor node value isCharacter ]) ifTrue: [ visitor node replaceWith: ``(`,(visitor node value) asParser) ] ]) with: (DSLSearchPattern new expression: '`var'; action: [ :visitor | ((Smalltalk hasClassNamed: visitor node name) or: [ (visitor tree allDefinedVariables includes: visitor node name) or: [ (visitor theClass allInstVarNames includes: visitor node name) ] ]) ifFalse: [ visitor node replaceWith: ``(self productionAt: `,(visitor node name asSymbol)) ] ]) with: [ :visitor | visitor tree body lastIsReturn ifTrue: [ visitor tree body statements last replaceWith: visitor tree body statements last value ]. visitor tree body addNodeFirst: ``(self productionAt: `,(visitor tree selector) ifAbsentPut: [ `,(visitor tree body) ]). visitor tree body statements allButFirst do: [ :each | visitor tree body removeNode: each ]. visitor tree body addReturn ])! ! !PPCompositeParser methodsFor: 'initialization' stamp: 'lr 4/20/2008 11:35'! initialize super initialize. productions := Dictionary new! ! !PPCompositeParser methodsFor: 'parsing' stamp: 'lr 4/19/2008 20:53'! parse: aStream forwarder isNil ifFalse: [ self transformForwarder ]. ^ start parse: aStream! ! !PPCompositeParser methodsFor: 'private' stamp: 'lr 4/19/2008 21:14'! performInitializer self class allSelectors do: [ :selector | (selector isUnary and: [ selector size > #initialize size and: [ selector beginsWith: #initialize ] ]) ifTrue: [ self perform: selector ] ]! ! !PPCompositeParser methodsFor: 'private' stamp: 'lr 4/19/2008 20:49'! prepareForwarder forwarder := Array new: self class instSize - 1. 1 to: forwarder size do: [ :index | forwarder at: index put: (self instVarAt: index + 1 put: PPForwarderParser new) ]! ! !PPCompositeParser methodsFor: 'accessing' stamp: 'lr 4/20/2008 16:19'! productionAt: aSymbol ^ productions at: aSymbol ifAbsentPut: [ PPUnresolvedParser on: self name: aSymbol ]! ! !PPCompositeParser methodsFor: 'accessing' stamp: 'lr 4/20/2008 16:30'! productionAt: aSymbol ifAbsentPut: aBlock | production | production := productions at: aSymbol ifAbsentPut: aBlock. production isUnresolved ifTrue: [ production becomeForward: aBlock value ]. ^ production! ! !PPCompositeParser methodsFor: 'private' stamp: 'lr 4/19/2008 20:54'! transformForwarder | target | target := Array new: forwarder size. 1 to: target size do: [ :index | target at: index put: (self instVarAt: index + 1) ]. forwarder elementsForwardIdentityTo: target. forwarder := nil! ! PPCompositeParser subclass: #PPLambdaParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Builder'! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/20/2008 11:53'! abstraction $\ , variable , $. , expression! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/20/2008 15:25'! application expression , expression => [ :foo :bar | Array with: foo with: bar ]! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/20/2008 11:53'! expression variable | abstraction | application! ! !PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/20/2008 14:02'! variable #letter plus! ! PPCompositeParser subclass: #PPSmalltalkParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Builder'! !PPSmalltalkParser methodsFor: 'scanner' stamp: 'lr 4/20/2008 16:07'! comment ": \"" [^\""]* \"" ;" $" , $" not star , $"! ! !PPSmalltalkParser methodsFor: 'scanner-number' stamp: 'lr 4/20/2008 16:08'! decimalNumber ": [0-9]+ (\. [0-9]+)? ;" #digit plus , ($. , #digit plus) optional! ! !PPSmalltalkParser methodsFor: 'scanner-number' stamp: 'lr 4/20/2008 16:08'! exponentNumber ": ( | ) e \-? [0-9]+ ;" (decimalNumber | radixNumber) , $e , $- optional , #digit plus! ! !PPSmalltalkParser methodsFor: 'scanner' stamp: 'lr 4/20/2008 16:01'! identifier #letter , #word star! ! !PPSmalltalkParser methodsFor: 'scanner' stamp: 'lr 4/20/2008 16:09'! keyword ": \: ;" name , $:! ! !PPSmalltalkParser methodsFor: 'scanner' stamp: 'lr 4/20/2008 16:09'! multikeyword ": \: ( \: )+ ;" name , $: , (name , $:) plus! ! !PPSmalltalkParser methodsFor: 'scanner' stamp: 'lr 4/20/2008 16:09'! name ": [a-zA-Z] [a-zA-Z0-9]* ;" #letter , #word star! ! !PPSmalltalkParser methodsFor: 'scanner-number' stamp: 'lr 4/20/2008 16:13'! negativeNumber ": \- ;" $- , number! ! !PPSmalltalkParser methodsFor: 'scanner' stamp: 'lr 4/20/2008 18:38'! number ": | | | ;" scaledNumber | exponentNumber | radixNumber | decimalNumber! ! !PPSmalltalkParser methodsFor: 'scanner-number' stamp: 'lr 4/20/2008 16:11'! radixNumber ": [0-9]+ r [0-9A-Z]+ (\. [0-9A-Z]+)? ;" #digit plus , $r , (#digit | #uppercase) plus , ($. , (#digit | #uppercase) plus) optional! ! !PPSmalltalkParser methodsFor: 'scanner-number' stamp: 'lr 4/20/2008 16:11'! scaledNumber ": s [0-9]+ ;" decimalNumber , $s , #digit plus! ! !PPSmalltalkParser methodsFor: 'scanner' stamp: 'lr 4/20/2008 16:11'! string ": \' [^\']* \' (\' [^\']* \')* ;" $' , $' not star , $' , ($' , $' not star , $' ) star! ! !PPSmalltalkParser methodsFor: 'scanner' stamp: 'lr 4/20/2008 16:16'! whitespace ": \s* ;" #space star! ! PPParser subclass: #PPDelegateParser instanceVariableNames: 'parser' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPDelegateParser commentStamp: 'lr 4/19/2008 12:57' prior: 0! A parser that delegates to another parser.! PPDelegateParser subclass: #PPActionParser instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPActionParser commentStamp: 'lr 4/19/2008 12:55' prior: 0! A parser that performs an action on the delegate.! !PPActionParser methodsFor: 'accessing' stamp: 'lr 4/18/2008 14:02'! block: aBlock block := aBlock! ! !PPActionParser methodsFor: 'parsing' stamp: 'lr 4/19/2008 10:03'! parse: aStream | element | element := super parse: aStream. ^ element isFailure ifTrue: [ element ] ifFalse: [ block value: element ]! ! !PPDelegateParser class methodsFor: 'instance-creation' stamp: 'lr 4/20/2008 16:22'! on: aParser ^ self new setParser: aParser! ! !PPDelegateParser methodsFor: 'parsing' stamp: 'lr 4/20/2008 16:22'! parse: aStream ^ parser parse: aStream! ! !PPDelegateParser methodsFor: 'printing' stamp: 'lr 4/20/2008 16:23'! printOn: aStream aStream nextPut: $(; print: parser; nextPut: $)! ! !PPDelegateParser methodsFor: 'initialization' stamp: 'lr 4/20/2008 16:23'! setParser: aParser parser := aParser! ! PPDelegateParser subclass: #PPStarParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPStarParser commentStamp: 'lr 4/19/2008 12:56' prior: 0! A parser that parses zero or more instances of my delegate.! !PPStarParser methodsFor: 'parsing' stamp: 'lr 4/20/2008 16:24'! parse: aStream | position elements element | elements := OrderedCollection new. [ position := aStream position. element := parser parse: aStream. element isFailure ifTrue: [ aStream position: position. ^ elements asArray ]. elements add: element ] repeat! ! !PPStarParser methodsFor: 'printing' stamp: 'lr 4/19/2008 09:55'! printOn: aStream super printOn: aStream. aStream nextPut: $*! ! PPDelegateParser subclass: #PPTokenParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPTokenParser commentStamp: 'lr 4/19/2008 12:54' prior: 0! A parser that produces a token from the range my delegate parses.! !PPTokenParser methodsFor: 'parsing' stamp: 'lr 4/19/2008 13:18'! parse: aStream | position element | position := aStream position. element := super parse: aStream. element isFailure ifTrue: [ ^ element ]. ^ aStream collection sliceFrom: position + 1 to: aStream position! ! PPParser subclass: #PPEndOfInputParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPEndOfInputParser commentStamp: 'lr 4/18/2008 13:46' prior: 0! A parser that succeeds only at the end of the input stream.! !PPEndOfInputParser methodsFor: 'parsing' stamp: 'lr 4/19/2008 10:03'! parse: aStream ^ aStream atEnd ifFalse: [ PPFailure reason: 'end of input expected' position: aStream position ]! ! !PPEndOfInputParser methodsFor: 'printing' stamp: 'lr 4/18/2008 14:13'! printOn: aStream aStream nextPut: $$! ! PPParser subclass: #PPEpsilonParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPEpsilonParser commentStamp: 'lr 4/18/2008 15:35' prior: 0! A parser that always succeeds.! !PPEpsilonParser methodsFor: 'parsing' stamp: 'lr 4/18/2008 14:13'! parse: aStream ^ nil! ! !PPEpsilonParser methodsFor: 'printing' stamp: 'lr 4/18/2008 15:21'! printOn: aStream aStream nextPut: $ø! ! PPParser subclass: #PPFailingParser instanceVariableNames: 'message' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPFailingParser class methodsFor: 'instance-creation' stamp: 'lr 4/19/2008 09:57'! message: aString ^ self new message: aString! ! !PPFailingParser methodsFor: 'accessing' stamp: 'lr 4/19/2008 09:56'! message: aString message := aString! ! !PPFailingParser methodsFor: 'parsing' stamp: 'lr 4/19/2008 12:32'! parse: aStream ^ PPFailure reason: message position: aStream position! ! PPParser subclass: #PPMultipleParser instanceVariableNames: 'parsers' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! PPMultipleParser subclass: #PPChoiceParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPChoiceParser commentStamp: 'lr 4/18/2008 15:35' prior: 0! A parser that uses the first parser that succeeds.! !PPChoiceParser methodsFor: 'parsing' stamp: 'lr 4/18/2008 14:14'! parse: aStream | item | parsers do: [ :parser | item := parser parse: aStream. item isFailure ifFalse: [ ^ item ] ]. ^ item! ! !PPChoiceParser methodsFor: 'printing' stamp: 'lr 4/20/2008 15:33'! printOn: aStream aStream nextPut: $(. parsers do: [ :each | aStream print: each ] separatedBy: [ aStream nextPutAll: ' | ' ]. aStream nextPut: $)! ! !PPChoiceParser methodsFor: 'operations' stamp: 'lr 4/18/2008 10:53'! | aRule parsers add: aRule! ! !PPMultipleParser methodsFor: 'initialization' stamp: 'lr 4/18/2008 10:53'! initialize super initialize. parsers := OrderedCollection new! ! PPMultipleParser subclass: #PPSequenceParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPSequenceParser commentStamp: 'lr 4/18/2008 15:34' prior: 0! A parser that parses a sequence of parsers.! !PPSequenceParser methodsFor: 'operations' stamp: 'lr 4/18/2008 10:53'! , aRule parsers add: aRule! ! !PPSequenceParser methodsFor: 'parsing' stamp: 'lr 4/18/2008 14:14'! parse: aStream | position items item | position := aStream position. items := OrderedCollection new: parsers size. parsers do: [ :parser | item := parser parse: aStream. item isFailure ifTrue: [ aStream position: position. ^ item ]. items add: item ]. ^ items asArray! ! !PPSequenceParser methodsFor: 'printing' stamp: 'lr 4/20/2008 15:34'! printOn: aStream aStream nextPut: $(. parsers do: [ :each | aStream print: each ] separatedBy: [ aStream nextPutAll: ' , ' ]. aStream nextPut: $)! ! !PPParser class methodsFor: 'instance-creation' stamp: 'lr 4/18/2008 14:00'! new ^ self basicNew initialize! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 19:58'! , aParser "Answer a new parser that parses the receiver followed by aParser." ^ PPSequenceParser new , self , aParser! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 10:05'! ==> aBlock "Assigns aBlock as a success action handler." ^ (PPActionParser on: self) block: aBlock! ! !PPParser methodsFor: 'converting' stamp: 'lr 4/19/2008 13:08'! asParser ^ self! ! !PPParser methodsFor: 'initialization' stamp: 'lr 4/18/2008 14:00'! initialize action := [ :value | value ]. failure := PPFailure new! ! !PPParser methodsFor: 'testing' stamp: 'lr 4/20/2008 16:30'! isUnresolved ^ false! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/20/2008 14:05'! optional "Answer a new parser that parses the receiver, if possible." ^ self | PPEpsilonParser new! ! !PPParser methodsFor: 'parsing' stamp: 'lr 4/18/2008 14:01'! parse: aStream self subclassResponsability! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 10:07'! plus "Answer a new parser that parses the receiver one or more times." ^ (self , self star) ==> [ :value | (Array with: value first) , value second ]! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 10:07'! star "Answer a new parser that parses the receiver zero or more times." ^ PPStarParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 12:48'! token "Answer a new parser that parses a token." ^ PPTokenParser on: self! ! !PPParser methodsFor: 'operations' stamp: 'lr 4/19/2008 19:59'! | aParser "Answer a new parser that either parses the receiver or aParser." ^ PPChoiceParser new | self | aParser! ! PPParser subclass: #PPPredicateParser instanceVariableNames: 'predicate predicateMessage negated negatedMessage' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Core'! !PPPredicateParser commentStamp: 'lr 4/18/2008 15:34' prior: 0! A parser that accepts if a given predicate holds.! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 4/19/2008 11:21'! any ^ self on: [ :each | true ] message: 'something expected' negated: [ :each | false ] message: 'nothing expected'! ! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 4/19/2008 11:25'! between: min and: max ^ self on: [ :each | each >= min and: [ each <= max ] ] message: min printString , '..' , max printString , ' expected' negated: [ :each | each < min or: [ each > max ] ] message: min printString , '..' , max printString , ' not expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/20/2008 15:54'! char: aCharacter ^ self expect: aCharacter! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:28'! control ^ self on: [ :each | each asInteger < 32 ] message: 'control character expected' negated: [ :each | each asInteger >= 32 ] message: 'no control character expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:35'! digit ^ self on: [ :each | each isDigit ] message: 'digit expected' negated: [ :each | each isDigit not ] message: 'no digit expected'! ! !PPPredicateParser class methodsFor: 'factory-objects' stamp: 'lr 4/19/2008 11:21'! expect: anObject ^ self on: [ :each | each = anObject ] message: anObject printString , ' expected' negated: [ :each | each ~= anObject ] message: anObject printString , ' not expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:35'! letter ^ self on: [ :each | each isLetter ] message: 'letter expected' negated: [ :each | each isLetter not ] message: 'no letter expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:28'! lowercase ^ self on: #isLowercase message: 'lowercase letter expected' negated: #isUppercase message: 'uppercase letter expected'! ! !PPPredicateParser class methodsFor: 'instance-creation' stamp: 'lr 4/19/2008 11:21'! on: aBlock message: aString ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString! ! !PPPredicateParser class methodsFor: 'instance-creation' stamp: 'lr 4/19/2008 11:21'! on: aBlock message: aString negated: aNegatedBlock message: aNegatedString ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:36'! space ^ self on: [ :each | each isSeparator ] message: 'separator expected' negated: [ :each | each isSeparator not ] message: 'no separator expected'! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:29'! uppercase ^ self lowercase not! ! !PPPredicateParser class methodsFor: 'factory-chars' stamp: 'lr 4/19/2008 11:37'! word ^ self on: [ :each | each isAlphaNumeric ] message: 'letter or digit expected' negated: [ :each | each isAlphaNumeric not ] message: 'no letter or digit expected'! ! !PPPredicateParser methodsFor: 'initialization' stamp: 'lr 4/19/2008 11:23'! initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString predicate := aBlock. predicateMessage := aString. negated := aNegatedBlock. negatedMessage := aNegatedString! ! !PPPredicateParser methodsFor: 'operators' stamp: 'lr 4/20/2008 15:53'! not "Negate the receiving predicate parser." ^ PPPredicateParser on: negated message: negatedMessage negated: predicate message: predicateMessage! ! !PPPredicateParser methodsFor: 'parsing' stamp: 'lr 4/19/2008 11:09'! parse: aStream ^ (aStream atEnd not and: [ predicate value: aStream peek ]) ifFalse: [ PPFailure reason: predicateMessage position: aStream position ] ifTrue: [ aStream next ]! ! !PPPredicateParser methodsFor: 'printing' stamp: 'lr 4/19/2008 22:07'! printOn: aStream aStream nextPut: $<; nextPutAll: predicateMessage; nextPut: $>! ! PPParser subclass: #PPUnresolvedParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Builder'! !PPUnresolvedParser methodsFor: 'testing' stamp: 'lr 4/20/2008 16:29'! isUnresolved ^ true! ! !PPUnresolvedParser methodsFor: 'parsing' stamp: 'lr 4/20/2008 18:50'! parse: aStream self error: 'Need to be resolved before execution.'! ! !Symbol methodsFor: '*petitparser' stamp: 'lr 4/20/2008 14:01'! asParser ^ PPPredicateParser perform: self! ! !Interval methodsFor: '*petitparser' stamp: 'lr 4/19/2008 13:06'! asParser ^ PPPredicateParser between: start and: stop! ! TestCase subclass: #PPParserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitParser-Tests'! !PPParserTest methodsFor: 'utilities' stamp: 'lr 4/19/2008 13:57'! assert: aParser fail: aCollection | stream result | stream := aCollection readStream. result := aParser parse: stream. self assert: result isFailure. self assert: stream position = 0! ! !PPParserTest methodsFor: 'utilities' stamp: 'lr 4/19/2008 13:53'! assert: aParser parse: aCollection to: anObject | stream result | stream := aCollection readStream. result := aParser parse: stream. self assert: result = anObject. self assert: stream atEnd! ! !PPParserTest methodsFor: 'examples' stamp: 'lr 4/20/2008 15:54'! comment ^ ($" asParser , (PPPredicateParser char: $") not star , $" asParser) token! ! !PPParserTest methodsFor: 'examples' stamp: 'lr 4/19/2008 13:53'! identifier ^ (PPPredicateParser letter , PPPredicateParser word star) token! ! !PPParserTest methodsFor: 'examples' stamp: 'lr 4/19/2008 13:53'! number ^ ($- asParser optional , PPPredicateParser digit plus , ($. asParser , PPPredicateParser digit plus) optional) token! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/20/2008 18:58'! testAlternating | parser | parser := $a asParser | $b asParser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'b' to: $b. self assert: parser fail: ''. self assert: parser fail: 'c'. self assert: parser fail: 'ca'! ! !PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/19/2008 14:06'! testCharacter | parser | parser := $a asParser. self assert: parser parse: 'a' to: $a. self assert: parser fail: ''. self assert: parser fail: 'b'. self assert: parser fail: 'A'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/20/2008 18:58'! testEndOfInput | parser | parser := PPEndOfInputParser new. self assert: parser parse: '' to: nil. self assert: parser fail: 'a'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/19/2008 14:05'! testEpsilon | parser | parser := PPEpsilonParser new. self assert: parser parse: '' to: nil! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/20/2008 18:58'! testFailing | parser | parser := PPFailingParser new. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: 'aa'! ! !PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/19/2008 13:09'! testInterval | parser | parser := (1 to: 3) asParser. self assert: parser parse: #(1) to: 1. self assert: parser parse: #(2) to: 2. self assert: parser parse: #(3) to: 3. self assert: parser fail: #(0). self assert: parser fail: #(4)! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/19/2008 14:05'! testOptional | parser | parser := $a asParser optional. self assert: parser parse: '' to: nil. self assert: parser parse: 'a' to: $a! ! !PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/19/2008 13:27'! testOrdered | parser | parser := #(1 3) asParser. self assert: parser parse: #(1 3) to: #(1 3). self assert: parser fail: #(). self assert: parser fail: #(1). self assert: parser fail: #(1 2). self assert: parser fail: #(1 1 3)! ! !PPParserTest methodsFor: 'testing-examples' stamp: 'lr 4/20/2008 18:59'! testParseComment self assert: self comment parse: '""' to: '""'. self assert: self comment parse: '"a"' to: '"a"'. self assert: self comment parse: '"ab"' to: '"ab"'. self assert: self comment parse: '"abc"' to: '"abc"'. self assert: self comment fail: '"'. self assert: self comment fail: '"a'. self assert: self comment fail: '"aa'. self assert: self comment fail: 'a"'. self assert: self comment fail: 'aa"'! ! !PPParserTest methodsFor: 'testing-examples' stamp: 'lr 4/19/2008 13:52'! testParseIdentifier self assert: self identifier parse: 'a' to: 'a'. self assert: self identifier parse: 'a1' to: 'a1'. self assert: self identifier parse: 'a12' to: 'a12'. self assert: self identifier parse: 'ab' to: 'ab'. self assert: self identifier parse: 'a1b' to: 'a1b'. self assert: self identifier fail: ''. self assert: self identifier fail: ' '. self assert: self identifier fail: '1'. self assert: self identifier fail: '1a'! ! !PPParserTest methodsFor: 'testing-examples' stamp: 'lr 4/19/2008 14:06'! testParseNumber self assert: self number parse: '1' to: '1'. self assert: self number parse: '12' to: '12'. self assert: self number parse: '12.3' to: '12.3'. self assert: self number parse: '12.34' to: '12.34'. self assert: self number parse: '-1' to: '-1'. self assert: self number parse: '-12' to: '-12'. self assert: self number parse: '-12.3' to: '-12.3'. self assert: self number parse: '-12.34' to: '-12.34'. self assert: self number fail: ''. self assert: self number fail: '-'. self assert: self number fail: '.'. self assert: self number fail: '.1'! ! !PPParserTest methodsFor: 'testing-examples' stamp: 'lr 4/20/2008 18:59'! testParseReturn | number spaces return | number := #digit asParser plus token. spaces := #space asParser star. return := (spaces , $^ asParser , spaces , number , spaces) ==> [ :nodes | { #return. nodes at: 4 } ]. self assert: return parse: '^1' to: #(return '1'). self assert: return parse: ' ^12' to: #(return '12'). self assert: return parse: '^123 ' to: #(return '123'). self assert: return parse: '^ 1234' to: #(return '1234')! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/19/2008 13:59'! testPlus | parser | parser := $a asParser plus. 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 fail: ''. self assert: parser fail: 'b'. self assert: parser fail: 'ba'! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:00'! testPredicateAny | parser | parser := #any asParser. self assert: parser parse: ' ' to: $ . self assert: parser parse: '1' to: $1. self assert: parser parse: 'a' to: $a. self assert: parser fail: ''. self assert: parser not fail: ''. self assert: parser not fail: '1'. self assert: parser not fail: 'a'! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:10'! testPredicateCharacter | parser | parser := $* asParser. self assert: parser parse: '*' to: $*. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: 'a'. self assert: parser not parse: '1' to: $1. self assert: parser not parse: 'a' to: $a. self assert: parser not fail: '*'. self assert: parser not fail: '' ! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:09'! testPredicateControl | parser | parser := #control asParser. self assert: parser parse: String cr to: Character cr. self assert: parser parse: String tab to: Character tab. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: 'a'. self assert: parser not parse: '1' to: $1. self assert: parser not parse: 'a' to: $a. self assert: parser not fail: ''. self assert: parser not fail: String cr. self assert: parser not fail: String tab! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:09'! testPredicateDigit | parser | parser := #digit asParser. self assert: parser parse: '0' to: $0. self assert: parser parse: '9' to: $9. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser not parse: ' ' to: $ . self assert: parser not parse: 'a' to: $a. self assert: parser not fail: ''. self assert: parser not fail: '0'! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:09'! testPredicateLetter | parser | parser := #letter asParser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'Z' to: $Z. self assert: parser fail: ''. self assert: parser fail: '0'. self assert: parser not parse: '1' to: $1. self assert: parser not parse: ' ' to: $ . self assert: parser not fail: ''. self assert: parser not fail: 'a'! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:09'! testPredicateLowercase | parser | parser := #lowercase asParser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'z' to: $z. self assert: parser fail: ''. self assert: parser fail: 'A'. self assert: parser fail: '0'! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:09'! testPredicateSpace | parser | parser := #space asParser. self assert: parser parse: String tab to: Character tab. self assert: parser parse: ' ' to: Character space. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser not parse: 'a' to: $a. self assert: parser not parse: '/' to: $/. self assert: parser not fail: ''. self assert: parser not fail: ' '.! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:10'! testPredicateUppercase | parser | parser := #uppercase asParser. self assert: parser parse: 'A' to: $A. self assert: parser parse: 'Z' to: $Z. self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: '0'! ! !PPParserTest methodsFor: 'testing-predicate' stamp: 'lr 4/20/2008 19:10'! testPredicateWord | parser | parser := #word asParser. self assert: parser parse: 'a' to: $a. self assert: parser parse: 'A' to: $A. self assert: parser parse: '0' to: $0. self assert: parser fail: ''. self assert: parser fail: '-'. self assert: parser not parse: ' ' to: $ . self assert: parser not parse: '-' to: $-. self assert: parser not fail: ''. self assert: parser not fail: 'a'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/20/2008 18:58'! testSequential | parser | parser := $a asParser , $b asParser. self assert: parser parse: 'ab' to: #($a $b). self assert: parser fail: ''. self assert: parser fail: 'a'. self assert: parser fail: 'aa'. self assert: parser fail: 'ba'. self assert: parser fail: 'bab'! ! !PPParserTest methodsFor: 'testing' stamp: 'lr 4/19/2008 14:04'! testStar | parser | parser := $a asParser star. 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)! ! !PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/20/2008 19:18'! testString | parser | parser := 'ab' asParser. self assert: parser parse: 'ab' to: #($a $b). self assert: parser fail: 'a'. self assert: parser fail: 'ac'! ! !PPParserTest methodsFor: 'testing-extension' stamp: 'lr 4/19/2008 13:27'! testUnordered | parser | parser := #(1 3) asSet asParser. self assert: parser parse: #(1) to: 1. self assert: parser parse: #(3) to: 3. self assert: parser fail: #(). self assert: parser fail: #(2). self assert: parser fail: #(2 1). self assert: parser fail: #(2 3)! !