Mercurial Mercurial > hg > stx-goodies-petitparser / changeset
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | raw | zip | gz | bz2 | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Some tests fixed.
authorJan Vrany <jan.vrany@fit.cvut.cz>
Fri, 03 Oct 2014 03:11:33 +0100
changeset 379 451b5ae38b72
parent 378 53d66ecfeb1b
child 380 8fe3cb4e607f
Some tests fixed.
analyzer/analyzer.rc file | annotate | diff | comparison | revisions
extensions.st file | annotate | diff | comparison | revisions
petitparser.rc file | annotate | diff | comparison | revisions
stx_goodies_petitparser.st file | annotate | diff | comparison | revisions
tests/PPExtensionTest.st file | annotate | diff | comparison | revisions
tests/PPParserTest.st file | annotate | diff | comparison | revisions
tests/PPPredicateTest.st file | annotate | diff | comparison | revisions
tests/PPScriptingTest.st file | annotate | diff | comparison | revisions
tests/tests.rc file | annotate | diff | comparison | revisions 
--- a/analyzer/analyzer.rc	Fri Oct 03 02:45:16 2014 +0100
+++ b/analyzer/analyzer.rc	Fri Oct 03 03:11:33 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 01:43:52 GMT\0"
+      VALUE "ProductDate", "Fri, 03 Oct 2014 02:10:43 GMT\0"
     END
 
   END
--- a/extensions.st	Fri Oct 03 02:45:16 2014 +0100
+++ b/extensions.st	Fri Oct 03 03:11:33 2014 +0100
@@ -100,6 +100,20 @@
     "Modified: / 18-12-2010 / 17:38:01 / Jan Kurs <kurs.jan@post.cz>"
 ! !
 
+!PositionableStream methodsFor:'*petitparser-core'!
+
+peekTwice
+	"Answer what would be returned if the message next were sent to the 
+	receiver. If the receiver is at the end, answer nil."
+
+	| array |
+	self atEnd 
+		ifTrue: [^Array with: nil with: nil].
+	array := Array with: (self next) with: (self peek).
+	position := position - 1.
+	^array
+! !
+
 !SequenceableCollection methodsFor:'*petitparser-core-converting'!
 
 asParser
--- a/petitparser.rc	Fri Oct 03 02:45:16 2014 +0100
+++ b/petitparser.rc	Fri Oct 03 03:11:33 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 01:43:49 GMT\0"
+      VALUE "ProductDate", "Fri, 03 Oct 2014 02:10:40 GMT\0"
     END
 
   END
--- a/stx_goodies_petitparser.st	Fri Oct 03 02:45:16 2014 +0100
+++ b/stx_goodies_petitparser.st	Fri Oct 03 03:11:33 2014 +0100
@@ -195,6 +195,7 @@
         Symbol value:
         Text asPetitStream
         UndefinedObject asParser
+        PositionableStream peekTwice
     )
 ! !
 
--- a/tests/PPExtensionTest.st	Fri Oct 03 02:45:16 2014 +0100
+++ b/tests/PPExtensionTest.st	Fri Oct 03 03:11:33 2014 +0100
@@ -71,12 +71,14 @@
 !
 
 testRange
-	| 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'
+        | 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'
+
+    "Modified: / 03-10-2014 / 03:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 testSequence
--- a/tests/PPParserTest.st	Fri Oct 03 02:45:16 2014 +0100
+++ b/tests/PPParserTest.st	Fri Oct 03 03:11:33 2014 +0100
@@ -1452,18 +1452,20 @@
 !
 
 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').
-	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').
-	self assert: (result message includesSubstring: 'expected').
-	self assert: result position equals: 0
+        | 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').
+        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').
+        self assert: (result message includesSubstring: 'expected').
+        self assert: result position equals: 0
+
+    "Modified (format): / 03-10-2014 / 02:48:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 testParseOnError0
--- a/tests/PPPredicateTest.st	Fri Oct 03 02:45:16 2014 +0100
+++ b/tests/PPPredicateTest.st	Fri Oct 03 03:11:33 2014 +0100
@@ -297,12 +297,19 @@
 !
 
 parsedCharacterSet: aParser
-	| result |
-	result := WriteStream on: String new.
-	self charactersDo: [ :char |
-		(aParser matches: (String with: char))
-			ifTrue: [ result nextPut: char ] ].
-	^ result contents
+        | 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>"
 ! !
 
 !PPPredicateTest class methodsFor:'documentation'!
--- a/tests/PPScriptingTest.st	Fri Oct 03 02:45:16 2014 +0100
+++ b/tests/PPScriptingTest.st	Fri Oct 03 03:11:33 2014 +0100
@@ -14,68 +14,74 @@
 !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 - $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
+        "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
+
+    "Modified: / 03-10-2014 / 02:54:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 expressionParser
-	"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
+        "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
+
+    "Modified: / 03-10-2014 / 02:54:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 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 - $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 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
+        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: / 03-10-2014 / 02:56:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !PPScriptingTest methodsFor:'tests'!
--- a/tests/tests.rc	Fri Oct 03 02:45:16 2014 +0100
+++ b/tests/tests.rc	Fri Oct 03 03:11:33 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 01:43:50 GMT\0"
+      VALUE "ProductDate", "Fri, 03 Oct 2014 02:10:41 GMT\0"
     END
 
   END
hg/stx-goodies-petitparser