--- a/PPPredicateTest.st Mon Jul 02 07:39:04 2018 +0200
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,313 +0,0 @@
-"{ 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 $'
-! !
-