Merged PetitParser and PetitTests
Name: PetitParser-JanKurs.253
Author: JanKurs
Time: 30-10-2014, 03:55:46 AM
UUID: c7100f9c-e875-4453-8f26-e0c91dd49b91
Name: PetitTests-JanKurs.63
Author: JanKurs
Time: 30-10-2014, 12:54:37 PM
UUID: 7afbeef7-eadf-4d65-bce5-7204e2727edb
--- a/Make.proto Sat Nov 01 00:34:30 2014 +0000
+++ b/Make.proto Mon Nov 03 09:10:56 2014 +0000
@@ -71,7 +71,7 @@
mcz: mc
$(TOP)/projects/smalltalk/smalltalk --eval " \
- Smalltalk packagePath add:'$(TOP)' . \
+ Smalltalk packagePath add:'$(TOP)/..' . \
Smalltalk loadPackage:'stx:goodies/petitparser'. \
(Smalltalk at: #'stx_goodies_petitparser') exportAsMczTo: 'mc'."
--- a/PPContext.st Sat Nov 01 00:34:30 2014 +0000
+++ b/PPContext.st Mon Nov 03 09:10:56 2014 +0000
@@ -17,6 +17,8 @@
yourself
! !
+
+
!PPContext methodsFor:'accessing-globals'!
globalAt: aKey
@@ -219,6 +221,10 @@
^ stream contents
!
+isEndOfLine
+ ^ stream isEndOfLine
+!
+
isStartOfLine
^ stream isStartOfLine
!
--- a/PPMemento.st Sat Nov 01 00:34:30 2014 +0000
+++ b/PPMemento.st Mon Nov 03 09:10:56 2014 +0000
@@ -61,6 +61,11 @@
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPMemento.st,v 1.3 2012-05-04 22:00:45 vrany Exp $'
!
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+!
+
version_SVN
^ '§Id: PPMemento.st 2 2010-12-17 18:44:23Z vranyj1 §'
! !
--- a/PPPredicateObjectParser.st Sat Nov 01 00:34:30 2014 +0000
+++ b/PPPredicateObjectParser.st Mon Nov 03 09:10:56 2014 +0000
@@ -20,7 +20,7 @@
startOfLine
- ^ PPStartOfLine new.
+ ^ PPStartOfLineParser new.
! !
!PPPredicateObjectParser class methodsFor:'factory-chars'!
@@ -42,9 +42,7 @@
!
cr
- ^ self char: (Character codePoint: 13) message: 'carriage return expected'
-
- "Modified: / 03-10-2014 / 23:56:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ ^ self char: (Character codePoint: 13) message: 'carriage return expected'
!
digit
@@ -65,7 +63,7 @@
!
lf
- ^ self char: Character lf
+ ^ self char: (Character codePoint: 10)
!
lowercase
@@ -73,9 +71,7 @@
!
newline
- ^ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected'
-
- "Modified: / 03-10-2014 / 23:56:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ ^ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected'
!
punctuation
@@ -124,6 +120,11 @@
negated: [ :each | each < min or: [ each > max ] ] message: min printString , '..' , max printString , ' not expected'
!
+endOfLine
+
+ ^ PPEndOfLineParser new.
+!
+
expect: anObject
^ self expect: anObject message: anObject printString , ' expected'
!
@@ -134,6 +135,7 @@
negated: [ :each | each ~= anObject ] message: 'no ' , aString
! !
+
!PPPredicateObjectParser methodsFor:'initialization'!
initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
--- a/PPStream.st Sat Nov 01 00:34:30 2014 +0000
+++ b/PPStream.st Mon Nov 03 09:10:56 2014 +0000
@@ -8,6 +8,7 @@
!
+
!PPStream methodsFor:'accessing'!
collection
@@ -38,6 +39,14 @@
position := anInteger
!
+size
+ "
+ The same implementation as a ReadStream. Implemented here for compatibility with Smalltalk/X
+ that has different implementation in a ReadStream
+ "
+ ^readLimit
+!
+
uncheckedPeek
"An unchecked version of peek that throws an error if we try to peek over the end of the stream, even faster than #peek."
@@ -64,29 +73,23 @@
!PPStream methodsFor:'queries'!
insideCRLF
- (position < 1) ifTrue: [ ^ false ].
-
- ^ (self peek = (Character codePoint: 10)) and: [ self peekBack = (Character codePoint: 13) ]
+ (position < 1) ifTrue: [ ^ false ].
+
+ ^ (self peek = (Character codePoint: 10)) and: [ self peekBack = (Character codePoint: 13) ]
+!
- "Modified: / 03-10-2014 / 23:52:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+isEndOfLine
+ self atEnd ifTrue: [ ^ true ].
+ self insideCRLF ifTrue: [ ^ false ].
+ ^ (self peek = (Character codePoint: 13) or: [ self peek = (Character codePoint: 10)]).
!
isStartOfLine
- (position = 0) ifTrue: [ ^ true ].
-
- self insideCRLF ifTrue: [ ^ false ].
-
- ^ (self peekBack = (Character codePoint: 13)) or: [ self peekBack = (Character codePoint: 10)].
+ (position = 0) ifTrue: [ ^ true ].
- "Modified: / 03-10-2014 / 23:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-size
- ^ readLimit
- "DO NOT REMOVE this method event though in Pharo it is the same as
- inherited. This is required for Smalltalk/X compatibility"
-
- "Created: / 08-10-2014 / 12:25:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ self insideCRLF ifTrue: [ ^ false ].
+
+ ^ (self peekBack = (Character codePoint: 13)) or: [ self peekBack = (Character codePoint: 10)].
! !
!PPStream class methodsFor:'documentation'!
--- a/PPToken.st Sat Nov 01 00:34:30 2014 +0000
+++ b/PPToken.st Mon Nov 03 09:10:56 2014 +0000
@@ -11,15 +11,11 @@
!PPToken class methodsFor:'initialization'!
initialize
- "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple."
-
- | cr lf |
-
- cr := Character codePoint: 13.
- lf := Character codePoint: 10.
- NewLineParser := lf asParser / (cr asParser , lf asParser optional)
-
- "Modified: / 04-10-2014 / 00:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple."
+ | cr lf |
+ cr := Character codePoint: 13.
+ lf := Character codePoint: 10.
+ NewLineParser := lf asParser / (cr asParser , lf asParser optional)
! !
!PPToken class methodsFor:'instance creation'!
@@ -45,6 +41,16 @@
value: anObject
! !
+!PPToken methodsFor:'*petitcompiler'!
+
+= anObject
+ ^ self class = anObject class and: [ self inputValue = anObject inputValue ]
+!
+
+hash
+ ^ self inputValue hash
+! !
+
!PPToken methodsFor:'accessing'!
collection
@@ -90,16 +96,6 @@
^ self inputValue
! !
-!PPToken methodsFor:'comparing'!
-
-= anObject
- ^ self class = anObject class and: [ self parsedValue = anObject parsedValue ]
-!
-
-hash
- ^ self parsedValue hash
-! !
-
!PPToken methodsFor:'copying'!
copyFrom: aStartInteger to: aStopInteger
--- a/analyzer/analyzer.rc Sat Nov 01 00:34:30 2014 +0000
+++ b/analyzer/analyzer.rc Mon Nov 03 09:10:56 2014 +0000
@@ -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", "Tue, 14 Oct 2014 22:14:26 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Nov 2014 09:07:04 GMT\0"
END
END
--- a/analyzer/stx_goodies_petitparser_analyzer.st Sat Nov 01 00:34:30 2014 +0000
+++ b/analyzer/stx_goodies_petitparser_analyzer.st Mon Nov 03 09:10:56 2014 +0000
@@ -68,7 +68,7 @@
^ #(
#'stx:goodies/petitparser' "PPActionParser - extended"
- #'stx:libbasic' "LibraryDefinition - extended"
+ #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_analyzer"
)
!
--- a/analyzer/tests/stx_goodies_petitparser_analyzer_tests.st Sat Nov 01 00:34:30 2014 +0000
+++ b/analyzer/tests/stx_goodies_petitparser_analyzer_tests.st Mon Nov 03 09:10:56 2014 +0000
@@ -14,14 +14,14 @@
"The last merged version is: "
^ '
- Name: PetitAnalyzer-DiegoLont.46
- Author: DiegoLont
- Time: 02-09-2013, 12:37:58 PM
- UUID: 89f155fa-89b4-4bb7-b76e-0f8485be4a56
- Repository: http://smalltalkhub.com/mc/Moose/PetitParser/main
+ Name: PetitAnalyzer-JanKurs.48
+ Author: JanKurs
+ Time: 30-10-2014, 12:53:26 PM
+ UUID: 13464ded-5457-4b5b-ba2f-b4ab7dcec782
'
"Created: / 03-10-2014 / 02:40:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-11-2014 / 09:00:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
monticelloName
--- a/analyzer/tests/tests.rc Sat Nov 01 00:34:30 2014 +0000
+++ b/analyzer/tests/tests.rc Mon Nov 03 09:10:56 2014 +0000
@@ -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", "Tue, 14 Oct 2014 22:14:29 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Nov 2014 09:07:05 GMT\0"
END
END
--- a/compiler/PPCAnyNode.st Sat Nov 01 00:34:30 2014 +0000
+++ b/compiler/PPCAnyNode.st Mon Nov 03 09:10:56 2014 +0000
@@ -7,6 +7,7 @@
category:'PetitCompiler-Nodes'
!
+
!PPCAnyNode methodsFor:'as yet unclassified'!
acceptsEpsilon
@@ -34,3 +35,10 @@
^ #any
! !
+!PPCAnyNode class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/compiler.rc Sat Nov 01 00:34:30 2014 +0000
+++ b/compiler/compiler.rc Mon Nov 03 09:10:56 2014 +0000
@@ -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", "Sun, 26 Oct 2014 22:46:23 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Nov 2014 09:07:00 GMT\0"
END
END
--- a/compiler/tests/PPCNodeTest.st Sat Nov 01 00:34:30 2014 +0000
+++ b/compiler/tests/PPCNodeTest.st Mon Nov 03 09:10:56 2014 +0000
@@ -7,6 +7,7 @@
category:'PetitCompiler-Tests-Nodes'
!
+
!PPCNodeTest methodsFor:'as yet unclassified'!
testCopy
@@ -200,3 +201,10 @@
self assert: tree acceptsEpsilon.
! !
+!PPCNodeTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/tests/abbrev.stc Sat Nov 01 00:34:30 2014 +0000
+++ b/compiler/tests/abbrev.stc Mon Nov 03 09:10:56 2014 +0000
@@ -5,10 +5,10 @@
PPCContextTest PPCContextTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Context' 1
PPCGuardTest PPCGuardTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
PPCMockCompiler PPCMockCompiler stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 0
+PPCNodeCompilingTest PPCNodeCompilingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCNodeTest PPCNodeTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCOptimizingTest PPCOptimizingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCompiledSmalltalkGrammarResource PPCompiledSmalltalkGrammarResource stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Smalltalk' 1
-stx_goodies_petitparser_compiler_tests stx_goodies_petitparser_compiler_tests stx:goodies/petitparser/compiler/tests '* Projects & Packages *' 3
-PPCNodeCompilingTest PPCNodeCompilingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCompiledSmalltalkGrammarTests PPCompiledSmalltalkGrammarTests stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Smalltalk' 1
PetitCompilerTest PetitCompilerTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
+stx_goodies_petitparser_compiler_tests stx_goodies_petitparser_compiler_tests stx:goodies/petitparser/compiler/tests '* Projects & Packages *' 3
--- a/compiler/tests/stx_goodies_petitparser_compiler_tests.st Sat Nov 01 00:34:30 2014 +0000
+++ b/compiler/tests/stx_goodies_petitparser_compiler_tests.st Mon Nov 03 09:10:56 2014 +0000
@@ -57,7 +57,7 @@
^ #(
#'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of PPCNodeCompilingTest"
#'stx:goodies/sunit' "TestAsserter - superclass of PPCContextMementoTest"
- #'stx:libbasic' "Autoload - superclass of PPCNodeCompilingTest"
+ #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_compiler_tests"
)
!
@@ -99,13 +99,13 @@
PPCContextTest
PPCGuardTest
PPCMockCompiler
+ (PPCNodeCompilingTest autoload)
PPCNodeTest
PPCOptimizingTest
PPCompiledSmalltalkGrammarResource
- #'stx_goodies_petitparser_compiler_tests'
- (PPCNodeCompilingTest autoload)
(PPCompiledSmalltalkGrammarTests autoload)
(PetitCompilerTest autoload)
+ #'stx_goodies_petitparser_compiler_tests'
)
!
--- a/compiler/tests/tests.rc Sat Nov 01 00:34:30 2014 +0000
+++ b/compiler/tests/tests.rc Mon Nov 03 09:10:56 2014 +0000
@@ -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", "Thu, 30 Oct 2014 23:34:44 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Nov 2014 09:07:02 GMT\0"
END
END
--- a/extensions.st Sat Nov 01 00:34:30 2014 +0000
+++ b/extensions.st Mon Nov 03 09:10:56 2014 +0000
@@ -38,16 +38,35 @@
^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])
! !
+!Collection methodsFor:'*petitparser-converting'!
+
+asParser
+ "Create a range of characters between start and stop."
+
+ (self allSatisfy: [ :e | e isCharacter ]) ifTrue: [
+ | charSet |
+ charSet := PPCharSetPredicate on: [ :char | self includes: char ] .
+ ^ PPPredicateObjectParser on: charSet message: 'One of these charactes expected: ', self printString.
+ ].
+
+
+ ^ super asParser
+ "
+ ($a to:$f) asParser parse:'a'
+ ($a to:$f) asParser parse:'g'
+ "
+! !
+
!Collection methodsFor:'*petitparser-core-converting'!
asSequenceParser
^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])
! !
-!Interval methodsFor:'*petitparser-converting'!
+!Interval methodsFor:'*petitparser-core-converting'!
-asParser
- "Create a range of characters between start and stop."
+asParser
+ "Create a range of characters between start and stop."
self assert:start isCharacter.
self assert:stop isCharacter.
@@ -55,9 +74,11 @@
^ PPPredicateObjectParser between: start and: stop
"
- ($a to:$f) asParser parse:'a'
- ($a to:$f) asParser parse:'g'
+ ($a to: $f) asParser parse: 'a'
+ ($a to: $f) asParser parse: 'g'
"
+
+ "Modified (comment): / 01-11-2014 / 13:13:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object methodsFor:'*petitparser-core-converting'!
@@ -83,14 +104,11 @@
!PositionableStream methodsFor:'*petitparser-core-converting'!
asPetitStream
- "Some of my subclasses do not use the instance-variables collection, position and readLimit but instead have a completely different internal representation. In these cases just use the super implementation that is inefficient but should work in all cases."
+ "Some of my subclasses do not use the instance-variables collection, position and readLimit but instead have a completely different internal representation. In these cases just use the super implementation that is inefficient but should work in all cases."
- ^ (collection isNil or: [ position isNil or: [ readLimit isNil ] ])
- ifFalse: [ PPStream on: collection from: ( position + 1 ) to: readLimit ]
- ifTrue: [ super asPetitStream ]
-
- "Modified: / 18-12-2010 / 17:38:01 / Jan Kurs <kurs.jan@post.cz>"
- "Modified: / 04-10-2014 / 23:27:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ ^ (collection isNil or: [ position isNil or: [ readLimit isNil ] ])
+ ifFalse: [ PPStream on: collection from: ( position + 1 ) to: readLimit ]
+ ifTrue: [ super asPetitStream ]
! !
!PositionableStream methodsFor:'*petitparser-core'!
@@ -109,12 +127,6 @@
!SequenceableCollection methodsFor:'*petitparser-core-converting'!
-asParser
- ^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])
-! !
-
-!SequenceableCollection methodsFor:'*petitparser-core-converting'!
-
asPetitStream
^ PPStream on: self
! !
--- a/islands/islands.rc Sat Nov 01 00:34:30 2014 +0000
+++ b/islands/islands.rc Mon Nov 03 09:10:56 2014 +0000
@@ -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", "Tue, 14 Oct 2014 22:14:20 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Nov 2014 09:06:55 GMT\0"
END
END
--- a/islands/stx_goodies_petitparser_islands.st Sat Nov 01 00:34:30 2014 +0000
+++ b/islands/stx_goodies_petitparser_islands.st Mon Nov 03 09:10:56 2014 +0000
@@ -118,8 +118,6 @@
PPMemoizingIsland
(RobustXmlFeedParser autoload)
)
-
- "Modified: / 08-10-2014 / 00:30:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
extensionMethodNames
--- a/islands/tests/stx_goodies_petitparser_islands_tests.st Sat Nov 01 00:34:30 2014 +0000
+++ b/islands/tests/stx_goodies_petitparser_islands_tests.st Mon Nov 03 09:10:56 2014 +0000
@@ -101,8 +101,6 @@
#'stx_goodies_petitparser_islands_tests'
(PPMemoizingIslandTest autoload)
)
-
- "Modified: / 08-10-2014 / 00:27:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
extensionMethodNames
--- a/islands/tests/tests.rc Sat Nov 01 00:34:30 2014 +0000
+++ b/islands/tests/tests.rc Mon Nov 03 09:10:56 2014 +0000
@@ -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", "Tue, 14 Oct 2014 22:14:22 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Nov 2014 09:06:56 GMT\0"
END
END
--- a/petitparser.rc Sat Nov 01 00:34:30 2014 +0000
+++ b/petitparser.rc Mon Nov 03 09:10:56 2014 +0000
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "(C) Lukas Renggli\0"
VALUE "ProductName", "Petit Parser\0"
VALUE "ProductVersion", "6.2.4.0\0"
- VALUE "ProductDate", "Tue, 14 Oct 2014 22:14:18 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Nov 2014 09:06:53 GMT\0"
END
END
--- a/stx_goodies_petitparser.st Sat Nov 01 00:34:30 2014 +0000
+++ b/stx_goodies_petitparser.st Mon Nov 03 09:10:56 2014 +0000
@@ -30,14 +30,15 @@
"The last merged version is: "
^ '
- Name: PetitParser-JanKurs.250
+ Name: PetitParser-JanKurs.253
Author: JanKurs
- Time: 01-10-2014, 04:44:04 AM
- UUID: c46eea20-51a0-4deb-8fd5-8cb99810a8b4
+ Time: 30-10-2014, 03:55:46 AM
+ UUID: c7100f9c-e875-4453-8f26-e0c91dd49b91
Repository: http://smalltalkhub.com/mc/Moose/PetitParser/main
'
"Created: / 03-10-2014 / 02:27:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-11-2014 / 08:27:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
monticelloName
@@ -126,7 +127,7 @@
mcz: mc
$(TOP)/projects/smalltalk/smalltalk --eval " \
- Smalltalk packagePath add:''$(TOP)'' . \
+ Smalltalk packagePath add:''$(TOP)/..'' . \
Smalltalk loadPackage:''stx:goodies/petitparser''. \
(Smalltalk at: #''stx_goodies_petitparser'') exportAsMczTo: ''mc''."
@@ -205,7 +206,6 @@
Object isPetitFailure
Object isPetitParser
PositionableStream asPetitStream
- SequenceableCollection asParser
SequenceableCollection asPetitStream
Set asParser
Stream asPetitStream
@@ -294,11 +294,16 @@
'stx:goodies/petitparser/tests'
'stx:goodies/petitparser/analyzer'
'stx:goodies/petitparser/analyzer/tests'
+ 'stx:goodies/petitparser/parsers/smalltalk'
+ 'stx:goodies/petitparser/parsers/smalltalk/tests'
+ 'stx:goodies/petitparser/compiler'
+ 'stx:goodies/petitparser/compiler/tests'
).
exporter := [:pkgnm|
| mcpkg mcwc mcvi mcversion |
+ Stdout nextPutAll: 'Exporting '; nextPutLine: pkgnm.
Smalltalk loadPackage: pkgnm.
mcpkg := MCPackage named: pkgnm.
mcwc := mcpkg workingCopy.
--- a/tests/PPExtensionTest.st Sat Nov 01 00:34:30 2014 +0000
+++ b/tests/PPExtensionTest.st Mon Nov 03 09:10:56 2014 +0000
@@ -71,14 +71,12 @@
!
testRange
- | parser |
- parser := (Interval from: $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'
-
- "Modified: / 05-10-2014 / 00:02:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | 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'
!
testSequence
--- a/tests/PPParserTest.st Sat Nov 01 00:34:30 2014 +0000
+++ b/tests/PPParserTest.st Mon Nov 03 09:10:56 2014 +0000
@@ -931,23 +931,21 @@
!
testPrint
- | parser |
- parser := PPParser new.
- self assert: (parser printString includesSubstring: 'PPParser').
-
- parser := PPParser named: 'choice'.
- self assert: (parser printString includesSubstring: 'PPParser(choice').
-
- parser := PPLiteralObjectParser on: $a.
- self assert: (parser printString includesSubstring: $a printString).
-
- parser := PPFailingParser message: 'error'.
- self assert: (parser printString includesSubstring: 'error').
-
- parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'.
- self assert: (parser printString includesSubstring: 'error')
-
- "Modified: / 03-10-2014 / 23:43:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | parser |
+ parser := PPParser new.
+ self assert: (parser printString includesSubstring: 'PPParser').
+
+ parser := PPParser named: 'choice'.
+ self assert: (parser printString includesSubstring: 'PPParser(choice').
+
+ parser := PPLiteralObjectParser on: $a.
+ self assert: (parser printString includesSubstring: $a printString).
+
+ parser := PPFailingParser message: 'error'.
+ self assert: (parser printString includesSubstring: 'error').
+
+ parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'.
+ self assert: (parser printString includesSubstring: 'error')
! !
!PPParserTest methodsFor:'testing-fixtures'!
@@ -1454,20 +1452,18 @@
!
testParse
- | parser result |
- parser := $a asParser.
- self assert: (parser parse: 'a') equals: $a.
- self assert: (result := parser parse: 'b') isPetitFailure.
- self assert: (result message includesSubstring: $a printString).
- 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 includesSubstring: $a printString).
- self assert: (result message includesSubstring: 'expected').
- self assert: result position equals: 0
-
- "Modified: / 03-10-2014 / 23:42:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | parser result |
+ parser := $a asParser.
+ self assert: (parser parse: 'a') equals: $a.
+ self assert: (result := parser parse: 'b') isPetitFailure.
+ self assert: (result message includesSubstring: $a printString).
+ 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 includesSubstring: $a printString).
+ self assert: (result message includesSubstring: 'expected').
+ self assert: result position equals: 0
!
testParseOnError0
@@ -1481,39 +1477,35 @@
!
testParseOnError1
- | parser result seen |
- parser := $a asParser.
- result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
- self assert: result equals: $a.
- result := parser
- parse: 'b'
- onError: [ :failure |
- self assert: failure position equals: 0.
- self assert: (failure message includesSubstring: $a printString).
- self assert: (failure message includesSubstring: 'expected').
- seen := true ].
- self assert: result.
- self assert: seen
-
- "Modified: / 03-10-2014 / 23:42:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | parser result seen |
+ parser := $a asParser.
+ result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+ self assert: result equals: $a.
+ result := parser
+ parse: 'b'
+ onError: [ :failure |
+ self assert: failure position equals: 0.
+ self assert: (failure message includesSubstring: $a printString).
+ self assert: (failure message includesSubstring: 'expected').
+ seen := true ].
+ self assert: result.
+ self assert: seen
!
testParseOnError2
- | parser result seen |
- parser := $a asParser.
- result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
- self assert: result equals: $a.
- result := parser
- parse: 'b'
- onError: [ :msg :pos |
- self assert: (msg includesSubstring: $a printString).
- self assert: (msg includesSubstring: 'expected').
- self assert: pos equals: 0.
- seen := true ].
- self assert: result.
- self assert: seen
-
- "Modified: / 03-10-2014 / 23:42:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | parser result seen |
+ parser := $a asParser.
+ result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+ self assert: result equals: $a.
+ result := parser
+ parse: 'b'
+ onError: [ :msg :pos |
+ self assert: (msg includesSubstring: $a printString).
+ self assert: (msg includesSubstring: 'expected').
+ self assert: pos equals: 0.
+ seen := true ].
+ self assert: result.
+ self assert: seen
!
testParser
--- a/tests/PPPredicateTest.st Sat Nov 01 00:34:30 2014 +0000
+++ b/tests/PPPredicateTest.st Mon Nov 03 09:10:56 2014 +0000
@@ -59,12 +59,10 @@
!
testCr
- | parser |
- parser := #cr asParser.
- self assertCharacterSets: parser.
- self assert: parser parse: (String with: (Character codePoint: 13)) to: (Character codePoint: 13)
-
- "Modified: / 04-10-2014 / 12:03:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | parser |
+ parser := #cr asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: (String with: (Character codePoint: 13)) to: (Character codePoint: 13)
!
testDigit
@@ -77,6 +75,31 @@
self assert: parser fail: 'a'
!
+testEndOfLine
+ | parser |
+ parser := (#letter asParser / #blank asParser) star, #endOfLine asParser.
+
+ self assert: parser parse: 'lorem ipsum'.
+
+ parser := #any asParser, #endOfLine asParser, #any asParser star.
+ self assert: parser parse: 'a', String cr, 'b'.
+ self assert: parser fail: String crlf.
+ self assert: parser fail: 'lorem ipsum'.
+
+ parser := #endOfLine asParser, #any asParser, #endOfLine asParser negate star, #endOfLine asParser.
+ self assert: parser parse: String cr, 'lorem ipsum'.
+ self assert: parser parse: String lf, 'lorem ipsum'.
+ self assert: parser parse: String crlf, 'lorem ipsum'.
+
+ self assert: parser parse: String crlf.
+ self assert: parser parse: String cr.
+ self assert: parser parse: String lf.
+
+ parser := #endOfLine asParser negate star, #endOfLine asParser, #any asParser star.
+ self assert: parser parse: String crlf, 'lorem ipsum'.
+ self assert: parser parse: String crlf.
+!
+
testHex
| parser |
parser := #hex asParser.
@@ -299,19 +322,12 @@
!
parsedCharacterSet: aParser
- | result |
-
- ((Smalltalk respondsTo: #isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
- result := String new writeStream
- ] ifFalse:[
- result := WriteStream on: String new.
- ].
- self charactersDo: [ :char |
- (aParser matches: (char asString))
- ifTrue: [ result nextPut: char ] ].
- ^ result contents
-
- "Modified: / 03-10-2014 / 03:01:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | result |
+ result := String new writeStream.
+ self charactersDo: [ :char |
+ (aParser matches: (String with: char))
+ ifTrue: [ result nextPut: char ] ].
+ ^ result contents
! !
!PPPredicateTest class methodsFor:'documentation'!
--- a/tests/PPScriptingTest.st Sat Nov 01 00:34:30 2014 +0000
+++ b/tests/PPScriptingTest.st Mon Nov 03 09:10:56 2014 +0000
@@ -14,74 +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 := (Interval from: $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
-
- "Modified: / 05-10-2014 / 00:02:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "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
!
expressionParser
- "Simple demo of scripting an expression parser."
-
- | mul prim add dec |
- add := PPUnresolvedParser new.
- mul := PPUnresolvedParser new.
- prim := PPUnresolvedParser new.
- dec := (Interval from: $0 to: $9) asParser.
- add def: (mul , $+ asParser , add)
- / mul.
- mul def: (prim , $* asParser , mul)
- / prim.
- prim def: ($( asParser , add , $) asParser)
- / dec.
- ^ add end
-
- "Modified: / 05-10-2014 / 00:03:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "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
!
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 := (Interval from: $a to: $z) asParser.
- upper := (Interval from: $A to: $Z) asParser.
- char := lower / upper.
- nonzero := (Interval from: $1 to: $9) asParser.
- dec := (Interval from: $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 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 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
-
- "Modified: / 05-10-2014 / 00:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ 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 Sat Nov 01 00:34:30 2014 +0000
+++ b/tests/PPTokenTest.st Mon Nov 03 09:10:56 2014 +0000
@@ -89,25 +89,21 @@
!PPTokenTest methodsFor:'testing-querying'!
testColumn
- | input parser result |
- input := '1' , (String with: (Character codePoint: 13)) , '12' , (String with: (Character codePoint: 13) with: (Character codePoint: 10)) , '123'
- , (String with: (Character codePoint: 10)) , '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 ]
-
- "Modified: / 03-10-2014 / 23:53:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | input parser result |
+ input := '1' , (String with: (Character codePoint: 13)) , '12' , (String with: (Character codePoint: 13) with: (Character codePoint: 10)) , '123'
+ , (String with: (Character codePoint: 10)) , '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 |
- input := '1' , (String with: (Character codePoint: 13)) , '12' , (String with:(Character codePoint: 13) with: (Character codePoint: 10)) , '123'
- , (String with: (Character codePoint: 10)) , '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 ]
-
- "Modified: / 03-10-2014 / 23:54:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ | input parser result |
+ input := '1' , (String with: (Character codePoint: 13)) , '12' , (String with: (Character codePoint: 13) with: (Character codePoint: 10)) , '123'
+ , (String with: (Character codePoint: 10)) , '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'!
--- a/tests/stx_goodies_petitparser_tests.st Sat Nov 01 00:34:30 2014 +0000
+++ b/tests/stx_goodies_petitparser_tests.st Mon Nov 03 09:10:56 2014 +0000
@@ -14,14 +14,15 @@
"The last merged version is: "
^ '
- Name: PetitTests-JanKurs.60
+ Name: PetitTests-JanKurs.63
Author: JanKurs
- Time: 29-09-2014, 11:48:10 AM
- UUID: 28fd2e65-c287-4f73-b71e-5b6bb25bebaa
+ Time: 30-10-2014, 12:54:37 PM
+ UUID: 7afbeef7-eadf-4d65-bce5-7204e2727edb
Repository: http://smalltalkhub.com/mc/Moose/PetitParser/main
'
"Created: / 03-10-2014 / 02:28:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-11-2014 / 08:26:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
monticelloName
@@ -52,7 +53,7 @@
^ #(
#'stx:goodies/petitparser' "PPCompositeParser - superclass of PPArithmeticParser"
- #'stx:goodies/sunit' "TestAsserter - superclass of PPAbstractParseTest"
+ #'stx:goodies/sunit' "TestAsserter - superclass of PPAbstractParserTest"
#'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_tests"
)
!
--- a/tests/tests.rc Sat Nov 01 00:34:30 2014 +0000
+++ b/tests/tests.rc Mon Nov 03 09:10:56 2014 +0000
@@ -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", "Sat, 01 Nov 2014 00:33:33 GMT\0"
+ VALUE "ProductDate", "Mon, 03 Nov 2014 09:06:58 GMT\0"
END
END