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

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 PPAbstractParserTest subclass:#PPCPrototype1Test

     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 !PPCPrototype1Test methodsFor:'context'!

    14 

    15 context	

    16     ^ context := PPCProfilingContext new

    17 ! !

    18 

    19 !PPCPrototype1Test 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: arguments name ifAbsent: [nil]).

    33     parserClass notNil ifTrue:[ 

    34         parserClass removeFromSystem

    35     ].

    36 ! !

    37 

    38 !PPCPrototype1Test 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 compileWithConfiguration: configuration.

   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 !PPCPrototype1Test 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 testTrimmingToken2

   472 

   473     parser := 'foo' asParser trimmingToken, 'bar' asParser trimmingToken

   474         compileWithConfiguration: configuration.

   475     

   476     self assert: parser parse: 'foobar'.

   477     self assert: result first inputValue = 'foo'.

   478     self assert: result second inputValue = 'bar'.	

   479     self assert: context invocationCount = 3.

   480 

   481     self assert: parser parse: ' foobar'.

   482     self assert: result first inputValue = 'foo'.

   483     self assert: result second inputValue = 'bar'.	

   484     self assert: context invocationCount = 3.

   485     self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]).	

   486         

   487     self assert: parser fail: 'bar'.

   488     self assert: context invocationCount = 1.

   489     self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).	

   490     

   491 !

   492 

   493 testTrimmingToken3

   494 

   495     parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken)

   496         compileWithConfiguration: configuration.

   497     

   498     self assert: parser parse: 'foo'.

   499     self assert: result inputValue = 'foo'.

   500     self assert: context invocationCount = 2.

   501 

   502     self assert: parser parse: ' bar'.

   503     self assert: result inputValue = 'bar'.	

   504     self assert: context invocationCount = 2.

   505     self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]).	

   506         

   507     self assert: parser fail: 'baz'.

   508     self assert: context invocationCount = 2.

   509     

   510     self assert: parser fail: 'zaz'.

   511     self assert: context invocationCount = 1.

   512     self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).	

   513 !

   514 

   515 testTrimmingTokenNested

   516     | identifier kw |

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

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

   519     

   520     parser := identifier / kw.

   521     parser := parser compileWithConfiguration: configuration.

   522     self assert: parser class methodDictionary size = 5.

   523 

   524     self assert: parser parse: 'foo'.

   525     self assert: result inputValue = 'foo'.

   526 

   527     self assert: parser parse: 'false'.

   528     self assert: result inputValue = 'false'.

   529 !

   530 

   531 testTrimmingTokenNested2

   532     | identifier kw |

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

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

   535     

   536     parser := identifier / kw.

   537     parser := parser compileWithConfiguration: configuration.

   538     self assert: parser class methodDictionary size = 5.

   539 

   540     self assert: parser parse: 'foo'.

   541     self assert: result inputValue = 'foo'.

   542 

   543     self assert: parser parse: 'false'.

   544     self assert: result inputValue = 'false'.

   545 !

   546 

   547 testTrimmingTokenNested3

   548     | identifier kw |

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

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

   551     

   552     parser := identifier / kw.

   553     parser := parser compileWithConfiguration: configuration.

   554     self assert: parser class methodDictionary size = 8.

   555     self assert: (parser class methodDictionary values anySatisfy: [ :m | m selector = #kw ]).

   556     self assert: (parser class methodDictionary values anySatisfy: [ :m | m selector = #kw_fast ]).

   557 

   558     self assert: parser parse: 'foo'.

   559     self assert: result inputValue = 'foo'.

   560 

   561     self assert: parser parse: 'false'.

   562     self assert: result inputValue = 'false'.

   563 

   564     "Modified: / 10-05-2015 / 07:33:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   565 ! !

   566 

   567 !PPCPrototype1Test methodsFor:'tests - ids'!

   568 

   569 setUp

   570     arguments := PPCArguments default

   571         profile: true;

   572         debug: true;

   573         yourself.

   574         

   575     configuration := PPCUniversalConfiguration new

   576         arguments: arguments;

   577         yourself.

   578 ! !

   579