tests/PPLambdaParserTest.st
changeset 375 e2b2f08d054e
parent 189 90b8d7cb0482
child 376 a2656b27cace
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/PPLambdaParserTest.st	Fri Oct 03 01:36:33 2014 +0100
@@ -0,0 +1,158 @@
+"{ Package: 'stx:goodies/petitparser' }"
+
+PPCompositeParserTest subclass:#PPLambdaParserTest
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitTests-Tests'
+!
+
+
+!PPLambdaParserTest methodsFor:'accessing'!
+
+parserClass
+	^ PPLambdaParser
+! !
+
+!PPLambdaParserTest methodsFor:'testing'!
+
+testAbstraction
+	self assert: '\x.y' is: #('x' 'y').
+	self assert: '\x.\y.z' is: #('x' ('y' 'z'))
+!
+
+testApplication
+	self assert: '(x x)' is: #('x' 'x').
+	self assert: '(x y)' is: #('x' 'y').
+	self assert: '((x y) z)' is: #(('x' 'y') 'z').
+	self assert: '(x (y z))' is: #('x' ('y' 'z'))
+!
+
+testVariable
+	self assert: 'x' is: 'x'.
+	self assert: 'xy' is: 'xy'.
+	self assert: 'x12' is: 'x12'
+! !
+
+!PPLambdaParserTest methodsFor:'testing-curch'!
+
+testAnd
+	self assert: self parserClass and = #('p' ('q' (('p' 'q') 'p')))
+!
+
+testFalse
+	self assert: self parserClass false = #('x' ('y' 'y'))
+!
+
+testIfThenElse
+	self assert: self parserClass ifthenelse = #('p' 'p')
+!
+
+testNot
+	self assert: self parserClass not = #('p' ('a' ('b' (('p' 'b') 'a'))))
+!
+
+testOr
+	self assert: self parserClass or = #('p' ('q' (('p' 'p') 'q')))
+!
+
+testTrue
+	self assert: self parserClass true = #('x' ('y' 'x'))
+! !
+
+!PPLambdaParserTest methodsFor:'testing-utilities'!
+
+testParseOnError
+	| beenHere |
+	result := self parserClass
+		parse: '\x.y'
+		onError: [ self fail ].
+	self assert: result = #('x' 'y').
+
+	beenHere := false.
+	result := self parserClass
+		parse: '\x.'
+		onError: [ beenHere := true ].
+	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).
+
+	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).
+			beenHere := true ].
+	self assert: result.
+	self assert: beenHere
+!
+
+testParseStartingAtOnError
+	| beenHere |
+	result := self parserClass
+		parse: 'x'
+		startingAt: #variable
+		onError: [ self fail ].
+	self assert: result = 'x'.
+	
+	beenHere := false.
+	result := self parserClass
+		parse: '\'
+		startingAt: #variable
+		onError: [ beenHere := true ].
+	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.
+
+	beenHere := false.
+	result := self parserClass
+		parse: '\'
+		startingAt: #variable
+		onError: [ :msg :pos | 
+			self assert: msg = 'letter expected'.
+			self assert: pos = 0.
+			beenHere := true ].
+	self assert: beenHere
+!
+
+testProductionAt
+	self assert: (parser productionAt: #foo) isNil.
+	self assert: (parser productionAt: #foo ifAbsent: [ true ]).
+	
+	self assert: (parser productionAt: #start) notNil.
+	self assert: (parser productionAt: #start ifAbsent: [ true ]) notNil.
+	
+	self assert: (parser productionAt: #variable) notNil.
+	self assert: (parser productionAt: #variable ifAbsent: [ true ]) notNil
+! !
+
+!PPLambdaParserTest class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPLambdaParserTest.st,v 1.4 2014-03-04 14:34:18 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPLambdaParserTest.st,v 1.4 2014-03-04 14:34:18 cg Exp $'
+!
+
+version_SVN
+    ^ '$Id: PPLambdaParserTest.st,v 1.4 2014-03-04 14:34:18 cg Exp $'
+! !
+