# HG changeset patch # User Claus Gittinger # Date 1530509949 -7200 # Node ID 87aecdeb7820e766e33400cc30a3f5621ad5a55f # Parent 1a13f890993622a1105de4b3a9482b53652b3ff0 removed container diff -r 1a13f8909936 -r 87aecdeb7820 PPPredicateTest.st --- 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 $' -! ! -