1 "{ Package: 'stx:goodies/petitparser/tests' }"

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 PPAbstractParserTest subclass:#PPPredicateTest

     6 	instanceVariableNames:''

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitTests-Tests'

    10 !

    11 

    12 

    13 !PPPredicateTest methodsFor:'private'!

    14 

    15 charactersDo: aBlock

    16     "cg: isn't 256 one too many?"

    17 

    18     Smalltalk isSmalltalkX ifTrue:[

    19         0 to: 255 do: [ :index | aBlock value: (Character codePoint: index) ]

    20     ] ifFalse:[

    21         1 to: 256 do: [ :index | aBlock value: (Character codePoint: index) ]

    22     ].

    23 ! !

    24 

    25 !PPPredicateTest methodsFor:'testing'!

    26 

    27 testOnMessage

    28 	| block parser |

    29 	block := [ :char | char = $* ].

    30 	parser := PPPredicateObjectParser on: block message: 'starlet'.

    31 	self assert: parser block = block.

    32 	self assert: parser message = 'starlet'.

    33 	

    34 	self assertCharacterSets: parser.

    35 	self assert: parser parse: '*' to: $*.

    36 	self assert: parser parse: '**' to: $* end: 1.

    37 	self assert: parser fail: ''.

    38 	self assert: parser fail: '1'.

    39 	self assert: parser fail: 'a'

    40 ! !

    41 

    42 !PPPredicateTest methodsFor:'testing-chars'!

    43 

    44 testBlank

    45         | parser cr|

    46         parser := #blank asParser.

    47         self assertCharacterSets: parser.

    48         self assert: parser parse: (String with: Character space) to: Character space.

    49         self assert: parser parse: (String with: Character tab) to: Character tab.

    50         self assert: parser fail: ''.

    51         self assert: parser fail: '1'.

    52         cr := Smalltalk isSmalltalkX 

    53             ifTrue:[Character return] 

    54             ifFalse:[Character cr].

    55         self assert: parser fail: (String with: cr)

    56 !

    57 

    58 testChar

    59 	| parser |

    60 	parser := $* asParser.

    61 	self assertCharacterSets: parser.

    62 	self assert: parser parse: '*' to: $*.

    63 	self assert: parser parse: '**' to: $* end: 1.

    64 	self assert: parser fail: ''.

    65 	self assert: parser fail: '1'.

    66 	self assert: parser fail: 'a'

    67 !

    68 

    69 testCr

    70         | parser cr |

    71 

    72         cr := Smalltalk isSmalltalkX 

    73                 ifTrue:[Character return] 

    74                 ifFalse:[Character cr].

    75 

    76         parser := #cr asParser.

    77         self assertCharacterSets: parser.

    78         self assert: parser parse: (String with: cr) to: cr

    79 !

    80 

    81 testDigit

    82 	| parser |

    83 	parser := #digit asParser.

    84 	self assertCharacterSets: parser.

    85 	self assert: parser parse: '0' to: $0.

    86 	self assert: parser parse: '9' to: $9.

    87 	self assert: parser fail: ''.

    88 	self assert: parser fail: 'a'

    89 !

    90 

    91 testHex

    92 	| parser |

    93 	parser := #hex asParser.

    94 	self assertCharacterSets: parser.

    95 	self assert: parser parse: '0' to: $0.

    96 	self assert: parser parse: '5' to: $5.

    97 	self assert: parser parse: '9' to: $9.

    98 	self assert: parser parse: 'A' to: $A.

    99 	self assert: parser parse: 'D' to: $D.

   100 	self assert: parser parse: 'F' to: $F.

   101 	self assert: parser parse: 'a' to: $a.

   102 	self assert: parser parse: 'e' to: $e.

   103 	self assert: parser parse: 'f' to: $f.

   104 	self assert: parser fail: ''.

   105 	self assert: parser fail: 'g'

   106 !

   107 

   108 testLetter

   109 	| parser |

   110 	parser := #letter asParser.

   111 	self assertCharacterSets: parser.

   112 	self assert: parser parse: 'a' to: $a.

   113 	self assert: parser parse: 'Z' to: $Z.

   114 	self assert: parser fail: ''.

   115 	self assert: parser fail: '0'

   116 !

   117 

   118 testLf

   119 	| parser |

   120 	parser := #lf asParser.

   121 	self assertCharacterSets: parser.

   122 	self assert: parser parse: (String with: Character lf) to: Character lf

   123 !

   124 

   125 testLowercase

   126 	| parser |

   127 	parser := #lowercase asParser.

   128 	self assertCharacterSets: parser.

   129 	self assert: parser parse: 'a' to: $a.

   130 	self assert: parser parse: 'z' to: $z.

   131 	self assert: parser fail: ''.

   132 	self assert: parser fail: 'A'.

   133 	self assert: parser fail: '0'

   134 !

   135 

   136 testNewline

   137         | parser cr|

   138         cr := Smalltalk isSmalltalkX 

   139                 ifTrue:[Character return] 

   140                 ifFalse:[Character cr].

   141         parser := #newline asParser.

   142         self assertCharacterSets: parser.

   143         self assert: parser parse: (String with: cr) to: cr.

   144         self assert: parser parse: (String with: Character lf) to: Character lf.

   145         self assert: parser fail: ' '

   146 !

   147 

   148 testPunctuation

   149 	| parser |

   150 	parser := #punctuation asParser.

   151 	self assertCharacterSets: parser.

   152 	self assert: parser parse: '.' to: $..

   153 	self assert: parser parse: ',' to: $,.

   154 	self assert: parser fail: ''.

   155 	self assert: parser fail: 'a'.

   156 	self assert: parser fail: '1'

   157 !

   158 

   159 testSpace

   160 	| parser |

   161 	parser := #space asParser.

   162 	self assertCharacterSets: parser.

   163 	self assert: parser parse: (String with: Character tab) to: Character tab.

   164 	self assert: parser parse: ' ' to: Character space.

   165 	self assert: parser fail: ''.

   166 	self assert: parser fail: 'a'

   167 !

   168 

   169 testTab

   170 	| parser |

   171 	parser := #tab asParser.

   172 	self assertCharacterSets: parser.

   173 	self assert: parser parse: (String with: Character tab) to: Character tab

   174 !

   175 

   176 testUppercase

   177 	| parser |

   178 	parser := #uppercase asParser.

   179 	self assertCharacterSets: parser.

   180 	self assert: parser parse: 'A' to: $A.

   181 	self assert: parser parse: 'Z' to: $Z.

   182 	self assert: parser fail: ''.

   183 	self assert: parser fail: 'a'.

   184 	self assert: parser fail: '0'

   185 !

   186 

   187 testWord

   188 	| parser |

   189 	parser := #word asParser.

   190 	self assertCharacterSets: parser.

   191 	self assert: parser parse: 'a' to: $a.

   192 	self assert: parser parse: 'A' to: $A.

   193 	self assert: parser parse: '0' to: $0.

   194 	self assert: parser fail: ''.

   195 	self assert: parser fail: '-'

   196 ! !

   197 

   198 !PPPredicateTest methodsFor:'testing-objects'!

   199 

   200 testAny

   201 	| parser |

   202 	parser := #any asParser.

   203 	self assertCharacterSets: parser.

   204 	self assert: parser parse: ' ' to: $ .

   205 	self assert: parser parse: '1' to: $1.

   206 	self assert: parser parse: 'a' to: $a.

   207 	self assert: parser fail: ''

   208 !

   209 

   210 testAnyExceptAnyOf

   211 	| parser |

   212 	parser := PPPredicateObjectParser anyExceptAnyOf: #($: $,).

   213 	self assertCharacterSets: parser.

   214 	self assert: parser parse: 'a' to: $a.

   215 	self assert: parser parse: 'z' to: $z.

   216 	self assert: parser fail: ':'.

   217 	self assert: parser fail: ','

   218 !

   219 

   220 testAnyOf

   221 	| parser |

   222 	parser := PPPredicateObjectParser anyOf: #($a $z).

   223 	self assertCharacterSets: parser.

   224 	self assert: parser parse: 'a' to: $a.

   225 	self assert: parser parse: 'z' to: $z.

   226 	self assert: parser fail: 'x'

   227 !

   228 

   229 testBetweenAnd

   230 	| parser |

   231 	parser := PPPredicateObjectParser between: $b and: $d.

   232 	self assertCharacterSets: parser.

   233 	self assert: parser fail: 'a'.

   234 	self assert: parser parse: 'b' to: $b.

   235 	self assert: parser parse: 'c' to: $c.

   236 	self assert: parser parse: 'd' to: $d.

   237 	self assert: parser fail: 'e'

   238 !

   239 

   240 testExpect

   241 	| parser |

   242 	parser := PPPredicateObjectParser expect: $a.

   243 	self assertCharacterSets: parser.

   244 	self assert: parser parse: 'a' to: $a.

   245 	self assert: parser fail: 'b'.

   246 	self assert: parser fail: ''

   247 ! !

   248 

   249 !PPPredicateTest methodsFor:'testing-sequence'!

   250 

   251 testSequenceParser

   252 	| parser |

   253 	parser := PPPredicateSequenceParser 

   254 		on: [ :value | value first isUppercase ] 

   255 		message: 'uppercase 3 letter words'

   256 		size: 3.

   257 	self assert: parser size = 3.

   258 	self assert: parser parse: 'Abc'.

   259 	self assert: parser parse: 'ABc'.

   260 	self assert: parser parse: 'ABC'.

   261 	self assert: parser fail: 'abc'.

   262 	self assert: parser fail: 'aBC'.

   263 	self assert: parser fail: 'Ab'.

   264 	

   265 	parser := parser negate.

   266 	self assert: parser size = 3.

   267 	self assert: parser fail: 'Abc'.

   268 	self assert: parser fail: 'ABc'.

   269 	self assert: parser fail: 'ABC'.

   270 	self assert: parser parse: 'abc'.

   271 	self assert: parser parse: 'aBC'.

   272 	self assert: parser fail: 'Ab'

   273 ! !

   274 

   275 !PPPredicateTest methodsFor:'utilities'!

   276 

   277 assertCharacterSets: aParser

   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."

   279 

   280 	| positives negatives |

   281 	positives := self parsedCharacterSet: aParser.

   282 	negatives := self parsedCharacterSet: aParser negate.

   283 	self charactersDo: [ :char | 

   284 		| positive negative |

   285 		positive := positives includes: char.

   286 		negative := negatives includes: char.

   287 		self 

   288 			assert: ((positive and: [ negative not ])

   289 				or: [ positive not and: [ negative ] ])

   290 			description: char printString , ' should be in exactly one set' ]

   291 !

   292 

   293 parsedCharacterSet: aParser

   294 	| result |

   295 	result := WriteStream on: String new.

   296 	self charactersDo: [ :char |

   297 		(aParser matches: (String with: char))

   298 			ifTrue: [ result nextPut: char ] ].

   299 	^ result contents

   300 ! !

   301 

   302 !PPPredicateTest class methodsFor:'documentation'!

   303 

   304 version

   305     ^ '$Header$'

   306 !

   307 

   308 version_CVS

   309     ^ '$Header$'

   310 ! !

   311