"{ 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.
        "We don't use $ before character sign in ST/X"
        self assert: (result message includesSubString: '(').
"/        self assert: (result message includesSubString: '$(').
        self assert: (result message includesSubString: 'expected').
        self assert: (result position = 0).

        beenHere := false.
        result := self parserClass
                parse: '\x.'
                onError: [ :msg :pos | 
                        "We don't use $ before character sign in ST/X"
                        self assert: (msg includesSubString: '(').
"/                        self assert: (msg includesSubString: '$(').
                        self assert: (msg includesSubString: 'expected').
                        self assert: (pos = 0).
                        beenHere := true ].
        self assert: result.
        self assert: beenHere

    "Modified: / 19-12-2010 / 16:52:33 / Jan Kurs <kurs.jan@post.cz>"
!

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.3 2012-05-04 22:05:16 vrany Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPLambdaParserTest.st,v 1.3 2012-05-04 22:05:16 vrany Exp $'
!

version_SVN
    ^ '§Id: PPLambdaParserTest.st 5 2010-12-19 17:38:27Z kursjan §'
! !