--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/PPPredicateTest.st Mon Jul 02 07:39:04 2018 +0200
@@ -0,0 +1,311 @@
+"{ Package: 'stx:goodies/petitparser/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+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$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+