# HG changeset patch # User Jan Vrany # Date 1412299988 -3600 # Node ID 6112a403a52d343504769b2c0043f70344356dda # Parent a2656b27cacee9507cdca29b0b474c50f64add00 Updated to latest version from Moose repository. Name: PetitParser-JanKurs.250 Author: JanKurs Time: 01-10-2014, 04:44:04 AM UUID: c46eea20-51a0-4deb-8fd5-8cb99810a8b4 Repository: http://smalltalkhub.com/mc/Moose/PetitParser/main Name: PetitTests-JanKurs.60 Author: JanKurs Time: 29-09-2014, 11:48:10 AM UUID: 28fd2e65-c287-4f73-b71e-5b6bb25bebaa Repository: http://smalltalkhub.com/mc/Moose/PetitParser/main diff -r a2656b27cace -r 6112a403a52d Make.proto --- a/Make.proto Fri Oct 03 01:59:10 2014 +0100 +++ b/Make.proto Fri Oct 03 02:33:08 2014 +0100 @@ -34,7 +34,7 @@ # add the path(es) here:, # ********** OPTIONAL: MODIFY the next lines *** # LOCALINCLUDES=-Ifoo -Ibar -LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 +LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2 # if you need any additional defines for embedded C code, @@ -125,10 +125,6 @@ prereq: cd ../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd ../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd ../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd ../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd ../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd ../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" @@ -149,6 +145,8 @@ # BEGINMAKEDEPEND --- do not remove this line; make depend needs it $(OUTDIR)PPCharSetPredicate.$(O) PPCharSetPredicate.$(H): PPCharSetPredicate.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) +$(OUTDIR)PPContext.$(O) PPContext.$(H): PPContext.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) +$(OUTDIR)PPContextMemento.$(O) PPContextMemento.$(H): PPContextMemento.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)PPFailure.$(O) PPFailure.$(H): PPFailure.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)PPMemento.$(O) PPMemento.$(H): PPMemento.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)PPParser.$(O) PPParser.$(H): PPParser.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) @@ -162,6 +160,7 @@ $(OUTDIR)PPLiteralParser.$(O) PPLiteralParser.$(H): PPLiteralParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)PPPluggableParser.$(O) PPPluggableParser.$(H): PPPluggableParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)PPPredicateParser.$(O) PPPredicateParser.$(H): PPPredicateParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) +$(OUTDIR)PPStartOfLine.$(O) PPStartOfLine.$(H): PPStartOfLine.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)PPUnresolvedParser.$(O) PPUnresolvedParser.$(H): PPUnresolvedParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)PPActionParser.$(O) PPActionParser.$(H): PPActionParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)PPAndParser.$(O) PPAndParser.$(H): PPAndParser.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) diff -r a2656b27cace -r 6112a403a52d Make.spec --- a/Make.spec Fri Oct 03 01:59:10 2014 +0100 +++ b/Make.spec Fri Oct 03 02:33:08 2014 +0100 @@ -51,6 +51,8 @@ COMMON_CLASSES= \ PPCharSetPredicate \ + PPContext \ + PPContextMemento \ PPFailure \ PPMemento \ PPParser \ @@ -64,6 +66,7 @@ PPLiteralParser \ PPPluggableParser \ PPPredicateParser \ + PPStartOfLine \ PPUnresolvedParser \ PPActionParser \ PPAndParser \ @@ -94,6 +97,8 @@ COMMON_OBJS= \ $(OUTDIR_SLASH)PPCharSetPredicate.$(O) \ + $(OUTDIR_SLASH)PPContext.$(O) \ + $(OUTDIR_SLASH)PPContextMemento.$(O) \ $(OUTDIR_SLASH)PPFailure.$(O) \ $(OUTDIR_SLASH)PPMemento.$(O) \ $(OUTDIR_SLASH)PPParser.$(O) \ @@ -107,6 +112,7 @@ $(OUTDIR_SLASH)PPLiteralParser.$(O) \ $(OUTDIR_SLASH)PPPluggableParser.$(O) \ $(OUTDIR_SLASH)PPPredicateParser.$(O) \ + $(OUTDIR_SLASH)PPStartOfLine.$(O) \ $(OUTDIR_SLASH)PPUnresolvedParser.$(O) \ $(OUTDIR_SLASH)PPActionParser.$(O) \ $(OUTDIR_SLASH)PPAndParser.$(O) \ diff -r a2656b27cace -r 6112a403a52d PPActionParser.st --- a/PPActionParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPActionParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -14,11 +14,6 @@ ^ (self on: aParser) setBlock: aBlock ! ! -!PPActionParser methodsFor:'*petitanalyzer-matching'! - -match: aParser inContext: aDictionary seen: anIdentitySet - ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ] -! ! !PPActionParser methodsFor:'accessing'! @@ -36,9 +31,9 @@ !PPActionParser methodsFor:'parsing'! -parseOn: aStream +parseOn: aPPContext | element | - ^ (element := parser parseOn: aStream) isPetitFailure + ^ (element := parser parseOn: aPPContext) isPetitFailure ifFalse: [ block value: element ] ifTrue: [ element ] ! ! diff -r a2656b27cace -r 6112a403a52d PPAndParser.st --- a/PPAndParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPAndParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -16,11 +16,11 @@ !PPAndParser methodsFor:'parsing'! -parseOn: aStream - | element position | - position := aStream position. - element := parser parseOn: aStream. - aStream position: position. +parseOn: aPPContext + | element memento | + memento := aPPContext remember. + element := parser parseOn: aPPContext. + aPPContext restore: memento. ^ element ! ! diff -r a2656b27cace -r 6112a403a52d PPChoiceParser.st --- a/PPChoiceParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPChoiceParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -16,13 +16,13 @@ !PPChoiceParser methodsFor:'parsing'! -parseOn: aStream +parseOn: aPPContext "This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered." | element | 1 to: parsers size do: [ :index | element := (parsers at: index) - parseOn: aStream. + parseOn: aPPContext. element isPetitFailure ifFalse: [ ^ element ] ]. ^ element @@ -41,3 +41,4 @@ version_SVN ^ '§Id: PPChoiceParser.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d PPContext.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/PPContext.st Fri Oct 03 02:33:08 2014 +0100 @@ -0,0 +1,269 @@ +"{ Package: 'stx:goodies/petitparser' }" + +Object subclass:#PPContext + instanceVariableNames:'stream root properties globals' + classVariableNames:'' + poolDictionaries:'' + category:'PetitParser-Core' +! + +!PPContext class methodsFor:'as yet unclassified'! + +on: aPPParser stream: aStream + ^ self basicNew + initialize; + root: aPPParser; + stream: aStream asPetitStream; + yourself +! ! + +!PPContext methodsFor:'accessing-globals'! + +globalAt: aKey + "Answer the global property value associated with aKey." + + ^ self globalAt: aKey ifAbsent: [ self error: 'Property not found' ] +! + +globalAt: aKey ifAbsent: aBlock + "Answer the global property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." + + ^ globals isNil + ifTrue: [ aBlock value ] + ifFalse: [ globals at: aKey ifAbsent: aBlock ] +! + +globalAt: aKey ifAbsentPut: aBlock + "Answer the global property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." + + ^ self globalAt: aKey ifAbsent: [ self globalAt: aKey put: aBlock value ] +! + +globalAt: aKey put: anObject + "Set the global property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." + + ^ (globals ifNil: [ globals := Dictionary new: 1 ]) + at: aKey put: anObject +! + +hasGlobal: aKey + "Test if the global property aKey is present." + + ^ globals notNil and: [ globals includesKey: aKey ] +! + +removeGlobal: aKey + "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." + + ^ self removeGlobal: aKey ifAbsent: [ self error: 'Property not found' ] +! + +removeGlobal: aKey ifAbsent: aBlock + "Remove the global property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." + + | answer | + globals isNil ifTrue: [ ^ aBlock value ]. + answer := globals removeKey: aKey ifAbsent: aBlock. + globals isEmpty ifTrue: [ globals := nil ]. + ^ answer +! ! + +!PPContext methodsFor:'accessing-properties'! + +hasProperty: aKey + "Test if the property aKey is present." + + ^ properties notNil and: [ properties includesKey: aKey ] +! + +propertyAt: aKey + "Answer the property value associated with aKey." + + ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ] +! + +propertyAt: aKey ifAbsent: aBlock + "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." + + ^ properties isNil + ifTrue: [ aBlock value ] + ifFalse: [ properties at: aKey ifAbsent: aBlock ] +! + +propertyAt: aKey ifAbsentPut: aBlock + "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." + + ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ] +! + +propertyAt: aKey put: anObject + "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." + + ^ (properties ifNil: [ properties := Dictionary new: 1 ]) + at: aKey put: anObject +! + +removeProperty: aKey + "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." + + ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ] +! + +removeProperty: aKey ifAbsent: aBlock + "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." + + | answer | + properties isNil ifTrue: [ ^ aBlock value ]. + answer := properties removeKey: aKey ifAbsent: aBlock. + properties isEmpty ifTrue: [ properties := nil ]. + ^ answer +! ! + +!PPContext methodsFor:'acessing'! + +root + ^ root +! + +stream + ^ stream +! + +stream: aStream + stream := aStream. +! ! + +!PPContext methodsFor:'failures'! + +furthestFailure + " the furthest failure encountered while parsing the input stream " + + ^ self globalAt: #furthestFailure ifAbsent: [ nil ] +! + +noteFailure: aPPFailure + "record the furthest failure encountered while parsing the input stream " + + | furthestFailure | + furthestFailure := self furthestFailure. + ( furthestFailure isNil or: [ aPPFailure position > furthestFailure position ]) + ifTrue: [ self globalAt: #furthestFailure put: aPPFailure ]. +! ! + +!PPContext methodsFor:'initialization'! + +initialize + stream := nil. +! + +initializeFor: parser + parser == root ifTrue: [ ^ self ]. + + root := parser. + root allParsersDo: [ :p | + p updateContext: self + ] +! ! + +!PPContext methodsFor:'memoization'! + +remember + | memento | + memento := PPContextMemento new + stream: stream; + position: stream position; + yourself. + + self rememberProperties: memento. + ^ memento +! + +rememberProperties: aPPContextMemento + properties ifNil: [ ^ self ]. + + properties keysAndValuesDo: [ :key :value | + aPPContextMemento propertyAt: key put: value + ]. +! + +restore: aPPContextMemento + aPPContextMemento stream == stream ifFalse: [ self error: 'Oops!!' ]. + + stream position: aPPContextMemento position. + self restoreProperties: aPPContextMemento. +! + +restoreProperties: aPPContextMemento + aPPContextMemento stream == stream ifFalse: [ self error: 'Oops!!' ]. + + aPPContextMemento keysAndValuesDo: [ :key :value | + self propertyAt: key put: value + ]. +! ! + +!PPContext methodsFor:'stream mimicry'! + +atEnd + ^ stream atEnd +! + +back + ^ stream back +! + +collection + ^ stream collection +! + +contents + ^ stream contents +! + +isStartOfLine + ^ stream isStartOfLine +! + +next + ^ stream next +! + +next: anInteger + ^ stream next: anInteger +! + +peek + ^ stream peek +! + +peekTwice + ^ stream peekTwice +! + +position + ^ stream position +! + +position: anInteger + ^ stream position: anInteger +! + +skip: anInteger + ^ stream skip: anInteger +! + +uncheckedPeek + ^ stream uncheckedPeek +! + +upTo: anObject + ^ stream upTo: anObject +! + +upToAll: whatever + ^ stream upToAll: whatever +! + +upToAnyOf: whatever + ^ stream upToAnyOf: whatever +! ! + diff -r a2656b27cace -r 6112a403a52d PPContextMemento.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/PPContextMemento.st Fri Oct 03 02:33:08 2014 +0100 @@ -0,0 +1,119 @@ +"{ Package: 'stx:goodies/petitparser' }" + +Object subclass:#PPContextMemento + instanceVariableNames:'stream position properties' + classVariableNames:'' + poolDictionaries:'' + category:'PetitParser-Core' +! + +!PPContextMemento methodsFor:'accessing'! + +position + ^ position +! + +position: anInteger + position := anInteger +! + +stream + ^ stream +! + +stream: aStream + stream := aStream +! ! + +!PPContextMemento methodsFor:'accessing - properties'! + +hasProperty: aKey + "Test if the property aKey is present." + + ^ properties notNil and: [ properties includesKey: aKey ] +! + +keysAndValuesDo: aBlock + properties ifNil: [ ^ self ]. + properties keysAndValuesDo: [ :key :value | aBlock value: key value: value copy ] +! + +propertiesSize + properties ifNil: [ ^ 0 ]. + ^ properties size. +! + +propertyAt: aKey + "Answer the property value associated with aKey." + + ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ] +! + +propertyAt: aKey ifAbsent: aBlock + "Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock." + + properties isNil + ifTrue: [ ^ aBlock value ] + ifFalse: [ + (properties includesKey: aKey) ifTrue: [ + ^ (properties at: aKey) copy + ]. + ^ aBlock value + ] + + "Created: / 03-10-2014 / 02:17:26 / Jan Vrany " +! + +propertyAt: aKey ifAbsentPut: aBlock + "Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value." + + ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ] +! + +propertyAt: aKey put: anObject + "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject." + + ^ (properties ifNil: [ properties := Dictionary new: 1 ]) + at: aKey put: (anObject copy) +! + +removeProperty: aKey + "Remove the property with aKey. Answer the property or raise an error if aKey isn't found." + + ^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ] +! + +removeProperty: aKey ifAbsent: aBlock + "Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock." + + | answer | + properties isNil ifTrue: [ ^ aBlock value ]. + answer := properties removeKey: aKey ifAbsent: aBlock. + properties isEmpty ifTrue: [ properties := nil ]. + ^ answer +! ! + +!PPContextMemento methodsFor:'comparing'! + += anObject + + (self == anObject) ifTrue: [ ^ true ]. + (anObject class = PPContextMemento) ifFalse: [ ^ false ]. + + (anObject stream == stream) ifFalse: [ ^ false ]. + (anObject position = position) ifFalse: [ ^ false ]. + + (self propertiesSize = anObject propertiesSize) ifFalse: [ ^ false ]. + + self keysAndValuesDo: [ :key :value | + (anObject hasProperty: key) ifFalse: [ ^ false ]. + ((anObject propertyAt: key) = value) ifFalse: [ ^ false ]. + ]. + + ^ true. +! + +hash + ^ (position hash bitXor: stream hash) bitXor: properties hash. +! ! + diff -r a2656b27cace -r 6112a403a52d PPDelegateParser.st --- a/PPDelegateParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPDelegateParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -14,12 +14,6 @@ ^ self new setParser: aParser ! ! -!PPDelegateParser methodsFor:'*petitanalyzer-transforming'! - -replace: aParser with: anotherParser - super replace: aParser with: anotherParser. - parser == aParser ifTrue: [ parser := anotherParser ] -! ! !PPDelegateParser methodsFor:'accessing'! @@ -35,8 +29,8 @@ !PPDelegateParser methodsFor:'parsing'! -parseOn: aStream - ^ parser parseOn: aStream +parseOn: aPPContext + ^ parser parseOn: aPPContext ! ! !PPDelegateParser class methodsFor:'documentation'! diff -r a2656b27cace -r 6112a403a52d PPEndOfInputParser.st --- a/PPEndOfInputParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPEndOfInputParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -16,16 +16,16 @@ !PPEndOfInputParser methodsFor:'parsing'! -parseOn: aStream - | position result | - position := aStream position. - result := parser parseOn: aStream. - (result isPetitFailure or: [ aStream atEnd ]) +parseOn: aPPContext + | memento result | + memento := aPPContext remember. + result := parser parseOn: aPPContext. + (result isPetitFailure or: [ aPPContext stream atEnd ]) ifTrue: [ ^ result ]. result := PPFailure message: 'end of input expected' - at: aStream position. - aStream position: position. + context: aPPContext. + aPPContext restore: memento. ^ result ! ! @@ -42,3 +42,4 @@ version_SVN ^ '§Id: PPEndOfInputParser.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d PPFailingParser.st --- a/PPFailingParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPFailingParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -14,11 +14,6 @@ ^ self new setMessage: aString ! ! -!PPFailingParser methodsFor:'*petitanalyzer-matching'! - -match: aParser inContext: aDictionary seen: anIdentitySet - ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ] -! ! !PPFailingParser methodsFor:'accessing'! @@ -34,10 +29,10 @@ message := aString ! ! -!PPFailingParser methodsFor:'parsing'! +!PPFailingParser methodsFor:'pp-context'! -parseOn: aStream - ^ PPFailure message: message at: aStream position +parseOn: aPPContext + ^ PPFailure message: message context: aPPContext ! ! !PPFailingParser methodsFor:'printing'! diff -r a2656b27cace -r 6112a403a52d PPFailure.st --- a/PPFailure.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPFailure.st Fri Oct 03 02:33:08 2014 +0100 @@ -1,7 +1,7 @@ "{ Package: 'stx:goodies/petitparser' }" Object subclass:#PPFailure - instanceVariableNames:'message position' + instanceVariableNames:'message context position' classVariableNames:'' poolDictionaries:'' category:'PetitParser-Core' @@ -10,8 +10,21 @@ !PPFailure class methodsFor:'instance creation'! +message: aString + ^ self basicNew initializeMessage: aString +! + message: aString at: anInteger + "One should not use this method if the furthest failure is supposed to be reported correctly" ^ self basicNew initializeMessage: aString at: anInteger +! + +message: aString context: aPPContext + ^ self basicNew initializeMessage: aString context: aPPContext +! + +message: aString context: aPPContext at: position + ^ self basicNew initializeMessage: aString context: aPPContext position: position ! ! !PPFailure methodsFor:'accessing'! @@ -30,15 +43,33 @@ !PPFailure methodsFor:'initialization'! +initializeMessage: aString + message := aString. +! + initializeMessage: aString at: anInteger + "One should not use this method if the furthest failure is supposed to be reported correctly" message := aString. - position := anInteger + position := anInteger. +! + +initializeMessage: aString context: aPPContext + self initializeMessage: aString context: aPPContext position: aPPContext position +! + +initializeMessage: aString context: aPPContext position: anInteger + message := aString. + context := aPPContext. + position := anInteger. + + "record the furthest failure encountered while parsing the input stream " + aPPContext noteFailure: self. ! ! !PPFailure methodsFor:'printing'! printOn: aStream - aStream nextPutAll: self message; nextPutAll: ' at '; print: position + aStream nextPutAll: self message; nextPutAll: ' at '; print: self position ! ! !PPFailure methodsFor:'testing'! @@ -62,3 +93,4 @@ version_SVN ^ '§Id: PPFailure.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d PPFlattenParser.st --- a/PPFlattenParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPFlattenParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -16,12 +16,12 @@ !PPFlattenParser methodsFor:'parsing'! -parseOn: aStream +parseOn: aPPContext | start element | - start := aStream position. - element := parser parseOn: aStream. + start := aPPContext position. + element := parser parseOn: aPPContext. element isPetitFailure ifTrue: [ ^ element ]. - ^ self on: aStream collection start: start + 1 stop: aStream position value: element + ^ self on: aPPContext stream collection start: start + 1 stop: aPPContext position value: element ! ! !PPFlattenParser methodsFor:'private'! diff -r a2656b27cace -r 6112a403a52d PPGreedyRepeatingParser.st --- a/PPGreedyRepeatingParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPGreedyRepeatingParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -10,32 +10,32 @@ !PPGreedyRepeatingParser methodsFor:'parsing'! -parseOn: aStream - | start element elements positions | - start := aStream position. +parseOn: aPPContext + | memento element elements positions | + memento := aPPContext remember. elements := OrderedCollection new. [ elements size < min ] whileTrue: [ - (element := parser parseOn: aStream) isPetitFailure ifTrue: [ - aStream position: start. + (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [ + aPPContext restore: memento. ^ element ]. elements addLast: element ]. - positions := OrderedCollection with: aStream position. - [ elements size < max and: [ (element := parser parseOn: aStream) isPetitFailure not ] ] whileTrue: [ + positions := OrderedCollection with: aPPContext remember. + [ elements size < max and: [ (element := parser parseOn: aPPContext) isPetitFailure not ] ] whileTrue: [ elements addLast: element. - positions addLast: aStream position ]. + positions addLast: aPPContext remember ]. [ positions isEmpty ] whileFalse: [ - aStream position: positions last. - element := limit parseOn: aStream. + aPPContext restore: positions last. + element := limit parseOn: aPPContext. element isPetitFailure ifFalse: [ - aStream position: positions last. + aPPContext restore: positions last. ^ elements asArray ]. elements isEmpty ifTrue: [ - aStream position: start. + aPPContext restore: memento. ^ element ]. elements removeLast. positions removeLast ]. - aStream position: start. - ^ PPFailure message: 'overflow' at: start + aPPContext restore: memento. + ^ PPFailure message: 'overflow' context: aPPContext at: memento position ! ! !PPGreedyRepeatingParser class methodsFor:'documentation'! diff -r a2656b27cace -r 6112a403a52d PPLazyRepeatingParser.st --- a/PPLazyRepeatingParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPLazyRepeatingParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -10,22 +10,22 @@ !PPLazyRepeatingParser methodsFor:'parsing'! -parseOn: aStream - | start element elements | - start := aStream position. +parseOn: aPPContext + | memento element elements | + memento := aPPContext remember. elements := OrderedCollection new. [ elements size < min ] whileTrue: [ - (element := parser parseOn: aStream) isPetitFailure ifTrue: [ - aStream position: start. + (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [ + aPPContext restore: memento. ^ element ]. elements addLast: element ]. - [ self matchesLimitOn: aStream ] whileFalse: [ + [ self matchesLimitOn: aPPContext ] whileFalse: [ elements size < max ifFalse: [ - aStream position: start. - ^ PPFailure message: 'overflow' at: start ]. - element := parser parseOn: aStream. + aPPContext restore: memento. + ^ PPFailure message: 'overflow' context: aPPContext at: memento position ]. + element := parser parseOn: aPPContext. element isPetitFailure ifTrue: [ - aStream position: start. + aPPContext restore: memento. ^ element ]. elements addLast: element ]. ^ elements asArray diff -r a2656b27cace -r 6112a403a52d PPLimitedRepeatingParser.st --- a/PPLimitedRepeatingParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPLimitedRepeatingParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -14,6 +14,7 @@ ^ (self on: aParser) setLimit: aLimitParser ! ! + !PPLimitedRepeatingParser methodsFor:'accessing'! children @@ -32,13 +33,13 @@ limit := aParser ! ! -!PPLimitedRepeatingParser methodsFor:'private'! +!PPLimitedRepeatingParser methodsFor:'parsing'! -matchesLimitOn: aStream +matchesLimitOn: aPPContext | element position | - position := aStream position. - element := limit parseOn: aStream. - aStream position: position. + position := aPPContext remember. + element := limit parseOn: aPPContext. + aPPContext restore: position. ^ element isPetitFailure not ! ! diff -r a2656b27cace -r 6112a403a52d PPLiteralObjectParser.st --- a/PPLiteralObjectParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPLiteralObjectParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -23,10 +23,10 @@ !PPLiteralObjectParser methodsFor:'parsing'! -parseOn: aStream - ^ (aStream atEnd not and: [ literal = aStream uncheckedPeek ]) - ifFalse: [ PPFailure message: message at: aStream position ] - ifTrue: [ aStream next ] +parseOn: aPPContext + ^ (aPPContext stream atEnd not and: [ literal = aPPContext stream uncheckedPeek ]) + ifFalse: [ PPFailure message: message context: aPPContext ] + ifTrue: [ aPPContext stream next ] ! ! !PPLiteralObjectParser class methodsFor:'documentation'! diff -r a2656b27cace -r 6112a403a52d PPLiteralParser.st --- a/PPLiteralParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPLiteralParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -11,24 +11,13 @@ !PPLiteralParser class methodsFor:'instance creation'! on: anObject - |msg| - - "portable - does not depend on character to print with a $" - msg := anObject isCharacter - ifTrue:[ '$',anObject asString] - ifFalse:[ anObject printString ]. - ^ self on: anObject message: msg , ' expected' + ^ self on: anObject message: anObject printString , ' expected' ! on: anObject message: aString ^ self new initializeOn: anObject message: aString ! ! -!PPLiteralParser methodsFor:'*petitanalyzer-matching'! - -match: aParser inContext: aDictionary seen: anIdentitySet - ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ] -! ! !PPLiteralParser methodsFor:'accessing'! @@ -62,13 +51,8 @@ !PPLiteralParser methodsFor:'printing'! printNameOn: aStream - super printNameOn: aStream. - literal isCharacter ifTrue:[ - "/ portable - does not depend on character-print to print with $ - aStream nextPutAll: ', $'; print: literal asString - ] ifFalse:[ - aStream nextPutAll: ', '; print: literal - ]. + super printNameOn: aStream. + aStream nextPutAll: ', '; print: literal ! ! !PPLiteralParser class methodsFor:'documentation'! diff -r a2656b27cace -r 6112a403a52d PPLiteralSequenceParser.st --- a/PPLiteralSequenceParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPLiteralSequenceParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -34,13 +34,13 @@ !PPLiteralSequenceParser methodsFor:'parsing'! -parseOn: aStream - | position result | - position := aStream position. - result := aStream next: size. +parseOn: aPPContext + | memento result | + memento := aPPContext remember. + result := aPPContext next: size. literal = result ifTrue: [ ^ result ]. - aStream position: position. - ^ PPFailure message: message at: aStream position + aPPContext restore: memento. + ^ PPFailure message: message context: aPPContext ! ! !PPLiteralSequenceParser class methodsFor:'documentation'! @@ -56,3 +56,4 @@ version_SVN ^ '§Id: PPLiteralSequenceParser.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d PPMemento.st --- a/PPMemento.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPMemento.st Fri Oct 03 02:33:08 2014 +0100 @@ -1,7 +1,7 @@ "{ Package: 'stx:goodies/petitparser' }" Object subclass:#PPMemento - instanceVariableNames:'result count position' + instanceVariableNames:'result count context' classVariableNames:'' poolDictionaries:'' category:'PetitParser-Core' @@ -16,12 +16,12 @@ !PPMemento methodsFor:'accessing'! -position - ^ position +contextMemento + ^ context ! -position: anInteger - position := anInteger +contextMemento: aPPContextMemento + context := aPPContextMemento ! result @@ -64,3 +64,4 @@ version_SVN ^ '§Id: PPMemento.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d PPMemoizedParser.st --- a/PPMemoizedParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPMemoizedParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -1,7 +1,7 @@ "{ Package: 'stx:goodies/petitparser' }" PPDelegateParser subclass:#PPMemoizedParser - instanceVariableNames:'stream buffer' + instanceVariableNames:'buffer context hash' classVariableNames:'' poolDictionaries:'' category:'PetitParser-Parsers' @@ -18,27 +18,30 @@ !PPMemoizedParser methodsFor:'parsing'! -parseOn: aStream - | memento | - stream == aStream - ifFalse: [ self reset: aStream ]. - memento := (buffer at: stream position + 1) - ifNil: [ buffer at: stream position + 1 put: PPMemento new ]. - memento position isNil +parseOn: aPPContext + | memento contextMemento aStream | + "TODO: JK memoizing needs review!!" + + contextMemento := aPPContext remember. + (hash == aPPContext hash) + ifFalse: [ self reset: aPPContext ]. + memento := (buffer at: contextMemento ifAbsentPut: [ PPMemento new ]). + + memento contextMemento isNil ifTrue: [ - memento result: (stream size - stream position + 2 < memento count - ifTrue: [ PPFailure message: 'overflow' at: stream position ] - ifFalse: [ memento increment. parser parseOn: stream ]). - memento position: stream position ] - ifFalse: [ stream position: memento position ]. - ^ memento result -! ! + aStream := aPPContext stream. + memento result: (aStream size - aStream position + 2 < memento count + ifTrue: [ PPFailure message: 'overflow' context: aPPContext ] + ifFalse: [ memento increment. parser parseOn: aPPContext ]). + memento contextMemento: aPPContext remember ] + ifFalse: [ context restore: memento contextMemento ]. + ^ memento result. +! -!PPMemoizedParser methodsFor:'private'! - -reset: aStream - stream := aStream. - buffer := Array new: aStream size + 1 +reset: aPPContext + hash := aPPContext hash. + context := aPPContext. + buffer := Dictionary new. ! ! !PPMemoizedParser class methodsFor:'documentation'! @@ -54,3 +57,4 @@ version_SVN ^ '§Id: PPMemoizedParser.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d PPNotParser.st --- a/PPNotParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPNotParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -10,13 +10,13 @@ !PPNotParser methodsFor:'parsing'! -parseOn: aStream - | element position | - position := aStream position. - element := parser parseOn: aStream. - aStream position: position. +parseOn: aPPContext + | element memento | + memento := aPPContext remember. + element := parser parseOn: aPPContext. + aPPContext restore: memento. ^ element isPetitFailure - ifFalse: [ PPFailure message: '' at: aStream position ] + ifFalse: [ PPFailure message: '' context: aPPContext ] ! ! !PPNotParser class methodsFor:'documentation'! @@ -32,3 +32,4 @@ version_SVN ^ '§Id: PPNotParser.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d PPOptionalParser.st --- a/PPOptionalParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPOptionalParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -8,17 +8,12 @@ ! -!PPOptionalParser methodsFor:'*petitanalyzer-testing'! - -isNullable - ^ true -! ! !PPOptionalParser methodsFor:'parsing'! -parseOn: aStream +parseOn: aPPContext | element | - element := parser parseOn: aStream. + element := parser parseOn: aPPContext. ^ element isPetitFailure ifFalse: [ element ] ! ! diff -r a2656b27cace -r 6112a403a52d PPParser.st --- a/PPParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -25,11 +25,6 @@ - - - - - !PPParser methodsFor:'accessing'! children @@ -99,6 +94,30 @@ ^ answer ! ! +!PPParser methodsFor:'context'! + +parse: anObject withContext: aPPContext + "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure." + + aPPContext stream: anObject asPetitStream. + ^ self parseWithContext: aPPContext. +! + +parseWithContext: context + | result | + context initializeFor: self. + result := self parseOn: context. + + "Return the furthest failure, it gives better results than the last failure" + result isPetitFailure ifTrue: [ ^ context furthestFailure ]. + ^ result + +! + +updateContext: aPPContext + "nothing to do" +! ! + !PPParser methodsFor:'converting'! asParser @@ -224,13 +243,6 @@ ^ PPActionParser on: self block: aBlock ! ->=> aBlock - "Answer a new parser that wraps the receiving parser with a two argument block. - The first argument is the parsed stream, the second argument a continuation block on the delegate parser." - - ^ PPWrappingParser on: self block: aBlock -! - answer: anObject "Answer a new parser that always returns anObject from a successful parse." @@ -275,6 +287,12 @@ !PPParser methodsFor:'operators-mapping'! +>=> aBlock + "Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delegate parser." + + ^ PPWrappingParser on: self block: aBlock +! + foldLeft: aBlock "Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments." @@ -505,8 +523,8 @@ parse: anObject "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure." - - ^ self parseOn: anObject asPetitStream + + ^ self parse: anObject withContext: PPContext new ! parse: anObject onError: aBlock @@ -523,7 +541,7 @@ ^ aBlock value: result message value: result position ! -parseOn: aStream +parseOn: aPPContext "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:." self subclassResponsibility @@ -554,7 +572,6 @@ ^ false ! ! - !PPParser class methodsFor:'documentation'! version diff -r a2656b27cace -r 6112a403a52d PPPluggableParser.st --- a/PPPluggableParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPPluggableParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -14,11 +14,6 @@ ^ self new initializeOn: aBlock ! ! -!PPPluggableParser methodsFor:'*petitanalyzer-matching'! - -match: aParser inContext: aDictionary seen: anIdentitySet - ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ] -! ! !PPPluggableParser methodsFor:'accessing'! @@ -36,12 +31,12 @@ !PPPluggableParser methodsFor:'parsing'! -parseOn: aStream - | position result | - position := aStream position. - result := block value: aStream. +parseOn: aPPContext + | memento result | + memento := aPPContext remember. + result := block value: aPPContext. result isPetitFailure - ifTrue: [ aStream position: position ]. + ifTrue: [ aPPContext restore: memento ]. ^ result ! ! diff -r a2656b27cace -r 6112a403a52d PPPossessiveRepeatingParser.st --- a/PPPossessiveRepeatingParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPPossessiveRepeatingParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -10,17 +10,17 @@ !PPPossessiveRepeatingParser methodsFor:'parsing'! -parseOn: aStream - | start element elements | - start := aStream position. +parseOn: aPPContext + | memento element elements | + memento := aPPContext remember. elements := OrderedCollection new. [ elements size < min ] whileTrue: [ - (element := parser parseOn: aStream) isPetitFailure ifTrue: [ - aStream position: start. + (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [ + aPPContext restore: memento. ^ element ]. elements addLast: element ]. [ elements size < max ] whileTrue: [ - (element := parser parseOn: aStream) isPetitFailure + (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [ ^ elements asArray ]. elements addLast: element ]. ^ elements asArray diff -r a2656b27cace -r 6112a403a52d PPPredicateObjectParser.st --- a/PPPredicateObjectParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPPredicateObjectParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -16,6 +16,11 @@ on: aBlock message: aString negated: aNegatedBlock message: aNegatedString ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString +! + +startOfLine + + ^ PPStartOfLine new. ! ! !PPPredicateObjectParser class methodsFor:'factory-chars'! @@ -37,12 +42,7 @@ ! cr - |cr| - - cr := Smalltalk isSmalltalkX - ifTrue:[Character return] - ifFalse:[Character cr]. - ^ self char: cr message: 'carriage return expected' + ^ self char: Character cr message: 'carriage return expected' ! digit @@ -71,12 +71,7 @@ ! newline - |cr| - - cr := Smalltalk isSmalltalkX - ifTrue:[Character return] - ifFalse:[Character cr]. - ^ self chars: (String with: cr with: Character lf) message: 'newline expected' + ^ self chars: (String with: Character cr with: Character lf) message: 'newline expected' ! punctuation @@ -156,10 +151,10 @@ !PPPredicateObjectParser methodsFor:'parsing'! -parseOn: aStream - ^ (aStream atEnd not and: [ predicate value: aStream uncheckedPeek ]) - ifFalse: [ PPFailure message: predicateMessage at: aStream position ] - ifTrue: [ aStream next ] +parseOn: aPPContext + ^ (aPPContext atEnd not and: [ predicate value: aPPContext uncheckedPeek ]) + ifFalse: [ PPFailure message: predicateMessage context: aPPContext ] + ifTrue: [ aPPContext next ] ! ! !PPPredicateObjectParser class methodsFor:'documentation'! diff -r a2656b27cace -r 6112a403a52d PPPredicateSequenceParser.st --- a/PPPredicateSequenceParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPPredicateSequenceParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -18,11 +18,6 @@ ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString size: anInteger ! ! -!PPPredicateSequenceParser methodsFor:'*petitanalyzer-matching'! - -match: aParser inContext: aDictionary seen: anIdentitySet - ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ] -! ! !PPPredicateSequenceParser methodsFor:'accessing'! @@ -55,14 +50,14 @@ !PPPredicateSequenceParser methodsFor:'parsing'! -parseOn: aStream - | position result | - position := aStream position. - result := aStream next: size. +parseOn: aPPContext + | memento result | + memento := aPPContext remember. + result := aPPContext stream next: size. (result size = size and: [ predicate value: result ]) ifTrue: [ ^ result ]. - aStream position: position. - ^ PPFailure message: predicateMessage at: aStream position + aPPContext restore: memento. + ^ PPFailure message: predicateMessage context: aPPContext ! ! !PPPredicateSequenceParser class methodsFor:'documentation'! diff -r a2656b27cace -r 6112a403a52d PPSequenceParser.st --- a/PPSequenceParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPSequenceParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -8,46 +8,6 @@ ! -!PPSequenceParser methodsFor:'*petitanalyzer-private'! - -cycleSet: aDictionary - | firstSet | - 1 to: parsers size do: [ :index | - firstSet := aDictionary at: (parsers at: index). - (firstSet anySatisfy: [ :each | each isNullable ]) - ifFalse: [ ^ parsers copyFrom: 1 to: index ] ]. - ^ parsers -! - -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: PPSentinel instance -! - -followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet - parsers keysAndValuesDo: [ :index :parser | - | 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 ]) ] ] -! ! !PPSequenceParser methodsFor:'operations'! @@ -74,17 +34,17 @@ !PPSequenceParser methodsFor:'parsing'! -parseOn: aStream +parseOn: aPPContext "This is optimized code that avoids unnecessary block activations, do not change." - | start elements element | - start := aStream position. + | memento elements element | + memento := aPPContext remember. elements := Array new: parsers size. 1 to: parsers size do: [ :index | element := (parsers at: index) - parseOn: aStream. + parseOn: aPPContext. element isPetitFailure ifTrue: [ - aStream position: start. + aPPContext restore: memento. ^ element ]. elements at: index put: element ]. ^ elements diff -r a2656b27cace -r 6112a403a52d PPStartOfLine.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/PPStartOfLine.st Fri Oct 03 02:33:08 2014 +0100 @@ -0,0 +1,18 @@ +"{ Package: 'stx:goodies/petitparser' }" + +PPParser subclass:#PPStartOfLine + instanceVariableNames:'' + classVariableNames:'' + poolDictionaries:'' + category:'PetitParser-Parsers' +! + +!PPStartOfLine methodsFor:'parsing'! + +parseOn: aPPContext + (aPPContext isStartOfLine) ifTrue: [ + ^ #startOfLine + ]. + ^ PPFailure message: 'Start of line expected' context: aPPContext at: aPPContext position +! ! + diff -r a2656b27cace -r 6112a403a52d PPStream.st --- a/PPStream.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPStream.st Fri Oct 03 02:33:08 2014 +0100 @@ -61,6 +61,22 @@ nextPutAll: (collection copyFrom: position + 1 to: readLimit) ! ! +!PPStream methodsFor:'queries'! + +insideCRLF + (position < 1) ifTrue: [ ^ false ]. + + ^ (self peek = Character lf) and: [ self peekBack = Character cr ] +! + +isStartOfLine + (position = 0) ifTrue: [ ^ true ]. + + self insideCRLF ifTrue: [ ^ false ]. + + ^ (self peekBack = Character cr) or: [ self peekBack = Character lf]. +! ! + !PPStream class methodsFor:'documentation'! version diff -r a2656b27cace -r 6112a403a52d PPToken.st --- a/PPToken.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPToken.st Fri Oct 03 02:33:08 2014 +0100 @@ -11,14 +11,9 @@ !PPToken class methodsFor:'initialization'! initialize - "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple." - - |cr| + "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple." - cr := Smalltalk isSmalltalkX - ifTrue:[Character return] - ifFalse:[Character cr]. - NewLineParser := (Character lf asParser) / (cr asParser , Character lf asParser optional) + NewLineParser := (Character lf asParser) / (Character cr asParser , Character lf asParser optional) ! ! !PPToken class methodsFor:'instance creation'! diff -r a2656b27cace -r 6112a403a52d PPTrimmingParser.st --- a/PPTrimmingParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPTrimmingParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -33,16 +33,16 @@ !PPTrimmingParser methodsFor:'parsing'! -parseOn: aStream - | position element | - position := aStream position. - [ (trimmer parseOn: aStream) isPetitFailure ] +parseOn: aPPContext + | memento element | + memento := aPPContext remember. + [ (trimmer parseOn: aPPContext) isPetitFailure ] whileFalse. - element := parser parseOn: aStream. + element := parser parseOn: aPPContext. element isPetitFailure ifTrue: [ - aStream position: position. + aPPContext restore: memento. ^ element ]. - [ (trimmer parseOn: aStream) isPetitFailure ] + [ (trimmer parseOn: aPPContext) isPetitFailure ] whileFalse. ^ element ! ! @@ -60,3 +60,4 @@ version_SVN ^ '§Id: PPTrimmingParser.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d PPWrappingParser.st --- a/PPWrappingParser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/PPWrappingParser.st Fri Oct 03 02:33:08 2014 +0100 @@ -10,8 +10,8 @@ !PPWrappingParser methodsFor:'parsing'! -parseOn: aStream - ^ block value: aStream value: [ parser parseOn: aStream ] +parseOn: aPPContext + ^ block value: aPPContext value: [ parser parseOn: aPPContext ] ! ! !PPWrappingParser class methodsFor:'documentation'! @@ -27,3 +27,4 @@ version_SVN ^ '§Id: PPWrappingParser.st 2 2010-12-17 18:44:23Z vranyj1 §' ! ! + diff -r a2656b27cace -r 6112a403a52d abbrev.stc --- a/abbrev.stc Fri Oct 03 01:59:10 2014 +0100 +++ b/abbrev.stc Fri Oct 03 02:33:08 2014 +0100 @@ -2,6 +2,8 @@ # this file is needed for stc to be able to compile modules independently. # it provides information about a classes filename, category and especially namespace. PPCharSetPredicate PPCharSetPredicate stx:goodies/petitparser 'PetitParser-Tools' 0 +PPContext PPContext stx:goodies/petitparser 'PetitParser-Core' 0 +PPContextMemento PPContextMemento stx:goodies/petitparser 'PetitParser-Core' 0 PPFailure PPFailure stx:goodies/petitparser 'PetitParser-Core' 0 PPMemento PPMemento stx:goodies/petitparser 'PetitParser-Core' 0 PPParser PPParser stx:goodies/petitparser 'PetitParser-Parsers' 0 @@ -15,6 +17,7 @@ PPLiteralParser PPLiteralParser stx:goodies/petitparser 'PetitParser-Parsers' 0 PPPluggableParser PPPluggableParser stx:goodies/petitparser 'PetitParser-Parsers' 0 PPPredicateParser PPPredicateParser stx:goodies/petitparser 'PetitParser-Parsers' 0 +PPStartOfLine PPStartOfLine stx:goodies/petitparser 'PetitParser-Parsers' 0 PPUnresolvedParser PPUnresolvedParser stx:goodies/petitparser 'PetitParser-Tools' 0 PPActionParser PPActionParser stx:goodies/petitparser 'PetitParser-Parsers' 0 PPAndParser PPAndParser stx:goodies/petitparser 'PetitParser-Parsers' 0 diff -r a2656b27cace -r 6112a403a52d analyzer/Make.proto --- a/analyzer/Make.proto Fri Oct 03 01:59:10 2014 +0100 +++ b/analyzer/Make.proto Fri Oct 03 02:33:08 2014 +0100 @@ -103,10 +103,6 @@ prereq: cd ../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd ../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd ../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd ../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd ../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd ../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd ../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" diff -r a2656b27cace -r 6112a403a52d analyzer/analyzer.rc --- a/analyzer/analyzer.rc Fri Oct 03 01:59:10 2014 +0100 +++ b/analyzer/analyzer.rc Fri Oct 03 02:33:08 2014 +0100 @@ -25,7 +25,7 @@ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0" VALUE "ProductName", "Smalltalk/X\0" VALUE "ProductVersion", "6.2.4.0\0" - VALUE "ProductDate", "Fri, 03 Oct 2014 00:58:06 GMT\0" + VALUE "ProductDate", "Fri, 03 Oct 2014 01:32:33 GMT\0" END END diff -r a2656b27cace -r 6112a403a52d analyzer/bc.mak --- a/analyzer/bc.mak Fri Oct 03 01:59:10 2014 +0100 +++ b/analyzer/bc.mak Fri Oct 03 02:33:08 2014 +0100 @@ -52,10 +52,6 @@ prereq: pushd ..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd .. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " diff -r a2656b27cace -r 6112a403a52d analyzer/stx_goodies_petitparser_analyzer.st --- a/analyzer/stx_goodies_petitparser_analyzer.st Fri Oct 03 01:59:10 2014 +0100 +++ b/analyzer/stx_goodies_petitparser_analyzer.st Fri Oct 03 02:33:08 2014 +0100 @@ -29,26 +29,25 @@ ! mandatoryPreRequisites - "list all required mandatory packages. - Packages are mandatory, if they contain superclasses of the package's classes - or classes which are extended by this package. - This list can be maintained manually or (better) generated and - updated by scanning the superclass hierarchies - (the browser has a menu function for that)" + "list packages which are mandatory as a prerequisite. + This are packages containing superclasses of my classes and classes which + are extended by myself. + They are mandatory, because we need these packages as a prerequisite for loading and compiling. + This method is generated automatically, + by searching along the inheritance chain of all of my classes." ^ #( - #'stx:goodies/petitparser' "PPActionParser - extended " - #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_analyzer " + #'stx:goodies/petitparser' "PPActionParser - extended" + #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_analyzer" ) ! referencedPreRequisites - "list all packages containing classes referenced by the packages's members. - This list can be maintained manually or (better) generated and - updated by looking for global variable accesses - (the browser has a menu function for that) - However, often too much is found, and you may want to explicitely - exclude individual packages in the #excludedFromPreRequisites method." + "list packages which are a prerequisite, because they contain + classes which are referenced by my classes. + We do not need these packages as a prerequisite for loading or compiling. + This method is generated automatically, + by searching all classes (and their packages) which are referenced by my classes." ^ #( ) @@ -90,8 +89,8 @@ ! extensionMethodNames - "lists the extension methods which are to be included in the project. - Entries are 2-element array literals, consisting of class-name and selector." + "list class/selector pairs of extensions. + A correponding method with real names must be present in my concrete subclasses" ^ #( PPActionParser match:inContext:seen: diff -r a2656b27cace -r 6112a403a52d bc.mak --- a/bc.mak Fri Oct 03 01:59:10 2014 +0100 +++ b/bc.mak Fri Oct 03 02:33:08 2014 +0100 @@ -34,7 +34,7 @@ -LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 +LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2 LOCALDEFINES= STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME) @@ -52,10 +52,6 @@ prereq: pushd ..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " @@ -73,6 +69,8 @@ # BEGINMAKEDEPEND --- do not remove this line; make depend needs it $(OUTDIR)PPCharSetPredicate.$(O) PPCharSetPredicate.$(H): PPCharSetPredicate.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) +$(OUTDIR)PPContext.$(O) PPContext.$(H): PPContext.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) +$(OUTDIR)PPContextMemento.$(O) PPContextMemento.$(H): PPContextMemento.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)PPFailure.$(O) PPFailure.$(H): PPFailure.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)PPMemento.$(O) PPMemento.$(H): PPMemento.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)PPParser.$(O) PPParser.$(H): PPParser.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) @@ -86,6 +84,7 @@ $(OUTDIR)PPLiteralParser.$(O) PPLiteralParser.$(H): PPLiteralParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)PPPluggableParser.$(O) PPPluggableParser.$(H): PPPluggableParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)PPPredicateParser.$(O) PPPredicateParser.$(H): PPPredicateParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) +$(OUTDIR)PPStartOfLine.$(O) PPStartOfLine.$(H): PPStartOfLine.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)PPUnresolvedParser.$(O) PPUnresolvedParser.$(H): PPUnresolvedParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)PPActionParser.$(O) PPActionParser.$(H): PPActionParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)PPAndParser.$(O) PPAndParser.$(H): PPAndParser.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) diff -r a2656b27cace -r 6112a403a52d libInit.cc --- a/libInit.cc Fri Oct 03 01:59:10 2014 +0100 +++ b/libInit.cc Fri Oct 03 02:33:08 2014 +0100 @@ -28,6 +28,8 @@ OBJ snd; struct __vmData__ *__pRT__; { __BEGIN_PACKAGE2__("libstx_goodies_petitparser", _libstx_goodies_petitparser_Init, "stx:goodies/petitparser"); _PPCharSetPredicate_Init(pass,__pRT__,snd); +_PPContext_Init(pass,__pRT__,snd); +_PPContextMemento_Init(pass,__pRT__,snd); _PPFailure_Init(pass,__pRT__,snd); _PPMemento_Init(pass,__pRT__,snd); _PPParser_Init(pass,__pRT__,snd); @@ -41,6 +43,7 @@ _PPLiteralParser_Init(pass,__pRT__,snd); _PPPluggableParser_Init(pass,__pRT__,snd); _PPPredicateParser_Init(pass,__pRT__,snd); +_PPStartOfLine_Init(pass,__pRT__,snd); _PPUnresolvedParser_Init(pass,__pRT__,snd); _PPActionParser_Init(pass,__pRT__,snd); _PPAndParser_Init(pass,__pRT__,snd); diff -r a2656b27cace -r 6112a403a52d petitparser.rc --- a/petitparser.rc Fri Oct 03 01:59:10 2014 +0100 +++ b/petitparser.rc Fri Oct 03 02:33:08 2014 +0100 @@ -25,7 +25,7 @@ VALUE "LegalCopyright", "(C) Lukas Renggli\0" VALUE "ProductName", "Petit Parser\0" VALUE "ProductVersion", "6.2.4.0\0" - VALUE "ProductDate", "Fri, 03 Oct 2014 00:58:02 GMT\0" + VALUE "ProductDate", "Fri, 03 Oct 2014 01:32:30 GMT\0" END END diff -r a2656b27cace -r 6112a403a52d stx_goodies_petitparser.st --- a/stx_goodies_petitparser.st Fri Oct 03 01:59:10 2014 +0100 +++ b/stx_goodies_petitparser.st Fri Oct 03 02:33:08 2014 +0100 @@ -20,6 +20,20 @@ !stx_goodies_petitparser class methodsFor:'accessing - monticello'! +monticelloLastMergedVersionInfo + "The last merged version is: " + + ^ ' + Name: PetitParser-JanKurs.250 + Author: JanKurs + Time: 01-10-2014, 04:44:04 AM + UUID: c46eea20-51a0-4deb-8fd5-8cb99810a8b4 + Repository: http://smalltalkhub.com/mc/Moose/PetitParser/main + ' + + "Created: / 03-10-2014 / 02:27:21 / Jan Vrany " +! + monticelloName "Return name of the package for Monticello. This is used when package is exported" @@ -49,27 +63,25 @@ ! mandatoryPreRequisites - "list all required mandatory packages. - Packages are mandatory, if they contain superclasses of the package's classes - or classes which are extended by this package. - This list can be maintained manually or (better) generated and - updated by scanning the superclass hierarchies - (the browser has a menu function for that)" + "list packages which are mandatory as a prerequisite. + This are packages containing superclasses of my classes and classes which + are extended by myself. + They are mandatory, because we need these packages as a prerequisite for loading and compiling. + This method is generated automatically, + by searching along the inheritance chain of all of my classes." ^ #( - #'stx:goodies/sunit' "TestAsserter - superclass of PPAbstractParseTest " - #'stx:libbasic' "ArrayedCollection - extended " - #'stx:libbasic2' "Text - extended " + #'stx:libbasic' "ArrayedCollection - extended" + #'stx:libbasic2' "Text - extended" ) ! referencedPreRequisites - "list all packages containing classes referenced by the packages's members. - This list can be maintained manually or (better) generated and - updated by looking for global variable accesses - (the browser has a menu function for that) - However, often too much is found, and you may want to explicitely - exclude individual packages in the #excludedFromPreRequisites method." + "list packages which are a prerequisite, because they contain + classes which are referenced by my classes. + We do not need these packages as a prerequisite for loading or compiling. + This method is generated automatically, + by searching all classes (and their packages) which are referenced by my classes." ^ #( ) @@ -115,6 +127,8 @@ ^ #( " or ( attributes...) in load order" PPCharSetPredicate + PPContext + PPContextMemento PPFailure PPMemento PPParser @@ -128,6 +142,7 @@ PPLiteralParser PPPluggableParser PPPredicateParser + PPStartOfLine PPUnresolvedParser PPActionParser PPAndParser @@ -156,8 +171,8 @@ ! extensionMethodNames - "lists the extension methods which are to be included in the project. - Entries are 2-element array literals, consisting of class-name and selector." + "list class/selector pairs of extensions. + A correponding method with real names must be present in my concrete subclasses" ^ #( Block asParser diff -r a2656b27cace -r 6112a403a52d tests/Make.proto --- a/tests/Make.proto Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/Make.proto Fri Oct 03 02:33:08 2014 +0100 @@ -105,6 +105,7 @@ cd ../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd ../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd ../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" + cd ../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd ../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd ../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" @@ -126,6 +127,8 @@ # BEGINMAKEDEPEND --- do not remove this line; make depend needs it +$(OUTDIR)PPContextMementoTest.$(O) PPContextMementoTest.$(H): PPContextMementoTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) +$(OUTDIR)PPContextTest.$(O) PPContextTest.$(H): PPContextTest.st $(INCLUDE_TOP)/stx/goodies/sunit/TestAsserter.$(H) $(INCLUDE_TOP)/stx/goodies/sunit/TestCase.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)stx_goodies_petitparser_tests.$(O) stx_goodies_petitparser_tests.$(H): stx_goodies_petitparser_tests.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR) # ENDMAKEDEPEND --- do not remove this line diff -r a2656b27cace -r 6112a403a52d tests/Make.spec --- a/tests/Make.spec Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/Make.spec Fri Oct 03 02:33:08 2014 +0100 @@ -50,12 +50,16 @@ STCWARNINGS=-warnNonStandard COMMON_CLASSES= \ + PPContextMementoTest \ + PPContextTest \ stx_goodies_petitparser_tests \ COMMON_OBJS= \ + $(OUTDIR_SLASH)PPContextMementoTest.$(O) \ + $(OUTDIR_SLASH)PPContextTest.$(O) \ $(OUTDIR_SLASH)stx_goodies_petitparser_tests.$(O) \ diff -r a2656b27cace -r 6112a403a52d tests/PPAbstractParserTest.st --- a/tests/PPAbstractParserTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPAbstractParserTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -20,6 +20,12 @@ ^ self name = #PPAbstractParserTest ! ! +!PPAbstractParserTest methodsFor:'context'! + +context + ^ PPContext new +! ! + !PPAbstractParserTest methodsFor:'utilities'! assert: aParser fail: aCollection @@ -27,17 +33,20 @@ ! assert: aParser fail: aCollection end: anInteger - | stream result | + | stream result context | self assert: aParser isPetitParser description: 'Parser invalid'. stream := aCollection asPetitStream. - result := aParser parse: stream. + context := self context. + + + result := aParser parse: stream withContext: context. self assert: result isPetitFailure description: 'Parser did not fail'. self - assert: stream position = anInteger + assert: context position = anInteger description: 'Parser failed at wrong position'. ^ result ! @@ -55,18 +64,17 @@ ! assert: aParser parse: aCollection to: aTargetObject end: anInteger - | stream result | - self - assert: aParser isPetitParser - description: 'Parser invalid'. + | stream result context | + + self assert: aParser isPetitParser description: 'Parser invalid'. stream := aCollection asPetitStream. - result := aParser parse: stream. + context := self context. + + result := aParser parse: stream withContext: context. aTargetObject isNil ifTrue: [ self deny: result isPetitFailure ] - ifFalse: [ self assert: result = aTargetObject ]. - self - assert: stream position = anInteger - description: 'Parser accepted at wrong position'. + ifFalse: [ self assert: result equals: aTargetObject ]. + self assert: context position = anInteger description: 'Parser accepted at wrong position'. ^ result ! @@ -76,10 +84,14 @@ assert: aParser parse: aParserObject toToken: aStartInteger stop: aStopInteger end: anEndInteger | token | - token := self assert: aParser parse: aParserObject to: nil end: anEndInteger. + token := self + assert: aParser + parse: aParserObject + to: nil + end: anEndInteger. self assert: (token isKindOf: PPToken). - self assert: (token start = aStartInteger). - self assert: (token stop = aStopInteger). + self assert: token start equals: aStartInteger. + self assert: token stop equals: aStopInteger. ^ token ! ! diff -r a2656b27cace -r 6112a403a52d tests/PPComposedTest.st --- a/tests/PPComposedTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPComposedTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -46,7 +46,7 @@ as := bs := 0. cc value. (as even and: [ bs even ]) - ifFalse: [ PPFailure message: 'Even number of a and b expected' at: 0 ] ]. + ifFalse: [ PPFailure message: 'Even number of a and b expected' context: stream at: 0 ] ]. self assert: s fail: 'a' end: 1. self assert: s fail: 'b' end: 1. diff -r a2656b27cace -r 6112a403a52d tests/PPCompositeParserTest.st --- a/tests/PPCompositeParserTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPCompositeParserTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -42,9 +42,12 @@ !PPCompositeParserTest methodsFor:'parsing'! fail: aString rule: aSymbol - | production | + | production context | production := self parserInstanceFor: aSymbol. - result := production end parse: aString. + context := self context. + + result := production end parse: aString withContext: context. + self assert: result isPetitFailure description: 'Able to parse ' , aString printString. @@ -56,9 +59,11 @@ ! parse: aString rule: aSymbol - | production | + | production context | production := self parserInstanceFor: aSymbol. - result := production end parse: aString. + context := self context. + + result := production end parse: aString withContext: context. self deny: result isPetitFailure description: 'Unable to parse ' , aString printString. diff -r a2656b27cace -r 6112a403a52d tests/PPContextMementoTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/PPContextMementoTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -0,0 +1,117 @@ +"{ Package: 'stx:goodies/petitparser/tests' }" + +TestCase subclass:#PPContextMementoTest + instanceVariableNames:'memento' + classVariableNames:'' + poolDictionaries:'' + category:'PetitTests-Tests' +! + +!PPContextMementoTest methodsFor:'accessing'! + +memento + ^ PPContextMemento new +! ! + +!PPContextMementoTest methodsFor:'running'! + +setUp + memento := self memento. +! ! + +!PPContextMementoTest methodsFor:'tests'! + +testEquality + | m1 m2 | + m1 := self memento. + m2 := self memento. + + self assert: m1 = m2. + + m1 propertyAt: #foo put: #bar. + self assert: (m1 = m2) not. + + m2 propertyAt: #foo put: #bar. + self assert: m1 = m2. +! + +testEquality2 + | m1 m2 | + m1 := self memento. + m2 := self memento. + + self assert: m1 = m2. + + m1 propertyAt: #foo put: #bar. + self assert: (m1 = m2) not. + + m2 propertyAt: #bar put: #foo. + self assert: (m1 = m2) not. +! + +testGetProperty + + | c retval retval2 | + c := OrderedCollection new. + + memento propertyAt: #foo put: c. + + retval := memento propertyAt: #foo. + self assert: retval size = c size. + self assert: (retval == c) not. + self assert: retval = c. + + c add: #element. + self assert: (retval = c) not. + + retval2 := memento propertyAt: #foo. + self assert: (retval = retval2). + self assert: (retval == retval2) not. + + retval add: #element. + self assert: (retval = retval2) not. +! + +testKeysAndValuesDo + | | + memento keysAndValuesDo: [ :key :value | + self signalFailure: 'Should not be called' + ]. +! + +testKeysAndValuesDo2 + | c1 c2 | + c1 := OrderedCollection new. + c2 := OrderedCollection new. + + memento propertyAt: #foo put: c1. + memento propertyAt: #bar put: c2. + + memento keysAndValuesDo: [ :key :value | + self assert: (value == c1) not. + self assert: (value == c2) not. + ]. +! + +testPutProperty + | c retval | + c := OrderedCollection new. + self assert: (memento hasProperty: #foo) not. + self assert: (memento hasProperty: #bar) not. + + self should: [ memento propertyAt: #foo ] raise: Error. + self assert: (memento propertyAt: #foo ifAbsent: [ c ]) == c. + + retval := memento propertyAt: #foo ifAbsentPut: [ c ]. + self assert: retval size = c size. + self assert: (retval == c) not. + self assert: retval = c. + self assert: (memento hasProperty: #foo). + + retval := memento propertyAt: #bar put: c. + self assert: retval size = c size. + self assert: (retval == c) not. + self assert: retval = c. + self assert: (memento hasProperty: #foo). +! ! + diff -r a2656b27cace -r 6112a403a52d tests/PPContextTest.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/PPContextTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -0,0 +1,175 @@ +"{ Package: 'stx:goodies/petitparser/tests' }" + +TestCase subclass:#PPContextTest + instanceVariableNames:'context' + classVariableNames:'' + poolDictionaries:'' + category:'PetitTests-Tests' +! + +!PPContextTest methodsFor:'as yet unclassified'! + +context + ^ PPContext new +! + +setUp + context := self context. +! ! + +!PPContextTest methodsFor:'tests'! + +testFurthestFailure + | f1 f2 | + + f1 := PPFailure message: #foo context: context at: 1. + self assert: context furthestFailure = f1. + f2 := PPFailure message: #foo context: context at: 1. + self assert: context furthestFailure = f1. + f2 := PPFailure message: #foo context: context at: 3. + self assert: context furthestFailure = f2. +! + +testMemoization + | stream memento memento2 collection | + stream := 'abc' asPetitStream. + context := context stream: stream. + collection := OrderedCollection new. + + context propertyAt: #foo put: collection. + + memento := context remember. + + self assert: memento isNil not. + + context next. + collection add: #element. + self assert: (context propertyAt: #foo) size = 1. + + memento2 := context remember. + + context restore: memento. + self assert: (context propertyAt: #foo) size = 0. + self assert: context position = 0. + + context restore: memento2. + self assert: (context propertyAt: #foo) size = 1. + self assert: context position = 1. +! + +testMemoization2 + | stream memento | + stream := 'abc' asPetitStream. + context := context stream: stream. + + memento := context remember. + + context next. + self assert: context position = 1. + + context restore: memento. + self assert: context position = 0. +! + +testPutGlobals + self assert: (context hasGlobal: #foo) not. + self assert: (context hasGlobal: #bar) not. + + self should: [ context globalAt: #foo ] raise: Error. + self assert: (context globalAt: #foo ifAbsent: [ #bar ]) = #bar. + + self assert: (context globalAt: #foo ifAbsentPut: [ #bar ]) = #bar. + self assert: (context hasGlobal: #foo). + self assert: (context hasGlobal: #bar) not. + self assert: (context globalAt: #foo) = #bar. + + self assert: (context globalAt: #foo ifAbsentPut: [ #zorg ]) = #bar. + self assert: (context hasGlobal: #foo). + self assert: (context hasGlobal: #bar) not. + self assert: (context globalAt: #foo) = #bar. + + self assert: (context globalAt: #foo put: #zorg) = #zorg. + self assert: (context hasGlobal: #foo). + self assert: (context hasGlobal: #bar) not. + self assert: (context globalAt: #foo) = #zorg. + + self should: [ context globalAt: #bar ] raise: Error. + self assert: (context globalAt: #bar put: #foo) = #foo. + self assert: (context globalAt: #foo) = #zorg. + self assert: (context globalAt: #bar) = #foo. + +! + +testPutProperties + self assert: (context hasProperty: #foo) not. + self assert: (context hasProperty: #bar) not. + + self should: [ context propertyAt: #foo ] raise: Error. + self assert: (context propertyAt: #foo ifAbsent: [ #bar ]) = #bar. + + self assert: (context propertyAt: #foo ifAbsentPut: [ #bar ]) = #bar. + self assert: (context hasProperty: #foo). + self assert: (context hasProperty: #bar) not. + self assert: (context propertyAt: #foo) = #bar. + + self assert: (context propertyAt: #foo ifAbsentPut: [ #zorg ]) = #bar. + self assert: (context hasProperty: #foo). + self assert: (context hasProperty: #bar) not. + self assert: (context propertyAt: #foo) = #bar. + + self assert: (context propertyAt: #foo put: #zorg) = #zorg. + self assert: (context hasProperty: #foo). + self assert: (context hasProperty: #bar) not. + self assert: (context propertyAt: #foo) = #zorg. + + self should: [ context propertyAt: #bar ] raise: Error. + self assert: (context propertyAt: #bar put: #foo) = #foo. + self assert: (context propertyAt: #foo) = #zorg. + self assert: (context propertyAt: #bar) = #foo. + +! + +testRemoveGlobals + context globalAt: #foo put: #zorg. + context globalAt: #bar put: #qwark. + + self assert: (context removeGlobal: #foo) = #zorg. + self assert: (context removeGlobal: #bar) = #qwark. + + self should: [context removeGlobal: #foo] raise: Error. + self assert: (context removeGlobal: #bar ifAbsent: [ #foobar ]) = #foobar. +! + +testRemoveProperties + context propertyAt: #foo put: #zorg. + context propertyAt: #bar put: #qwark. + + self assert: (context removeProperty: #foo) = #zorg. + self assert: (context removeProperty: #bar) = #qwark. + + self should: [context removeProperty: #foo] raise: Error. + self assert: (context removeProperty: #bar ifAbsent: [ #foobar ]) = #foobar. +! + +testStreamProtocol + context stream: 'hi there' asPetitStream. + + self assert: context position = 0. + self assert: context peek = $h. + self assert: context uncheckedPeek = $h. + + self assert: context next = $h. + self assert: context peek = $i. + self assert: context uncheckedPeek = $i. + self assert: context position = 1. + + context skip: 2. + self assert: context position = 3. + self assert: context peek = $t. + self assert: context atEnd not. + + self assert: (context next: 5) = 'there'. + self assert: context position = 8. + self assert: context atEnd. +! ! + diff -r a2656b27cace -r 6112a403a52d tests/PPExtensionTest.st --- a/tests/PPExtensionTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPExtensionTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -40,7 +40,7 @@ self assert: parser parse: 'sa' to: '' end: 1. self assert: parser parse: 'saa' to: '' end: 1. - parser := [ :stream | stream upTo: $s. PPFailure message: 'stream' at: stream position ] asParser. + parser := [ :stream | stream upTo: $s. PPFailure message: 'stream' context: stream ] asParser. self assert: parser fail: ''. self assert: parser fail: 's'. self assert: parser fail: 'as' @@ -50,7 +50,7 @@ testEpsilon | parser | parser := nil asParser. - self assert: parser asParser = parser + self assert: parser asParser equals: parser ! testOrdered @@ -67,16 +67,16 @@ testParser | parser | parser := $a asParser. - self assert: parser asParser = parser + self assert: parser asParser equals: parser ! testRange - | parser | - parser := ($a to: $c) asParser. - self assert: parser parse: 'a' to: $a. - self assert: parser parse: 'b' to: $b. - self assert: parser parse: 'c' to: $c. - self assert: parser fail: 'd' + | parser | + parser := $a - $c. + self assert: parser parse: 'a' to: $a. + self assert: parser parse: 'b' to: $b. + self assert: parser parse: 'c' to: $c. + self assert: parser fail: 'd' ! testSequence @@ -123,19 +123,19 @@ testStream | stream | stream := 'abc' readStream asPetitStream. - self assert: (stream class = PPStream). - self assert: (stream printString = '·abc'). - self assert: (stream peek) = $a. - self assert: (stream uncheckedPeek = $a). - self assert: (stream next) = $a. - self assert: (stream printString = 'a·bc'). - self assert: (stream asPetitStream = stream) + self assert: stream class equals: PPStream. + self assert: stream printString equals: '·abc'. + self assert: stream peek equals: $a. + self assert: stream uncheckedPeek equals: $a. + self assert: stream next equals: $a. + self assert: stream printString equals: 'a·bc'. + self assert: stream asPetitStream equals: stream ! testText | stream | stream := 'abc' asText asPetitStream. - self assert: stream class = PPStream + self assert: stream class equals: PPStream ! ! !PPExtensionTest class methodsFor:'documentation'! diff -r a2656b27cace -r 6112a403a52d tests/PPLambdaParserTest.st --- a/tests/PPLambdaParserTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPLambdaParserTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -37,60 +37,55 @@ !PPLambdaParserTest methodsFor:'testing-curch'! testAnd - self assert: self parserClass and = #('p' ('q' (('p' 'q') 'p'))) + self assert: self parserClass and equals: #('p' #('q' #(#('p' 'q') 'p'))) ! testFalse - self assert: self parserClass false = #('x' ('y' 'y')) + self assert: self parserClass false equals: #('x' #('y' 'y')) ! testIfThenElse - self assert: self parserClass ifthenelse = #('p' 'p') + self assert: self parserClass ifthenelse equals: #('p' 'p') ! testNot - self assert: self parserClass not = #('p' ('a' ('b' (('p' 'b') 'a')))) + self assert: self parserClass not equals: #('p' #('a' #('b' #(#('p' 'b') 'a')))) ! testOr - self assert: self parserClass or = #('p' ('q' (('p' 'p') 'q'))) + self assert: self parserClass or equals: #('p' #('q' #(#('p' 'p') 'q'))) ! testTrue - self assert: self parserClass true = #('x' ('y' 'x')) + self assert: self parserClass true equals: #('x' #('y' 'x')) ! ! !PPLambdaParserTest methodsFor:'testing-utilities'! testParseOnError | beenHere | - result := self parserClass - parse: '\x.y' - onError: [ self fail ]. - self assert: result = #('x' 'y'). - + result := self parserClass parse: '\x.y' onError: [ self fail ]. + self assert: result equals: #('x' 'y'). + beenHere := false. + result := self parserClass parse: '\x.' onError: [ beenHere := true ]. + self assert: beenHere. beenHere := false. result := self parserClass parse: '\x.' - onError: [ beenHere := true ]. + onError: [ :fail | + beenHere := true. + fail ]. self assert: beenHere. - - beenHere := false. - result := self parserClass - parse: '\x.' - onError: [ :fail | beenHere := true. fail ]. - self assert: beenHere. - self assert: (result message findString: '$(') > 0. - self assert: (result message findString: 'expected') > 0. - self assert: (result position = 0). - + self assert: (result message includesSubstring: 'separator'). + self assert: (result message includesSubstring: 'expected'). + self assert: result position equals: 3. beenHere := false. result := self parserClass parse: '\x.' onError: [ :msg :pos | - self assert: (msg findString: '$(') > 0. - self assert: (msg findString: 'expected') > 0. - self assert: (pos = 0). + self assert: (msg includesSubstring: 'separator'). + self assert: (msg includesSubstring: 'expected'). + self assert: pos equals: 3. beenHere := true ]. self assert: result. self assert: beenHere @@ -98,35 +93,28 @@ testParseStartingAtOnError | beenHere | - result := self parserClass - parse: 'x' - startingAt: #variable - onError: [ self fail ]. - self assert: result = 'x'. - + result := self parserClass parse: 'x' startingAt: #variable onError: [ self fail ]. + self assert: result equals: 'x'. + beenHere := false. + result := self parserClass parse: '\' startingAt: #variable onError: [ beenHere := true ]. + self assert: beenHere. beenHere := false. result := self parserClass parse: '\' startingAt: #variable - onError: [ beenHere := true ]. + onError: [ :fail | + beenHere := true. + fail ]. self assert: beenHere. - - beenHere := false. - result := self parserClass - parse: '\' - startingAt: #variable - onError: [ :fail | beenHere := true. fail ]. - self assert: beenHere. - self assert: result message = 'letter expected'. - self assert: result position = 0. - + self assert: result message equals: 'separator expected'. + self assert: result position equals: 0. beenHere := false. result := self parserClass parse: '\' startingAt: #variable onError: [ :msg :pos | - self assert: msg = 'letter expected'. - self assert: pos = 0. + self assert: msg equals: 'separator expected'. + self assert: pos equals: 0. beenHere := true ]. self assert: beenHere ! diff -r a2656b27cace -r 6112a403a52d tests/PPObjectTest.st --- a/tests/PPObjectTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPObjectTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -46,7 +46,7 @@ result := continuation value. (result isPetitFailure or: [ result first + result last first ~= result last last ]) ifFalse: [ parser parseOn: stream ] - ifTrue: [ PPFailure message: 'invalid fibonacci sequence' at: stream position ] ]). + ifTrue: [ PPFailure message: 'invalid fibonacci sequence' context: stream ] ]). self assert: parser parse: #(1 1) to: 2. self assert: parser parse: #(1 1 2) to: 3. self assert: parser parse: #(1 1 2 3) to: 5. diff -r a2656b27cace -r 6112a403a52d tests/PPParserTest.st --- a/tests/PPParserTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPParserTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -13,12 +13,14 @@ testAnd | parser | parser := 'foo' asParser flatten , 'bar' asParser flatten and. - - self assert: parser parse: 'foobar' to: #('foo' 'bar') end: 3. + self + assert: parser + parse: 'foobar' + to: #('foo' 'bar') + end: 3. self assert: parser fail: 'foobaz'. - parser := 'foo' asParser and. - self assert: parser and = parser + self assert: parser and equals: parser ! testBlock @@ -93,8 +95,7 @@ testEndOfInput | parser | parser := PPEndOfInputParser on: $a asParser. - self assert: parser end = parser. - + self assert: parser end equals: parser. self assert: parser parse: 'a' to: $a. self assert: parser fail: ''. self assert: parser fail: 'aa' @@ -121,28 +122,22 @@ testFailing | parser result | parser := PPFailingParser message: 'Plonk'. - self assert: parser 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 = 'Plonk'. - self assert: result printString = 'Plonk at 0' + self assert: result message equals: 'Plonk'. + self assert: result printString equals: 'Plonk at 0' ! testLiteralObject | parser | - parser := PPLiteralObjectParser - on: $a - message: 'letter "a" expected'. - self assert: parser literal = $a. - self assert: parser message = 'letter "a" expected'. - + 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' - ! testLiteralObjectCaseInsensitive @@ -160,13 +155,10 @@ testLiteralSequence | parser | - parser := PPLiteralSequenceParser - on: 'abc' - message: 'sequence "abc" expected'. - self assert: parser size = 3. - self assert: parser literal = 'abc'. - self assert: parser message = 'sequence "abc" expected'. - + 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' @@ -188,15 +180,21 @@ testMax | parser | parser := $a asParser max: 2. - self assert: parser min = 0. - self assert: parser 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. - + self + assert: parser + parse: 'aaa' + to: #($a $a) + end: 2. + self + assert: parser + parse: 'aaaa' + to: #($a $a) + end: 2. self assert: (parser printString endsWith: '[0, 2]') ! @@ -249,32 +247,29 @@ testMemoized | count parser twice | count := 0. - parser := [ :s | count := count + 1. s next ] asParser memoized. + 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 = 1. - + self assert: count equals: 1. count := 0. self assert: twice parse: 'a' to: #($a $a). - self assert: count = 1. - - self assert: parser memoized = parser + self assert: count equals: 1. + self assert: parser memoized equals: parser ! testMin | parser | parser := $a asParser min: 2. - self assert: parser 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). - self assert: (parser printString endsWith: '[2, *]') ! @@ -353,17 +348,23 @@ testMinMax | parser | parser := $a asParser min: 2 max: 4. - self assert: parser min = 2. - self assert: parser 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. - + self + assert: parser + parse: 'aaaaa' + to: #($a $a $a $a) + end: 4. + self + assert: parser + parse: 'aaaaaa' + to: #($a $a $a $a) + end: 4. self assert: (parser printString endsWith: '[2, 4]') ! @@ -478,24 +479,32 @@ | block parser | block := [ :stream | stream position ]. parser := block asParser. - self assert: parser block = block + self assert: parser block equals: block ! testPlus | parser | parser := $a asParser plus. - - self assert: parser min = 1. + 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 + 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' @@ -505,54 +514,120 @@ | limit parser | limit := #digit asParser. parser := #word asParser plusGreedy: limit. - - self assert: parser min = 1. - self assert: parser max > parser min. - self assert: parser limit = limit. - self assert: parser children size = 2. - self assert: parser children last = limit. - + self assert: parser 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. + 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 ! testPlusLazy | limit parser | limit := #digit asParser. parser := #word asParser plusLazy: limit. - - self assert: parser min = 1. - self assert: parser max > parser min. - self assert: parser limit = limit. - self assert: parser children size = 2. - self assert: parser children last = limit. - + self assert: parser 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 + 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 ! testSeparatedBy @@ -609,77 +684,180 @@ testStar | parser | parser := $a asParser star. - - self assert: parser min = 0. + 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 + 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 ! testStarGreedy | limit parser | limit := #digit asParser. parser := #word asParser starGreedy: limit. - - self assert: parser min = 0. + self assert: parser min equals: 0. self assert: parser max > parser min. - self assert: parser limit = limit. - self assert: parser children size = 2. - self assert: parser children last = limit. - + self assert: parser 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 + 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 ! testStarLazy | limit parser | limit := #digit asParser. parser := #word asParser starLazy: limit. - - self assert: parser min = 0. + self assert: parser min equals: 0. self assert: parser max > parser min. - self assert: parser limit = limit. - self assert: parser children size = 2. - self assert: parser children last = limit. - + self assert: parser 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 + 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 ! testTimes @@ -746,30 +924,28 @@ | parser | parser := PPSequenceParser new. self assert: parser name isNil. - parser := PPChoiceParser named: 'choice'. - self assert: parser name = 'choice'. - + self assert: parser name equals: 'choice'. parser := $* asParser name: 'star'. - self assert: parser name = 'star' + self assert: parser name equals: 'star' ! testPrint | parser | parser := PPParser new. - self assert: (parser printString findString: 'PPParser') > 0. + self assert: (parser printString includesSubstring: 'PPParser'). parser := PPParser named: 'choice'. - self assert: (parser printString findString: 'PPParser(choice') > 0. + self assert: (parser printString includesSubstring: 'PPParser(choice'). parser := PPLiteralObjectParser on: $a. - self assert: (parser printString findString: '$a') > 0. + self assert: (parser printString includesSubstring: '$a'). parser := PPFailingParser message: 'error'. - self assert: (parser printString findString: 'error') > 0. + self assert: (parser printString includesSubstring: 'error'). parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'. - self assert: (parser printString findString: 'error') > 0 + self assert: (parser printString includesSubstring: 'error') ! ! !PPParserTest methodsFor:'testing-fixtures'! @@ -833,8 +1009,7 @@ | block parser | block := [ :char | char asUppercase ]. parser := #any asParser ==> block. - self assert: parser block = block. - + self assert: parser block equals: block. self assert: parser parse: 'a' to: $A. self assert: parser parse: 'b' to: $B ! @@ -965,14 +1140,21 @@ testToken | parser | parser := $a asParser token. - self assert: parser tokenClass = PPToken. - self assert: parser parse: 'a' toToken: 1 stop: 1. + 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 = PPToken. - self assert: parser parse: 'a' toToken: 1 stop: 1. + self assert: parser tokenClass equals: PPToken. + self + assert: parser + parse: 'a' + toToken: 1 + stop: 1. self assert: parser fail: ''. self assert: parser fail: 'b' ! @@ -1077,20 +1259,14 @@ 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). - + parser := #digit asParser plus >=> [ :stream :cc | Array with: stream position with: cc value with: stream position ]. + self assert: parser parse: '1' to: #(0 #($1) 1). + self assert: parser parse: '12' to: #(0 #($1 $2) 2). + self assert: parser parse: '123' to: #(0 #($1 $2 $3) 3). result := parser parse: 'a'. - self assert: result first = 0. + self assert: result first equals: 0. self assert: result second isPetitFailure. - self assert: result last = 0 + self assert: result last equals: 0 ! ! !PPParserTest methodsFor:'testing-properties'! @@ -1161,18 +1337,16 @@ p3 := PPUnresolvedParser new. p3 def: p2 / p3. self assert: p1 children isEmpty. - self assert: p2 children size = 1. - self assert: p3 children size = 2 + self assert: p2 children size equals: 1. + self assert: p3 children size equals: 2 ! testFailure | failure | - failure := PPFailure message: 'Error' at: 3. - - self assert: failure message = 'Error'. - self assert: failure position = 3. + 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 ! @@ -1182,10 +1356,9 @@ 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 = 1. - self assert: p2 children size = 2. - self assert: p3 children size = 3 + self assert: p1 children size equals: 1. + self assert: p2 children size equals: 2. + self assert: p3 children size equals: 3 ! testMatches @@ -1202,16 +1375,14 @@ testMatchesIn | parser result | parser := $a asParser. - result := parser matchesIn: 'abba'. - self assert: result size = 2. - self assert: result first = $a. - self assert: result last = $a. - + 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 = 3. - self assert: result first = $a. - self assert: result last = $a + self assert: result size equals: 3. + self assert: result first equals: $a. + self assert: result last equals: $a ! testMatchesInEmpty @@ -1219,9 +1390,8 @@ | parser result | parser := [ :stream | stream position ] asParser. - result := parser matchesIn: '123'. - self assert: result asArray = #(0 1 2 3) + self assert: result asArray equals: #(0 1 2 3) ! testMatchesInOverlapping @@ -1229,26 +1399,23 @@ | parser result | parser := #digit asParser , #digit asParser. - result := parser matchesIn: 'a123b'. - self assert: result size = 2. - self assert: result first = #($1 $2). - self assert: result last = #($2 $3) + self assert: result size equals: 2. + self assert: result first equals: #($1 $2). + self assert: result last equals: #($2 $3) ! testMatchesSkipIn | parser result | parser := $a asParser. - result := parser matchesSkipIn: 'abba'. - self assert: result size = 2. - self assert: result first = $a. - self assert: result last = $a. - + 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 = 3. - self assert: result first = $a. - self assert: result last = $a + self assert: result size equals: 3. + self assert: result first equals: $a. + self assert: result last equals: $a ! testMatchesSkipInOverlapping @@ -1256,10 +1423,9 @@ | parser result | parser := #digit asParser , #digit asParser. - result := parser matchesSkipIn: 'a123b'. - self assert: result size = 1. - self assert: result first = #($1 $2) + self assert: result size equals: 1. + self assert: result first equals: #($1 $2) ! testMatchingRangesIn @@ -1268,10 +1434,10 @@ parser := #digit asParser plus. result := parser matchingRangesIn: input. result := result collect: [ :each | input copyFrom: each first to: each last ]. - self assert: result size = 3. - self assert: result first = '12'. - self assert: result second = '2'. - self assert: result last = '3' + self assert: result size equals: 3. + self assert: result first equals: '12'. + self assert: result second equals: '2'. + self assert: result last equals: '3' ! testMatchingSkipRangesIn @@ -1280,35 +1446,31 @@ parser := #digit asParser plus. result := parser matchingSkipRangesIn: input. result := result collect: [ :each | input copyFrom: each first to: each last ]. - self assert: result size = 2. - self assert: result first = '12'. - self assert: result last = '3' + self assert: result size equals: 2. + self assert: result first equals: '12'. + self assert: result last equals: '3' ! testParse | parser result | parser := $a asParser. - - self assert: (parser parse: 'a') = $a. + self assert: (parser parse: 'a') equals: $a. self assert: (result := parser parse: 'b') isPetitFailure. - self assert: (result message findString: '$a') > 0. - self assert: (result message findString: 'expected') > 0. - self assert: (result position = 0). - - self assert: (parser parse: 'a' readStream) = $a. + self assert: (result message includesSubstring: '$a'). + 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 findString: '$a') > 0. - self assert: (result message findString: 'expected') > 0. - self assert: (result position = 0) + self assert: (result message includesSubstring: '$a'). + self assert: (result message includesSubstring: 'expected'). + self assert: result position equals: 0 ! testParseOnError0 | parser result seen | parser := $a asParser. - result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. - self assert: result = $a. - + self assert: result equals: $a. result := parser parse: 'b' onError: [ seen := true ]. self assert: result. self assert: seen @@ -1317,15 +1479,15 @@ testParseOnError1 | parser result seen | parser := $a asParser. - result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. - self assert: result = $a. - - result := parser parse: 'b' onError: [ :failure | - self assert: (failure position = 0). - self assert: (failure message findString: '$a') > 0. - self assert: (failure message findString: 'expected') > 0. - seen := true ]. + self assert: result equals: $a. + result := parser + parse: 'b' + onError: [ :failure | + self assert: failure position equals: 0. + self assert: (failure message includesSubstring: '$a'). + self assert: (failure message includesSubstring: 'expected'). + seen := true ]. self assert: result. self assert: seen ! @@ -1333,15 +1495,15 @@ testParseOnError2 | parser result seen | parser := $a asParser. - result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ]. - self assert: result = $a. - - result := parser parse: 'b' onError: [ :msg :pos | - self assert: (msg findString: '$a') > 0. - self assert: (msg findString: 'expected') > 0. - self assert: pos = 0. - seen := true ]. + self assert: result equals: $a. + result := parser + parse: 'b' + onError: [ :msg :pos | + self assert: (msg includesSubstring: '$a'). + self assert: (msg includesSubstring: 'expected'). + self assert: pos equals: 0. + seen := true ]. self assert: result. self assert: seen ! @@ -1366,6 +1528,11 @@ ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPParserTest.st,v 1.4 2014-03-04 14:34:21 cg Exp $' ! +version_HG + + ^ '$Changeset: $' +! + version_SVN ^ '$Id: PPParserTest.st,v 1.4 2014-03-04 14:34:21 cg Exp $' ! ! diff -r a2656b27cace -r 6112a403a52d tests/PPPredicateTest.st --- a/tests/PPPredicateTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPPredicateTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -11,13 +11,7 @@ !PPPredicateTest methodsFor:'private'! charactersDo: aBlock - "cg: isn't 256 one too many?" - - Smalltalk isSmalltalkX ifTrue:[ - 0 to: 255 do: [ :index | aBlock value: (Character codePoint: index) ] - ] ifFalse:[ - 1 to: 256 do: [ :index | aBlock value: (Character codePoint: index) ] - ]. + 1 to: 256 do: [ :index | aBlock value: (Character codePoint: index) ] ! ! !PPPredicateTest methodsFor:'testing'! @@ -26,12 +20,15 @@ | block parser | block := [ :char | char = $* ]. parser := PPPredicateObjectParser on: block message: 'starlet'. - self assert: parser block = block. - self assert: parser message = 'starlet'. - + self assert: parser block equals: block. + self assert: parser message equals: 'starlet'. self assertCharacterSets: parser. self assert: parser parse: '*' to: $*. - self assert: parser parse: '**' to: $* end: 1. + self + assert: parser + parse: '**' + to: $* + end: 1. self assert: parser fail: ''. self assert: parser fail: '1'. self assert: parser fail: 'a' @@ -40,17 +37,14 @@ !PPPredicateTest methodsFor:'testing-chars'! testBlank - | parser cr| - parser := #blank asParser. - self assertCharacterSets: parser. - self assert: parser parse: (String with: Character space) to: Character space. - self assert: parser parse: (String with: Character tab) to: Character tab. - self assert: parser fail: ''. - self assert: parser fail: '1'. - cr := Smalltalk isSmalltalkX - ifTrue:[Character return] - ifFalse:[Character cr]. - self assert: parser fail: (String with: cr) + | parser | + parser := #blank asParser. + self assertCharacterSets: parser. + self assert: parser parse: (String with: Character space) to: Character space. + self assert: parser parse: (String with: Character tab) to: Character tab. + self assert: parser fail: ''. + self assert: parser fail: '1'. + self assert: parser fail: (String with: Character cr) ! testChar @@ -65,15 +59,10 @@ ! testCr - | parser cr | - - cr := Smalltalk isSmalltalkX - ifTrue:[Character return] - ifFalse:[Character cr]. - - parser := #cr asParser. - self assertCharacterSets: parser. - self assert: parser parse: (String with: cr) to: cr + | parser | + parser := #cr asParser. + self assertCharacterSets: parser. + self assert: parser parse: (String with: Character cr) to: Character cr ! testDigit @@ -132,15 +121,12 @@ ! testNewline - | parser cr| - cr := Smalltalk isSmalltalkX - ifTrue:[Character return] - ifFalse:[Character cr]. - parser := #newline asParser. - self assertCharacterSets: parser. - self assert: parser parse: (String with: cr) to: cr. - self assert: parser parse: (String with: Character lf) to: Character lf. - self assert: parser fail: ' ' + | parser | + parser := #newline asParser. + self assertCharacterSets: parser. + self assert: parser parse: (String with: Character cr) to: Character cr. + self assert: parser parse: (String with: Character lf) to: Character lf. + self assert: parser fail: ' ' ! testPunctuation @@ -164,6 +150,29 @@ self assert: parser fail: 'a' ! +testStartOfLine + | parser | + parser := #startOfLine asParser, #any asParser star. + + self assert: parser parse: 'lorem ipsum'. + + parser := #any asParser, #startOfLine asParser, #any asParser star. + self assert: parser fail: 'lorem ipsum'. + + parser := #startOfLine asParser, #any asParser, #startOfLine asParser, #any asParser star. + self assert: parser parse: String cr, 'lorem ipsum'. + self assert: parser parse: String lf, 'lorem ipsum'. + self assert: parser fail: String crlf, 'lorem ipsum'. + + self assert: parser fail: String crlf. + self assert: parser parse: String cr. + self assert: parser parse: String lf. + + parser := #startOfLine asParser, #any asParser, #any asParser, #startOfLine asParser, #any asParser star. + self assert: parser parse: String crlf, 'lorem ipsum'. + self assert: parser parse: String crlf. +! + testTab | parser | parser := #tab asParser. @@ -248,20 +257,19 @@ testSequenceParser | parser | - parser := PPPredicateSequenceParser - on: [ :value | value first isUppercase ] + parser := PPPredicateSequenceParser + on: [ :value | value first isUppercase ] message: 'uppercase 3 letter words' size: 3. - self assert: parser size = 3. + self assert: parser size equals: 3. self assert: parser parse: 'Abc'. self assert: parser parse: 'ABc'. self assert: parser parse: 'ABC'. self assert: parser fail: 'abc'. self assert: parser fail: 'aBC'. self assert: parser fail: 'Ab'. - parser := parser negate. - self assert: parser size = 3. + self assert: parser size equals: 3. self assert: parser fail: 'Abc'. self assert: parser fail: 'ABc'. self assert: parser fail: 'ABC'. diff -r a2656b27cace -r 6112a403a52d tests/PPScriptingTest.st --- a/tests/PPScriptingTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPScriptingTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -14,68 +14,68 @@ !PPScriptingTest methodsFor:'examples'! expressionInterpreter - "Same as #expressionInterpreter but with semantic actions." - - | mul prim add dec | - add := PPUnresolvedParser new. - mul := PPUnresolvedParser new. - prim := PPUnresolvedParser new. - dec := ($0 to: $9) asParser ==> [ :token | token codePoint - $0 codePoint ]. - add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ]) - / mul. - mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ]) - / prim. - prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ]) - / dec. - ^ add end + "Same as #expressionInterpreter but with semantic actions." + + | mul prim add dec | + add := PPUnresolvedParser new. + mul := PPUnresolvedParser new. + prim := PPUnresolvedParser new. + dec := ($0 - $9) ==> [ :token | token codePoint - $0 codePoint ]. + add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ]) + / mul. + mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ]) + / prim. + prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ]) + / dec. + ^ add end ! expressionParser - "Simple demo of scripting an expression parser." - - | mul prim add dec | - add := PPUnresolvedParser new. - mul := PPUnresolvedParser new. - prim := PPUnresolvedParser new. - dec := ($0 to: $9) asParser. - add def: (mul , $+ asParser , add) - / mul. - mul def: (prim , $* asParser , mul) - / prim. - prim def: ($( asParser , add , $) asParser) - / dec. - ^ add end + "Simple demo of scripting an expression parser." + + | mul prim add dec | + add := PPUnresolvedParser new. + mul := PPUnresolvedParser new. + prim := PPUnresolvedParser new. + dec := ($0 - $9). + add def: (mul , $+ asParser , add) + / mul. + mul def: (prim , $* asParser , mul) + / prim. + prim def: ($( asParser , add , $) asParser) + / dec. + ^ add end ! straightLineParser - | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper | - goal := PPUnresolvedParser new. - stmList := PPUnresolvedParser new. - stm := PPUnresolvedParser new. - exp := PPUnresolvedParser new. - expList := PPUnresolvedParser new. - mulExp := PPUnresolvedParser new. - primExp := PPUnresolvedParser new. - - lower := ($a to: $z) asParser. - upper := ($A to: $Z) asParser. - char := lower / upper. - nonzero := ($1 to: $9) asParser. - dec := ($0 to: $9) asParser. - id := char, ( char / dec ) star. - num := $0 asParser / ( nonzero, dec star). + | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper | + goal := PPUnresolvedParser new. + stmList := PPUnresolvedParser new. + stm := PPUnresolvedParser new. + exp := PPUnresolvedParser new. + expList := PPUnresolvedParser new. + mulExp := PPUnresolvedParser new. + primExp := PPUnresolvedParser new. + + lower := $a - $z. + upper := $A - $Z. + char := lower / upper. + nonzero := $1 - $9. + dec := $0 - $9. + id := char, ( char / dec ) star. + num := $0 asParser / ( nonzero, dec star). - goal def: stmList end. - stmList def: stm , ( $; asParser, stm ) star. - stm def: ( id, ':=' asParser, exp ) - / ( 'print' asParser, $( asParser, expList, $) asParser ). - exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star. - expList def: exp, ( $, asParser, exp ) star. - mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star. - primExp def: id - / num - / ( $( asParser, stmList, $, asParser, exp, $) asParser ). - ^ goal + goal def: stmList end. + stmList def: stm , ( $; asParser, stm ) star. + stm def: ( id, ':=' asParser, exp ) + / ( 'print' asParser, $( asParser, expList, $) asParser ). + exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star. + expList def: exp, ( $, asParser, exp ) star. + mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star. + primExp def: id + / num + / ( $( asParser, stmList, $, asParser, exp, $) asParser ). + ^ goal ! ! !PPScriptingTest methodsFor:'tests'! diff -r a2656b27cace -r 6112a403a52d tests/PPTokenTest.st --- a/tests/PPTokenTest.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/PPTokenTest.st Fri Oct 03 02:33:08 2014 +0100 @@ -19,11 +19,9 @@ testCollection | input result | input := 'foo '. - result := self - parse: input - using: self identifier. - self assert: (result collection = input). - self assert: (result collection == input) + result := self parse: input using: self identifier. + self assert: result collection equals: input. + self assert: result collection == input ! testInitialize @@ -38,31 +36,25 @@ testPrinting | result | result := PPToken on: 'var'. - self assert: (result printString findString: 'PPToken[1,3]') > 0 + self assert: (result printString includesSubstring: 'PPToken[1,3]') ! testSize | result | - result := self - parse: 'foo' - using: self identifier. - self assert: result size = 3 + result := self parse: 'foo' using: self identifier. + self assert: result size equals: 3 ! testStart | result | - result := self - parse: 'foo' - using: self identifier. - self assert: result start = 1 + result := self parse: 'foo' using: self identifier. + self assert: result start equals: 1 ! testStop | result | - result := self - parse: 'foo' - using: self identifier. - self assert: result stop = 3 + result := self parse: 'foo' using: self identifier. + self assert: result stop equals: 3 ! testValue @@ -75,11 +67,11 @@ testEquality | token1 token2 | - token1 := self parse: 'foo' using: self identifier. - token2 := self parse: 'foo' using: self identifier. + token1 := self parse: 'foo' using: self identifier. + token2 := self parse: 'foo' using: self identifier. self deny: token1 == token2. - self assert: token1 = token2. - self assert: token1 hash = token2 hash. + self assert: token1 equals: token2. + self assert: token1 hash equals: token2 hash ! ! !PPTokenTest methodsFor:'testing-copying'! @@ -88,41 +80,30 @@ | result other | result := PPToken on: 'abc'. other := result copyFrom: 2 to: 2. - - self assert: other size = 1. - self assert: other start = 2. - self assert: other stop = 2. - self assert: other collection = result collection + self assert: other size equals: 1. + self assert: other start equals: 2. + self assert: other stop equals: 2. + self assert: other collection equals: result collection ! ! !PPTokenTest methodsFor:'testing-querying'! testColumn - | input parser result cr | - - cr := Smalltalk isSmalltalkX - ifTrue:[ Character return] - ifFalse:[ Character cr ]. - input := '1' , (String with:cr) , '12' , (String with: cr with: Character lf) , '123' , (String with: Character lf) , '1234'. - parser := #any asParser token star. - result := parser parse: input. - result - with: #(1 2 1 2 3 4 1 2 3 4 1 2 3 4) - do: [ :token :line | self assert: token column = line ] + | input parser result | + input := '1' , (String with: Character cr) , '12' , (String with: Character cr with: Character lf) , '123' + , (String with: Character lf) , '1234'. + parser := #any asParser token star. + result := parser parse: input. + result with: #(1 2 1 2 3 4 1 2 3 4 1 2 3 4) do: [ :token :line | self assert: token column equals: line ] ! testLine - | input parser result cr| - - cr := Smalltalk isSmalltalkX - ifTrue:[Character return] - ifFalse:[Character cr]. - input := '1' , (String with: cr) , '12' , (String with: cr with: Character lf) , '123' , (String with: Character lf) , '1234'. - parser := #any asParser token star. - result := parser parse: input. - result - with: #(1 1 2 2 2 2 3 3 3 3 4 4 4 4) - do: [ :token :line | self assert: token line = line ] + | input parser result | + input := '1' , (String with: Character cr) , '12' , (String with: Character cr with: Character lf) , '123' + , (String with: Character lf) , '1234'. + parser := #any asParser token star. + result := parser parse: input. + result with: #(1 1 2 2 2 2 3 3 3 3 4 4 4 4) do: [ :token :line | self assert: token line equals: line ] ! ! !PPTokenTest methodsFor:'testing-values'! @@ -130,20 +111,16 @@ testInputValue | input result | input := 'foo'. - result := self - parse: input - using: self identifier. - self assert: result inputValue = input. + result := self parse: input using: self identifier. + self assert: result inputValue equals: input. self deny: result inputValue == input ! testParsedValue | input result | input := 'foo'. - result := self - parse: input - using: self identifier. - self assert: result parsedValue = #($f $o $o) + result := self parse: input using: self identifier. + self assert: result parsedValue equals: #($f $o $o) ! ! !PPTokenTest methodsFor:'utilities'! diff -r a2656b27cace -r 6112a403a52d tests/abbrev.stc --- a/tests/abbrev.stc Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/abbrev.stc Fri Oct 03 02:33:08 2014 +0100 @@ -1,21 +1,23 @@ # automagically generated by the project definition # this file is needed for stc to be able to compile modules independently. # it provides information about a classes filename, category and especially namespace. +PPAbstractParseTest PPAbstractParseTest stx:goodies/petitparser/tests 'PetitTests-Core' 1 PPAbstractParserTest PPAbstractParserTest stx:goodies/petitparser/tests 'PetitTests-Core' 1 +PPArithmeticParser PPArithmeticParser stx:goodies/petitparser/tests 'PetitTests-Examples' 0 +PPContextMementoTest PPContextMementoTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 +PPContextTest PPContextTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 +PPLambdaParser PPLambdaParser stx:goodies/petitparser/tests 'PetitTests-Examples' 0 +PPParserResource PPParserResource stx:goodies/petitparser/tests 'PetitTests-Core' 1 stx_goodies_petitparser_tests stx_goodies_petitparser_tests stx:goodies/petitparser/tests '* Projects & Packages *' 3 +PPComposedTest PPComposedTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 PPCompositeParserTest PPCompositeParserTest stx:goodies/petitparser/tests 'PetitTests-Core' 1 -PPAbstractParseTest PPAbstractParseTest stx:goodies/petitparser/tests 'PetitTests-Core' 1 -PPArithmeticParserTest PPArithmeticParserTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 -PPComposedTest PPComposedTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 PPExtensionTest PPExtensionTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 -PPLambdaParserTest PPLambdaParserTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 +PPMappingTest PPMappingTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 PPObjectTest PPObjectTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 -PPParserResource PPParserResource stx:goodies/petitparser/tests 'PetitTests-Core' 1 PPParserTest PPParserTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 PPPredicateTest PPPredicateTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 PPScriptingTest PPScriptingTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 PPTokenTest PPTokenTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 +PPArithmeticParserTest PPArithmeticParserTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 +PPLambdaParserTest PPLambdaParserTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 PPExpressionParserTest PPExpressionParserTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 -PPMappingTest PPMappingTest stx:goodies/petitparser/tests 'PetitTests-Tests' 1 -PPArithmeticParser PPArithmeticParser stx:goodies/petitparser/tests 'PetitTests-Examples' 0 -PPLambdaParser PPLambdaParser stx:goodies/petitparser/tests 'PetitTests-Examples' 0 diff -r a2656b27cace -r 6112a403a52d tests/bc.mak --- a/tests/bc.mak Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/bc.mak Fri Oct 03 02:33:08 2014 +0100 @@ -54,6 +54,7 @@ pushd ..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " + pushd .. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " @@ -72,6 +73,8 @@ # BEGINMAKEDEPEND --- do not remove this line; make depend needs it +$(OUTDIR)PPContextMementoTest.$(O) PPContextMementoTest.$(H): PPContextMementoTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) +$(OUTDIR)PPContextTest.$(O) PPContextTest.$(H): PPContextTest.st $(INCLUDE_TOP)\stx\goodies\sunit\TestAsserter.$(H) $(INCLUDE_TOP)\stx\goodies\sunit\TestCase.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)stx_goodies_petitparser_tests.$(O) stx_goodies_petitparser_tests.$(H): stx_goodies_petitparser_tests.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR) # ENDMAKEDEPEND --- do not remove this line diff -r a2656b27cace -r 6112a403a52d tests/libInit.cc --- a/tests/libInit.cc Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/libInit.cc Fri Oct 03 02:33:08 2014 +0100 @@ -27,6 +27,8 @@ void _libstx_goodies_petitparser_tests_Init(pass, __pRT__, snd) OBJ snd; struct __vmData__ *__pRT__; { __BEGIN_PACKAGE2__("libstx_goodies_petitparser_tests", _libstx_goodies_petitparser_tests_Init, "stx:goodies/petitparser/tests"); +_PPContextMementoTest_Init(pass,__pRT__,snd); +_PPContextTest_Init(pass,__pRT__,snd); _stx_137goodies_137petitparser_137tests_Init(pass,__pRT__,snd); diff -r a2656b27cace -r 6112a403a52d tests/stx_goodies_petitparser_tests.st --- a/tests/stx_goodies_petitparser_tests.st Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/stx_goodies_petitparser_tests.st Fri Oct 03 02:33:08 2014 +0100 @@ -10,6 +10,20 @@ !stx_goodies_petitparser_tests class methodsFor:'accessing - monticello'! +monticelloLastMergedVersionInfo + "The last merged version is: " + + ^ ' + Name: PetitTests-JanKurs.60 + Author: JanKurs + Time: 29-09-2014, 11:48:10 AM + UUID: 28fd2e65-c287-4f73-b71e-5b6bb25bebaa + Repository: http://smalltalkhub.com/mc/Moose/PetitParser/main + ' + + "Created: / 03-10-2014 / 02:28:16 / Jan Vrany " +! + monticelloName "Return name of the package for Monticello. This is used when package is exported" @@ -29,29 +43,28 @@ ! mandatoryPreRequisites - "list all required mandatory packages. - Packages are mandatory, if they contain superclasses of the package's classes - or classes which are extended by this package. - This list can be maintained manually or (better) generated and - updated by scanning the superclass hierarchies - (the browser has a menu function for that)" + "list packages which are mandatory as a prerequisite. + This are packages containing superclasses of my classes and classes which + are extended by myself. + They are mandatory, because we need these packages as a prerequisite for loading and compiling. + This method is generated automatically, + by searching along the inheritance chain of all of my classes." ^ #( - #'stx:goodies/sunit' "TestAsserter - superclass of PPAbstractParserTest " - #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_tests " + #'stx:goodies/petitparser' "PPCompositeParser - superclass of PPArithmeticParser" + #'stx:goodies/sunit' "TestAsserter - superclass of PPAbstractParseTest" + #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_tests" ) ! referencedPreRequisites - "list all packages containing classes referenced by the packages's members. - This list can be maintained manually or (better) generated and - updated by looking for global variable accesses - (the browser has a menu function for that) - However, often too much is found, and you may want to explicitely - exclude individual packages in the #excludedFromPreRequisites method." + "list packages which are a prerequisite, because they contain + classes which are referenced by my classes. + We do not need these packages as a prerequisite for loading or compiling. + This method is generated automatically, + by searching all classes (and their packages) which are referenced by my classes." ^ #( - #'stx:goodies/petitparser' "PPParserResource - referenced by PPCompositeParserTest class>>resources " ) ! @@ -75,30 +88,32 @@ ^ #( " or ( attributes...) in load order" + (PPAbstractParseTest autoload) (PPAbstractParserTest autoload) + (PPArithmeticParser autoload) + PPContextMementoTest + PPContextTest + (PPLambdaParser autoload) + (PPParserResource autoload) #'stx_goodies_petitparser_tests' + (PPComposedTest autoload) (PPCompositeParserTest autoload) - (PPAbstractParseTest autoload) - (PPArithmeticParserTest autoload) - (PPComposedTest autoload) (PPExtensionTest autoload) - (PPLambdaParserTest autoload) + (PPMappingTest autoload) (PPObjectTest autoload) - (PPParserResource autoload) (PPParserTest autoload) (PPPredicateTest autoload) (PPScriptingTest autoload) (PPTokenTest autoload) + (PPArithmeticParserTest autoload) + (PPLambdaParserTest autoload) (PPExpressionParserTest autoload) - (PPMappingTest autoload) - (PPArithmeticParser autoload) - (PPLambdaParser autoload) ) ! extensionMethodNames - "lists the extension methods which are to be included in the project. - Entries are 2-element array literals, consisting of class-name and selector." + "list class/selector pairs of extensions. + A correponding method with real names must be present in my concrete subclasses" ^ #( ) diff -r a2656b27cace -r 6112a403a52d tests/tests.rc --- a/tests/tests.rc Fri Oct 03 01:59:10 2014 +0100 +++ b/tests/tests.rc Fri Oct 03 02:33:08 2014 +0100 @@ -25,7 +25,7 @@ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0" VALUE "ProductName", "Smalltalk/X\0" VALUE "ProductVersion", "6.2.4.0\0" - VALUE "ProductDate", "Fri, 03 Oct 2014 00:58:04 GMT\0" + VALUE "ProductDate", "Fri, 03 Oct 2014 01:32:32 GMT\0" END END