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

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


!PPPredicateTest methodsFor:'private'!

charactersDo: aBlock
	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 equals: block.
	self assert: parser message equals: '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 |
	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'.
	self assert: parser fail: (String with: Character 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 |
	parser := #cr asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: (String with: (Character codePoint: 13)) to: (Character codePoint: 13)
!

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

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.
	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 |
	parser := #newline asParser.
	self assertCharacterSets: parser.
	self assert: parser parse: (String with: Character cr) to: Character 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'
!

testStartOfLine
	| parser |
	parser := #startOfLine asParser, #any asParser star.
	
	self assert: parser parse: 'lorem ipsum'.
	
	parser := #any asParser, #startOfLine asParser, #any asParser star.
	self assert: parser fail: 'lorem ipsum'.
	
	parser := #startOfLine asParser, #any asParser, #startOfLine asParser, #any asParser star.
	self assert: parser parse: String cr, 'lorem ipsum'.
	self assert: parser parse: String lf, 'lorem ipsum'.	
	self assert: parser fail: String crlf, 'lorem ipsum'.	
	
	self assert: parser fail: String crlf.
	self assert: parser parse: String cr.
	self assert: parser parse: String lf.
	
	parser := #startOfLine asParser, #any asParser, #any asParser, #startOfLine asParser, #any asParser star.
	self assert: parser parse: String crlf, 'lorem ipsum'.
	self assert: parser parse: String crlf.
!

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 equals: 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 equals: 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 := String new writeStream.
	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_HG

    ^ '$Changeset: <not expanded> $'
!

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