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

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 PPAbstractParserTest subclass:#PPCProtype1Test

     6 	instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3

     7 		arguments configuration'

     8 	classVariableNames:''

     9 	poolDictionaries:''

    10 	category:'PetitCompiler-Tests-Core'

    11 !

    12 

    13 !PPCProtype1Test methodsFor:'context'!

    14 

    15 context	

    16 	^ context := PPCProfilingContext new

    17 ! !

    18 

    19 !PPCProtype1Test methodsFor:'test support'!

    20 

    21 assert: p parse: whatever

    22 	^ result := super assert: p parse: whatever.

    23 !

    24 

    25 parse: whatever

    26 	^ result := super parse: whatever.

    27 !

    28 

    29 tearDown

    30 	| parserClass |

    31 

    32 	parserClass := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).

    33 	parserClass notNil ifTrue:[ 

    34 		parserClass removeFromSystem

    35 	].

    36 ! !

    37 

    38 !PPCProtype1Test methodsFor:'tests - compiling'!

    39 

    40 testCompileAnd

    41 	parser := #digit asParser and compileWithConfiguration: configuration.

    42 	

    43 	self assert: parser parse: '1' to: $1 end: 0.

    44 	self assert: parser fail: 'a'.

    45 	self assert: parser fail: ''.

    46 

    47 	parser := ('foo' asParser, ($: asParser and)) compile.

    48 	self assert: parser parse: 'foo:' to: { 'foo'. $: } end: 3.

    49 !

    50 

    51 testCompileAny

    52 	parser := #any asParser compile.

    53 	

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

    55 	self assert: parser parse: '_' to: $_.

    56 	self assert: parser parse: '

    57 ' to: Character cr.

    58 !

    59 

    60 testCompileAnyStar

    61 	parser := #any asParser star compileWithConfiguration: configuration.

    62 	

    63 	

    64 	self assert: parser parse: 'aaa' to: { $a. $a . $a }.

    65 	self assert: context invocationCount = 1.

    66 	self assert: parser parse: '' to: { }.	

    67 !

    68 

    69 testCompileBlock

    70 	parser := (#letter asParser) plus ==> [ :res | res collect: [:each | each asUppercase ]].

    71 	parser := parser compileWithConfiguration: configuration.

    72 	

    73 	self assert: parser parse: 'foo' to: { $F . $O . $O}.

    74 	self assert: parser parse: 'bar' to: { $B . $A . $R}.

    75 	self assert: parser fail: ''.

    76 !

    77 

    78 testCompileCharacter

    79 	parser := $a asParser compileWithConfiguration: configuration.

    80 	

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

    82 	self assert: parser fail: 'b'.

    83 

    84 	parser := $# asParser compileWithConfiguration: configuration.

    85 	self assert: parser parse: '#'.

    86 !

    87 

    88 testCompileChoice

    89 	parser := (#digit asParser / #letter asParser) compileWithConfiguration: configuration.

    90 	

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

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

    93 	self assert: parser fail: '_'.

    94 	

    95 !

    96 

    97 testCompileChoice2

    98 	parser := ('true' asParser / 'false' asParser) compileWithConfiguration: configuration.

    99 	

   100 	self assert: parser parse: 'true' to: 'true'.

   101 	self assert: parser parse: 'false' to: 'false'.

   102 	self assert: parser fail: 'trulse'.

   103 	

   104 !

   105 

   106 testCompileLiteral

   107 	parser := 'foo' asParser compileWithConfiguration: configuration.

   108 	

   109 	self assert: parser parse: 'foo'  to: 'foo'.

   110 	self assert: parser parse: 'foobar'  to: 'foo' end: 3.

   111 	self assert: parser fail: 'boo'.

   112 	

   113 	parser := '#[' asParser compile.

   114 	self assert: parser parse: '#[1]' to: '#[' end: 2.

   115 !

   116 

   117 testCompileLiteral2

   118 	| quote |

   119 	quote := '''' asParser.

   120 	parser := (quote, $a asParser ) compileWithConfiguration: configuration.	

   121 	self assert: parser parse: '''a'  to: {'''' . $a}.	

   122 !

   123 

   124 testCompileNegate

   125 	parser := #letter asParser negate star, #letter asParser.

   126 	parser := parser compileWithConfiguration: configuration.

   127 	

   128 	self assert: parser parse: '...a' to: { { $. . $. . $. } . $a }.

   129 	self assert: parser parse: 'aaa' to: { {} . $a } end: 1.

   130 	self assert: parser fail: '...'.

   131 !

   132 

   133 testCompileNil

   134 	parser := nil asParser compileWithConfiguration: configuration.

   135 	

   136 	self assert: parser parse: 'a' to: nil end: 0.

   137 	self assert: parser parse: '' to: nil end: 0.

   138 	

   139 	parser := nil asParser, 'foo' asParser.

   140 	self assert: parser parse: 'foo' to: { nil . 'foo' }

   141 !

   142 

   143 testCompileNot

   144 	parser := #digit asParser not compileWithConfiguration: configuration.

   145 	

   146 	self assert: parser parse: 'a' to: nil end: 0.

   147 	self assert: parser fail: '1'.

   148 	self assert: parser parse: '' to: nil end: 0.

   149 

   150 	parser := 'foo' asParser, $: asParser not.

   151 	parser := parser compileWithConfiguration: configuration.	

   152 	self assert: parser parse: 'foo' to: { 'foo'. nil } end: 3.

   153 	

   154 	parser := 'foo' asParser, $: asParser not, 'bar' asParser.

   155 	parser := parser compileWithConfiguration: configuration.	

   156 	self assert: parser parse: 'foobar' to: { 'foo'. nil . 'bar' } end: 6.

   157 !

   158 

   159 testCompileNot2

   160 	parser := ($a asParser, $b asParser) not compileWithConfiguration: configuration.

   161 		

   162 	self assert: parser parse: '' to: nil end: 0.

   163 	self assert: parser parse: 'a' to: nil end: 0.

   164 	self assert: parser parse: 'aa' to: nil end: 0.

   165 	self assert: parser fail: 'ab'.

   166 !

   167 

   168 testCompileNot3

   169 	parser := ('foo' asParser not, 'fee' asParser) compileWithConfiguration: configuration.

   170 		

   171 	self assert: parser parse: 'fee' to: #(nil 'fee').

   172 	self assert: parser fail: 'foo'.

   173 !

   174 

   175 testCompileNotLiteral

   176 	parser := 'foo' asParser not compileWithConfiguration: configuration.

   177 	self assert: parser class methodDictionary size = 1.

   178 

   179 	self assert: parser parse: 'bar' to: nil end: 0.

   180 		

   181 	self assert: parser fail: 'foo'.

   182 	self assert: parser parse: '' to: nil end: 0.

   183 

   184 	parser := '''' asParser not compile.

   185 	self assert: parser class methodDictionary size = 1.

   186 

   187 	self assert: parser parse: 'a' to: nil end: 0.

   188 	self assert: parser fail: ''''.

   189 	self assert: parser parse: '' to: nil end: 0.

   190 

   191 

   192 	parser := ('foo' asParser, 'bar' asParser not) compile.

   193 	self assert: parser parse: 'foofoo' to: { 'foo'. nil } end: 3.

   194 	

   195 	parser := ('foo' asParser, 'foo' asParser not, #any asParser star) compile.

   196 	self assert: parser parse: 'foobar' to: { 'foo'. nil . #($b $a $r) } end: 6.

   197 	self assert: parser fail: 'foofoo'.

   198 !

   199 

   200 testCompileOptional

   201 	parser := #digit asParser optional compileWithConfiguration: configuration.

   202 	

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

   204 	self assert: parser parse: 'a' to: nil end: 0.

   205 	

   206 	parser := (#digit asParser optional, #letter asParser) compile.

   207 	self assert: parser parse: '1a' to: { $1 . $a }.

   208 	self assert: parser parse: 'a' to: { nil . $a }.

   209 !

   210 

   211 testCompilePlus

   212 	parser := #letter asParser plus compileWithConfiguration: configuration.

   213 	

   214 	self assert: parser parse: 'lorem' to: {$l. $o. $r. $e. $m} .

   215 	self assert: parser parse: 'a123' to: {$a} end: 1.

   216 	self assert: parser parse: 'ab123' to: {$a . $b} end: 2.

   217 

   218 	self assert: parser fail: ''.

   219 	self assert: parser fail: '123'.

   220 !

   221 

   222 testCompilePredicate

   223 	parser := #digit asParser compileWithConfiguration: configuration.

   224 	

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

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

   227 	self assert: parser fail: 'a'.

   228 !

   229 

   230 testCompilePredicate2

   231 	parser := #space asParser compileWithConfiguration: configuration.

   232 	

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

   234 	self assert: parser fail: 'a'.

   235 !

   236 

   237 testCompileSequence

   238 	parser := (#digit asParser, #letter asParser) compileWithConfiguration: configuration.

   239 	

   240 	self assert: parser parse: '1a' to: {$1 .$a}.

   241 	

   242 	

   243 !

   244 

   245 testCompileSequence2

   246 	parser := (#digit asParser, #space asParser, #letter asParser) compileWithConfiguration: configuration.

   247 	

   248 	self assert: parser parse: '9 c' to: {$9 . Character space. $c }.	

   249 	self assert: parser fail: '9c'.

   250 	

   251 !

   252 

   253 testCompileSequence3

   254 	parser := (#any asParser, #any asParser, #any asParser) compileWithConfiguration: configuration.

   255 	

   256 	self assert: parser parse: 'foo' to: #($f $o $o).	

   257 	self assert: parser fail: 'fo'.

   258 	

   259 !

   260 

   261 testCompileStar

   262 	parser := #letter asParser star compileWithConfiguration: configuration.

   263 	

   264 	self assert: parser parse: 'lorem' to: {$l. $o. $r. $e. $m} .

   265 	self assert: parser parse: '' to: {}.

   266 	self assert: parser parse: '123' to: {} end: 0.

   267 	self assert: parser parse: 'ab123' to: {$a . $b} end: 2.

   268 !

   269 

   270 testCompileStarLiteral

   271 	parser := 'foo' asParser star compileWithConfiguration: configuration.

   272 	

   273 	self assert: parser parse: 'foo' to: #('foo' ) .

   274 	self assert: parser parse: 'foofoo' to: #('foo' 'foo') .

   275 	self assert: parser parse: 'foofoofoo' to: #('foo' 'foo' 'foo') .

   276 	self assert: parser parse: '' to: #().

   277 	self assert: parser parse: 'bar' to: #() end: 0.

   278 !

   279 

   280 testCompileStarPredicate

   281 	parser := #letter asParser star compileWithConfiguration: configuration.

   282 	

   283 	self assert: parser parse: 'foo' to: #($f $o $o ) .

   284 	self assert: parser parse: '' to: #().

   285 	self assert: parser parse: '123' to: #() end: 0.

   286 !

   287 

   288 testCompileSymbolBlock

   289 	parser := (#letter asParser) plus ==> #second.

   290 	parser := parser compileWithConfiguration: configuration.

   291 	

   292 	self assert: parser parse: 'foo' to: $o.

   293 	self assert: parser parse: 'bar' to: $a.

   294 	self assert: parser fail: ''.

   295 	self should: [ parser parse: 'f' ] raise: Error.

   296 !

   297 

   298 testCompileTrim

   299 	parser := $a asParser trim compileWithConfiguration: configuration.

   300 	

   301 	self assert: parser fail: ''.

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

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

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

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

   306 !

   307 

   308 testCompileTrimmingToken

   309 	| token1 token2 |

   310 	token1 := (#letter asParser) plus trimmingToken.

   311 	token2 := (#letter asParser) plus trimmingToken.

   312 	

   313 	parser := (token1, token2) compileWithConfiguration: configuration.

   314 	

   315 	self assert: parser parse: 'foo bar'.

   316 	self assert: parser parse: ' foo bar '.

   317 !

   318 

   319 testCompileTrimmingToken2

   320 	| token1 token2 |

   321 	token1 := (#letter asParser) plus trimmingToken.

   322 	token2 := (#letter asParser) plus trimmingToken / 'foo' asParser trimmingToken.

   323 	

   324 	parser := (token1, token2) compileWithConfiguration: configuration.

   325 	

   326 	self assert: parser parse: 'foo bar'.

   327 	self assert: parser parse: ' foo bar '.

   328 !

   329 

   330 testCompileTrimmingToken3

   331 	| token1 token2 |

   332 	token1 := ($a asParser, $b asParser) trimmingToken name: 'token1'.

   333 	token2 := (token1 not, $c asParser) trimmingToken name: 'token2'.

   334 	

   335 	parser := (token1 / token2) compileWithConfiguration: configuration.

   336 

   337 	self assert: (parser class methodDictionary includesKey: #'token1').

   338 	self assert: (parser class methodDictionary includesKey: #'token1_fast').

   339 	

   340 	self assert: parser parse: 'ab'.

   341 	self assert: (result isKindOf: PPToken).

   342 	self assert: result inputValue = 'ab'.

   343 

   344 	self assert: parser parse: 'c'.

   345 	self assert: (result isKindOf: PPToken).

   346 	self assert: result inputValue = 'c'.

   347 	

   348 ! !

   349 

   350 !PPCProtype1Test methodsFor:'tests - extra'!

   351 

   352 testCompileSmalltalkToken

   353 	parser := (#letter asParser, ((#letter asParser / #digit asParser) star)) smalltalkToken compileWithConfiguration: configuration.

   354 	

   355 	self assert: parser parse: 'foo'.

   356 	self assert: result inputValue = 'foo'.

   357 	self assert: parser parse: 'a'.

   358 	self assert: result inputValue = 'a'.

   359 	self assert: parser parse: 'f123a'.

   360 	self assert: result inputValue = 'f123a'.

   361 	

   362 	self assert: parser fail: ''.

   363 	self assert: parser fail: '12'.

   364 

   365 	self assert: parser parse: ' "comment" foo'.

   366 	self assert: result inputValue = 'foo'.

   367 	

   368 	self assert: parser parse: ' "comment" bar "another comment" '.

   369 	self assert: result inputValue = 'bar'.

   370 	self assert: parser parse: '

   371 		"b"

   372 		"b"

   373 		foo

   374 		"and yet, another comment"

   375 

   376 		"one more to make sure :)"

   377 	'.

   378 	self assert: result inputValue = 'foo'.

   379 !

   380 

   381 testCycle

   382 	| p1 block |

   383 	

   384 	p1 := PPDelegateParser new.

   385 	block := ${ asParser, p1, $} asParser / nil asParser.

   386 	p1 setParser: block.

   387 	

   388 	parser := block compileWithConfiguration: configuration.

   389 	self assert: parser parse: '{}' to: { ${. nil . $} }.

   390 	self assert: parser parse: '{{}}' to: { ${. { ${ . nil . $} } . $} }.

   391 	

   392 !

   393 

   394 testSmalltalkToken

   395 	parser := (#letter asParser, (#digit asParser / #letter asParser) star) smalltalkToken compileWithConfiguration: configuration.

   396 	

   397 	self assert: parser class methodDictionary size = 5.

   398 	self assert: parser parse: 'foo'.

   399 	self assert: result inputValue = 'foo'.

   400 	self assert: context invocationCount = 8.

   401 	self assert: context rememberCount = 0.

   402 	self assert: context lwRememberCount = 1.

   403 	self assert: context lwRestoreCount = 0.	

   404 !

   405 

   406 testSmalltalkToken2

   407 	id := (#letter asParser, (#digit asParser / #letter asParser) star)

   408 		name: 'identifier';

   409 		yourself.

   410 		

   411 	parser := (id wrapped, $: asParser) smalltalkToken 

   412 		name: 'kw';

   413 		yourself.

   414 	

   415 	parser := parser compileWithConfiguration: configuration.

   416 	

   417 	self assert: parser parse: 'foo:'.

   418 	self assert: result inputValue = 'foo:'.

   419 !

   420 

   421 testToken

   422 	parser := (#letter asParser, (#digit asParser / #letter asParser) star) flatten compileWithConfiguration: configuration.

   423 	

   424 	self assert: parser parse: 'foo' to: 'foo'.

   425 	self assert: parser parse: 'a' to: 'a'.

   426 	self assert: parser parse: 'f123a' to: 'f123a'.

   427 	self assert: parser fail: ''.

   428 !

   429 

   430 testToken2

   431 	parser := (#letter asParser, (#digit asParser / #letter asParser) star) token compileWithConfiguration: configuration.

   432 	

   433 	self assert: parser class methodDictionary size = 4.

   434 	self assert: parser parse: 'foo'.

   435 	self assert: result inputValue = 'foo'.

   436 	self assert: context invocationCount = 6.

   437 	self assert: context rememberCount = 0.

   438 	self assert: context lwRememberCount = 1.

   439 	self assert: context lwRestoreCount = 0.	

   440 !

   441 

   442 testTrimmingToken

   443 	parser := (#letter asParser, (#digit asParser / #letter asParser) star) trimmingToken compileWithConfiguration: configuration.

   444 

   445 	self assert: parser class methodDictionary size = 4.

   446 

   447 	self assert: parser parse: 'foo'.

   448 	self assert: result inputValue = 'foo'.

   449 

   450 	self assert: context invocationCount = 6.

   451 	self assert: context rememberCount = 0.

   452 	self assert: context lwRememberCount = 1.

   453 	self assert: context lwRestoreCount = 0.	

   454 

   455 	self assert: parser parse: ' foo '.

   456 	self assert: result inputValue = 'foo'.

   457 

   458 

   459 

   460 	self assert: parser fail: '123'.

   461 

   462 	self assert: context invocationCount = 1.

   463 	self assert: context rememberCount = 0.

   464 	self assert: context lwRememberCount = 0.

   465 	self assert: context lwRestoreCount = 0.	

   466 

   467 

   468 	self assert: parser fail: ''.

   469 !

   470 

   471 testTrimmingTokenNested

   472 	| identifier kw |

   473 	kw := 'false' asParser trimmingToken name: #kw.

   474 	identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.

   475 	

   476 	parser := identifier / kw.

   477 	parser := parser compileWithConfiguration: configuration.

   478 	self assert: parser class methodDictionary size = 5.

   479 

   480 	self assert: parser parse: 'foo'.

   481 	self assert: result inputValue = 'foo'.

   482 

   483 	self assert: parser parse: 'false'.

   484 	self assert: result inputValue = 'false'.

   485 !

   486 

   487 testTrimmingTokenNested2

   488 	| identifier kw |

   489 	kw := 'false' asParser trimmingToken name: #kw.

   490 	identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.

   491 	

   492 	parser := identifier / kw.

   493 	parser := parser compileWithConfiguration: configuration.

   494 	self assert: parser class methodDictionary size = 5.

   495 

   496 	self assert: parser parse: 'foo'.

   497 	self assert: result inputValue = 'foo'.

   498 

   499 	self assert: parser parse: 'false'.

   500 	self assert: result inputValue = 'false'.

   501 !

   502 

   503 testTrimmingTokenNested3

   504 	| identifier kw |

   505 	kw := ('false' asParser, #word asParser not) trimmingToken name: #kw.

   506 	identifier := (kw not, (#letter asParser, #word asParser star)) trimmingToken name: #identifier.

   507 	

   508 	parser := identifier / kw.

   509 	parser := parser compileWithConfiguration: configuration.

   510 	self assert: parser class methodDictionary size = 8.

   511 	self assert: (parser class methods anySatisfy: [ :m | m selector = #kw ]).

   512 	self assert: (parser class methods anySatisfy: [ :m | m selector = #kw_fast ]).

   513 

   514 	self assert: parser parse: 'foo'.

   515 	self assert: result inputValue = 'foo'.

   516 

   517 	self assert: parser parse: 'false'.

   518 	self assert: result inputValue = 'false'.

   519 ! !

   520 

   521 !PPCProtype1Test methodsFor:'tests - ids'!

   522 

   523 setUp

   524 	arguments := PPCArguments default

   525 		profile: true;

   526 		yourself.

   527 		

   528 	configuration := PPCFirstPrototype new

   529 		arguments: arguments;

   530 		yourself.

   531 ! !

   532