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
--- 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)
--- 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) \
--- 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 ]
! !
--- 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
! !
--- 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 §'
! !
+
--- /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
+! !
+
--- /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 <jan.vrany@fit.cvut.cz>"
+!
+
+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.
+! !
+
--- 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'!
--- 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 §'
! !
+
--- 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'!
--- 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 §'
! !
+
--- 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'!
--- 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'!
--- 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
--- 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
! !
--- 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'!
--- 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'!
--- 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 §'
! !
+
--- 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 §'
! !
+
--- 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 §'
! !
+
--- 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 §'
! !
+
--- 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 ]
! !
--- 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
--- 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
! !
--- 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
--- 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'!
--- 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'!
--- 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
--- /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
+! !
+
--- 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
--- 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'!
--- 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 §'
! !
+
--- 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 §'
! !
+
--- 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
--- 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)"
--- 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
--- 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) "
--- 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:
--- 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)
--- 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);
--- 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
--- 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 <jan.vrany@fit.cvut.cz>"
+!
+
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 @@
^ #(
"<className> or (<className> 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
--- 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
--- 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) \
--- 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
! !
--- 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.
--- 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.
--- /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).
+! !
+
--- /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.
+! !
+
--- 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'!
--- 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
!
--- 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.
--- 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: <not expanded> $'
+!
+
version_SVN
^ '$Id: PPParserTest.st,v 1.4 2014-03-04 14:34:21 cg Exp $'
! !
--- 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'.
--- 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'!
--- 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'!
--- 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
--- 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
--- 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);
--- 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 <jan.vrany@fit.cvut.cz>"
+!
+
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 @@
^ #(
"<className> or (<className> 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"
^ #(
)
--- 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