"{ 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

!

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 |

	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

! !

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

! !