tests/PPPredicateTest.st
author sr
Wed, 04 Jul 2018 15:30:19 +0200
changeset 611 38338f2de417
parent 572 1a13f8909936
permissions -rw-r--r--
build order was wrong
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
572
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:goodies/petitparser/tests' }"
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ NameSpace: Smalltalk }"
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
PPAbstractParserTest subclass:#PPPredicateTest
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	instanceVariableNames:''
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	classVariableNames:''
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	poolDictionaries:''
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	category:'PetitTests-Tests'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
!PPPredicateTest methodsFor:'private'!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
charactersDo: aBlock
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
    "cg: isn't 256 one too many?"
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
    Smalltalk isSmalltalkX ifTrue:[
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
        0 to: 255 do: [ :index | aBlock value: (Character codePoint: index) ]
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
    ] ifFalse:[
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
        1 to: 256 do: [ :index | aBlock value: (Character codePoint: index) ]
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
    ].
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
! !
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
!PPPredicateTest methodsFor:'testing'!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
testOnMessage
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
	| block parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
	block := [ :char | char = $* ].
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
	parser := PPPredicateObjectParser on: block message: 'starlet'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
	self assert: parser block = block.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
	self assert: parser message = 'starlet'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
	
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
	self assert: parser parse: '*' to: $*.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
	self assert: parser parse: '**' to: $* end: 1.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
	self assert: parser fail: '1'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
	self assert: parser fail: 'a'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
! !
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
!PPPredicateTest methodsFor:'testing-chars'!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
testBlank
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
        | parser cr|
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
        parser := #blank asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
        self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
        self assert: parser parse: (String with: Character space) to: Character space.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
        self assert: parser parse: (String with: Character tab) to: Character tab.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
        self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
        self assert: parser fail: '1'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
        cr := Smalltalk isSmalltalkX 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
            ifTrue:[Character return] 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
            ifFalse:[Character cr].
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
        self assert: parser fail: (String with: cr)
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
testChar
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
	parser := $* asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
	self assert: parser parse: '*' to: $*.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
	self assert: parser parse: '**' to: $* end: 1.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
	self assert: parser fail: '1'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
	self assert: parser fail: 'a'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
testCr
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
        | parser cr |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
        cr := Smalltalk isSmalltalkX 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
                ifTrue:[Character return] 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
                ifFalse:[Character cr].
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
        parser := #cr asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
        self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
        self assert: parser parse: (String with: cr) to: cr
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
testDigit
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
	parser := #digit asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
	self assert: parser parse: '0' to: $0.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
	self assert: parser parse: '9' to: $9.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
	self assert: parser fail: 'a'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
testHex
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
	parser := #hex asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
	self assert: parser parse: '0' to: $0.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
	self assert: parser parse: '5' to: $5.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
	self assert: parser parse: '9' to: $9.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
	self assert: parser parse: 'A' to: $A.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
	self assert: parser parse: 'D' to: $D.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
	self assert: parser parse: 'F' to: $F.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
	self assert: parser parse: 'a' to: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
	self assert: parser parse: 'e' to: $e.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
	self assert: parser parse: 'f' to: $f.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
	self assert: parser fail: 'g'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
testLetter
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
	parser := #letter asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   111
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
	self assert: parser parse: 'a' to: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
	self assert: parser parse: 'Z' to: $Z.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
	self assert: parser fail: '0'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
testLf
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
	parser := #lf asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
	self assert: parser parse: (String with: Character lf) to: Character lf
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
testLowercase
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
	parser := #lowercase asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
	self assert: parser parse: 'a' to: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
	self assert: parser parse: 'z' to: $z.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
	self assert: parser fail: 'A'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
	self assert: parser fail: '0'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
testNewline
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
        | parser cr|
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
        cr := Smalltalk isSmalltalkX 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
                ifTrue:[Character return] 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
                ifFalse:[Character cr].
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
        parser := #newline asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
        self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
        self assert: parser parse: (String with: cr) to: cr.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
        self assert: parser parse: (String with: Character lf) to: Character lf.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
        self assert: parser fail: ' '
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
testPunctuation
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
	parser := #punctuation asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
	self assert: parser parse: '.' to: $..
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
	self assert: parser parse: ',' to: $,.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
	self assert: parser fail: 'a'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
	self assert: parser fail: '1'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
