initial checkin draft
authorClaus Gittinger <cg@exept.de>
Mon, 02 Jul 2018 07:39:04 +0200
changeset 572 1a13f8909936
parent 571 e2d486a27959
child 573 87aecdeb7820
initial checkin
tests/PPPredicateTest.st
--- /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$'
+! !
+