"{ Package: 'stx:goodies/petitparser' }"

PPAbstractParserTest subclass:#PPPredicateTest
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitTests-Tests'
!


!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) ]
    ].
! !

!PPPredicateTest methodsFor:'testing'!

testOnMessage
	| block parser |
	block := [ :char | char = $* ].
	parser := PPPredicateObjectParser on: block message: 'starlet'.
	self assert: parser block = block.
	self assert: parser message = 'starlet'.
	
	self assertCharacterSets: parser.
	self assert: parser parse: '*' to: $*.
	self assert: parser parse: '**' to: $* end: 1.
	self assert: parser fail: ''.
	self assert: parser fail: '1'.
	self assert: parser fail: 'a'
! !

!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)
!

testChar
	| parser |
	parser := $* asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: '*' to: $*.
	self assert: parser parse: '**' to: $* end: 1.
	self assert: parser fail: ''.
	self assert: parser fail: '1'.
	self assert: parser fail: 'a'
!

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
!

testDigit
	| parser |
	parser := #digit asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: '0' to: $0.
	self assert: parser parse: '9' to: $9.
	self assert: parser fail: ''.
	self assert: parser fail: 'a'
!

testHex
	| parser |
	parser := #hex asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: '0' to: $0.
	self assert: parser parse: '5' to: $5.
	self assert: parser parse: '9' to: $9.
	self assert: parser parse: 'A' to: $A.
	self assert: parser parse: 'D' to: $D.
	self assert: parser parse: 'F' to: $F.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'e' to: $e.
	self assert: parser parse: 'f' to: $f.
	self assert: parser fail: ''.
	self assert: parser fail: 'g'
!

testLetter
	| parser |
	parser := #letter asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'Z' to: $Z.
	self assert: parser fail: ''.
	self assert: parser fail: '0'
!

testLf
	| parser |
	parser := #lf asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: (String with: Character lf) to: Character lf
!

testLowercase
	| parser |
	parser := #lowercase asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'z' to: $z.
	self assert: parser fail: ''.
	self assert: parser fail: 'A'.
	self assert: parser fail: '0'
!

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: ' '
!

testPunctuation
	| parser |
	parser := #punctuation asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: '.' to: $..
	self assert: parser parse: ',' to: $,.
	self assert: parser fail: ''.
	self assert: parser fail: 'a'.
	self assert: parser fail: '1'
!

testSpace
	| parser |
	parser := #space asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: (String with: Character tab) to: Character tab.
	self assert: parser parse: ' ' to: Character space.
	self assert: parser fail: ''.
	self assert: parser fail: 'a'
!

testTab
	| parser |
	parser := #tab asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: (String with: Character tab) to: Character tab
!

testUppercase
	| parser |
	parser := #uppercase asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: 'A' to: $A.
	self assert: parser parse: 'Z' to: $Z.
	self assert: parser fail: ''.
	self assert: parser fail: 'a'.
	self assert: parser fail: '0'
!

testWord
	| parser |
	parser := #word asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'A' to: $A.
	self assert: parser parse: '0' to: $0.
	self assert: parser fail: ''.
	self assert: parser fail: '-'
! !

!PPPredicateTest methodsFor:'testing-objects'!

testAny
	| parser |
	parser := #any asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: ' ' to: $ .
	self assert: parser parse: '1' to: $1.
	self assert: parser parse: 'a' to: $a.
	self assert: parser fail: ''
!

testAnyExceptAnyOf
	| parser |
	parser := PPPredicateObjectParser anyExceptAnyOf: #($: $,).
	self assertCharacterSets: parser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'z' to: $z.
	self assert: parser fail: ':'.
	self assert: parser fail: ','
!

testAnyOf
	| parser |
	parser := PPPredicateObjectParser anyOf: #($a $z).
	self assertCharacterSets: parser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser parse: 'z' to: $z.
	self assert: parser fail: 'x'
!

testBetweenAnd
	| parser |
	parser := PPPredicateObjectParser between: $b and: $d.
	self assertCharacterSets: parser.
	self assert: parser fail: 'a'.
	self assert: parser parse: 'b' to: $b.
	self assert: parser parse: 'c' to: $c.
	self assert: parser parse: 'd' to: $d.
	self assert: parser fail: 'e'
!

testExpect
	| parser |
	parser := PPPredicateObjectParser expect: $a.
	self assertCharacterSets: parser.
	self assert: parser parse: 'a' to: $a.
	self assert: parser fail: 'b'.
	self assert: parser fail: ''
! !

!PPPredicateTest methodsFor:'testing-sequence'!

testSequenceParser
	| parser |
	parser := PPPredicateSequenceParser 
		on: [ :value | value first isUppercase ] 
		message: 'uppercase 3 letter words'
		size: 3.
	self assert: parser size = 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 fail: 'Abc'.
	self assert: parser fail: 'ABc'.
	self assert: parser fail: 'ABC'.
	self assert: parser parse: 'abc'.
	self assert: parser parse: 'aBC'.
	self assert: parser fail: 'Ab'
! !

!PPPredicateTest methodsFor:'utilities'!

assertCharacterSets: aParser
	"Assert the character set of aParser does not overlap with the character set with the negated parser, and that they both cover the complete character space."

	| positives negatives |
	positives := self parsedCharacterSet: aParser.
	negatives := self parsedCharacterSet: aParser negate.
	self charactersDo: [ :char | 
		| positive negative |
		positive := positives includes: char.
		negative := negatives includes: char.
		self 
			assert: ((positive and: [ negative not ])
				or: [ positive not and: [ negative ] ])
			description: char printString , ' should be in exactly one set' ]
!

parsedCharacterSet: aParser
	| result |
	result := WriteStream on: String new.
	self charactersDo: [ :char |
		(aParser matches: (String with: char))
			ifTrue: [ result nextPut: char ] ].
	^ result contents
! !

!PPPredicateTest class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateTest.st,v 1.6 2014-03-04 20:09:46 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateTest.st,v 1.6 2014-03-04 20:09:46 cg Exp $'
!

version_SVN
    ^ '$Id: PPPredicateTest.st,v 1.6 2014-03-04 20:09:46 cg Exp $'
! !