testSpace
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
	parser := #space asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
	self assert: parser parse: (String with: Character tab) to: Character tab.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
	self assert: parser parse: ' ' to: Character space.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
	self assert: parser fail: 'a'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
testTab
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
	parser := #tab asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
	self assert: parser parse: (String with: Character tab) to: Character tab
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
testUppercase
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
	parser := #uppercase asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
	self assert: parser parse: 'A' to: $A.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
	self assert: parser parse: 'Z' to: $Z.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
	self assert: parser fail: 'a'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
	self assert: parser fail: '0'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
testWord
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
	parser := #word asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
	self assert: parser parse: 'a' to: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
	self assert: parser parse: 'A' to: $A.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
	self assert: parser parse: '0' to: $0.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
	self assert: parser fail: ''.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
	self assert: parser fail: '-'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
! !
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
!PPPredicateTest methodsFor:'testing-objects'!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
testAny
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
	parser := #any asParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
	self assert: parser parse: ' ' to: $ .
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
	self assert: parser parse: '1' to: $1.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
	self assert: parser parse: 'a' to: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
	self assert: parser fail: ''
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   209
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
testAnyExceptAnyOf
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
	parser := PPPredicateObjectParser anyExceptAnyOf: #($: $,).
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
	self assert: parser parse: 'a' to: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
	self assert: parser parse: 'z' to: $z.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
	self assert: parser fail: ':'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
	self assert: parser fail: ','
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
testAnyOf
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
	parser := PPPredicateObjectParser anyOf: #($a $z).
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
	self assert: parser parse: 'a' to: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
	self assert: parser parse: 'z' to: $z.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
	self assert: parser fail: 'x'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
testBetweenAnd
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
	parser := PPPredicateObjectParser between: $b and: $d.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
	self assert: parser fail: 'a'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
	self assert: parser parse: 'b' to: $b.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
	self assert: parser parse: 'c' to: $c.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
	self assert: parser parse: 'd' to: $d.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
	self assert: parser fail: 'e'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
testExpect
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
	parser := PPPredicateObjectParser expect: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
	self assertCharacterSets: parser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
	self assert: parser parse: 'a' to: $a.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
	self assert: parser fail: 'b'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
	self assert: parser fail: ''
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
! !
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
!PPPredicateTest methodsFor:'testing-sequence'!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
testSequenceParser
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
	| parser |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
	parser := PPPredicateSequenceParser 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
		on: [ :value | value first isUppercase ] 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
		message: 'uppercase 3 letter words'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
		size: 3.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
	self assert: parser size = 3.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
	self assert: parser parse: 'Abc'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
	self assert: parser parse: 'ABc'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
	self assert: parser parse: 'ABC'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
	self assert: parser fail: 'abc'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
	self assert: parser fail: 'aBC'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
	self assert: parser fail: 'Ab'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
	
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
	parser := parser negate.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
	self assert: parser size = 3.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
	self assert: parser fail: 'Abc'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
	self assert: parser fail: 'ABc'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
	self assert: parser fail: 'ABC'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
	self assert: parser parse: 'abc'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
	self assert: parser parse: 'aBC'.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
	self assert: parser fail: 'Ab'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   273
! !
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   274
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
!PPPredicateTest methodsFor:'utilities'!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   276
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   277
assertCharacterSets: aParser
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
	"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."
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
	| positives negatives |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   281
	positives := self parsedCharacterSet: aParser.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   282
	negatives := self parsedCharacterSet: aParser negate.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
	self charactersDo: [ :char | 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
		| positive negative |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   285
		positive := positives includes: char.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
		negative := negatives includes: char.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
		self 
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
			assert: ((positive and: [ negative not ])
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
				or: [ positive not and: [ negative ] ])
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
			description: char printString , ' should be in exactly one set' ]
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
parsedCharacterSet: aParser
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
	| result |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
	result := WriteStream on: String new.
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
	self charactersDo: [ :char |
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
		(aParser matches: (String with: char))
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
			ifTrue: [ result nextPut: char ] ].
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
	^ result contents
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
! !
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
!PPPredicateTest class methodsFor:'documentation'!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
version
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
    ^ '$Header$'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
!
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
version_CVS
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
    ^ '$Header$'
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
! !
1a13f8909936 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311