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

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 TestCase subclass:#PEGFsaGeneratorTest

     6 	instanceVariableNames:'result node fsa generator interpreter'

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitCompiler-Tests-FSA'

    10 !

    11 

    12 

    13 !PEGFsaGeneratorTest methodsFor:'as yet unclassified'!

    14 

    15 assert: anFsa fail: input

    16     | stream |

    17     stream := input asPetitStream.

    18 

    19     result := interpreter interpret: anFsa on: stream.

    20 

    21     self assert: result isEmpty.

    22     ^ result

    23 !

    24 

    25 assert: interpret parse: input 

    26     ^ self assert: interpret parse: input end: input size

    27 !

    28 

    29 assert: anFsa parse: input end: end

    30     | stream |

    31     stream := input asPetitStream.

    32 

    33     result := interpreter interpret: anFsa on: stream.

    34 

    35     self assert: result isEmpty not.

    36     self assert: (result values anySatisfy: [ :pos | pos = end ]) description: 'wrong position'.

    37     

    38     ^ result

    39 !

    40 

    41 fsaFrom: aNode

    42     ^ (aNode accept: generator)

    43         compact;

    44         yourself

    45 !

    46 

    47 setUp

    48     super setUp.

    49     generator := PEGFsaGenerator new.

    50     interpreter := PEGFsaInterpret new.	

    51 !

    52 

    53 testAAA_Aplusnot

    54     | parser |

    55     parser := 'aaa' asParser not, $a asParser plus.

    56     node := parser asCompilerTree.

    57         

    58     fsa := self fsaFrom: node.

    59     

    60     self assert: fsa parse: 'a'.	

    61     self assert: fsa parse: 'aa'.	

    62     self assert: fsa fail: ''.

    63     self assert: fsa fail: 'aaa'.

    64     self assert: fsa fail: 'aaaa'.

    65     self assert: fsa fail: 'aaaaa'.

    66 !

    67 

    68 testAAplusA

    69     | parser |

    70     parser := 'aa' asParser plus, $a asParser.

    71     node := parser asCompilerTree.

    72         

    73     fsa := self fsaFrom: node.

    74 

    75     self assert: fsa parse: 'aaa'.	

    76     self assert: fsa parse: 'aaaaa'.	

    77     self assert: fsa parse: 'aaaaaaa'.	

    78     self assert: fsa fail: 'a'.

    79     self assert: fsa fail: 'aa'.

    80     self assert: fsa fail: 'aaaa'.

    81 !

    82 

    83 testAAplusB

    84     | parser |

    85     parser := 'aa' asParser plus, $b asParser.

    86     node := parser asCompilerTree.

    87         

    88     fsa := self fsaFrom: node.

    89     

    90     self assert: fsa parse: 'aab'.	

    91     self assert: fsa parse: 'aaaab'.	

    92     self assert: fsa fail: 'a'.

    93     self assert: fsa fail: 'aa'.

    94     self assert: fsa fail: 'aaaa'.

    95     self assert: fsa fail: 'aaaac'.

    96 !

    97 

    98 testAB

    99     | parser |

   100     parser := $a asParser, $b asParser.

   101     node := parser asCompilerTree.

   102         

   103     fsa := self fsaFrom: node.

   104     

   105     self assert: fsa parse: 'ab'.	

   106     self assert: fsa fail: 'a'.

   107     self assert: fsa fail: 'b'.

   108     self assert: fsa fail: 'ac'.

   109 !

   110 

   111 testA_Boptional

   112     | parser |

   113     parser := $a asParser, $b asParser optional.

   114     node := parser asCompilerTree.

   115     

   116     fsa := self fsaFrom: node.

   117     

   118     self assert: fsa parse: 'ab'.	

   119     self assert: fsa parse: 'ac' end: 1.	

   120     self assert: fsa parse: 'a'.

   121     self assert: fsa fail: 'b'.

   122 !

   123 

   124 testA_Boptionaloptional

   125     | parser |

   126     parser := ($a asParser, $b asParser optional) optional.

   127     node := parser asCompilerTree.

   128         

   129     fsa := self fsaFrom: node.

   130 

   131     self assert: fsa parse: ''.	

   132     self assert: fsa parse: 'a'.	

   133     self assert: fsa parse: 'ab'.	

   134     self assert: fsa parse: 'b' end: 0.

   135 !

   136 

   137 testA_BorC_D

   138     | parser |

   139     parser := $a asParser, ($b asParser / $c asParser), $d asParser.

   140     node := parser asCompilerTree.

   141         

   142     fsa := self fsaFrom: node.

   143     

   144     self assert: fsa parse: 'abd'.	

   145     self assert: fsa parse: 'acd'.	

   146     self assert: fsa fail: 'abc'.

   147     self assert: fsa fail: 'add'.

   148     self assert: fsa fail: 'ad'.

   149 !

   150 

   151 testAorAA

   152     | parser |

   153     parser := 'a' asParser / 'aa' asParser.

   154     node := parser asCompilerTree.

   155         

   156     fsa := self fsaFrom: node.

   157     

   158     self assert: fsa parse: 'a'.	

   159     self assert: fsa parse: 'aa' end: 1.	

   160     self assert: fsa parse: 'aaaaaaa' end: 1.	

   161     self assert: fsa fail: ''.

   162     self assert: fsa fail: 'b'.

   163 !

   164 

   165 testAorAX_X

   166     | parser |

   167     parser := ('a' asParser / 'ax' asParser), $x asParser.

   168     node := parser asCompilerTree.

   169     

   170     fsa := self fsaFrom: node.

   171 

   172     self assert: fsa parse: 'ax'.	

   173     self assert: fsa parse: 'axx' end: 2.	

   174     self assert: fsa fail: 'a'.

   175     self assert: fsa fail: 'x'.

   176     self assert: fsa fail: ''.

   177 !

   178 

   179 testAorBC_X

   180     | parser |

   181     parser := ('a' asParser / 'bc' asParser), $x asParser.

   182     node := parser asCompilerTree.

   183         

   184     fsa := self fsaFrom: node.

   185 

   186     self assert: fsa parse: 'ax'.	

   187     self assert: fsa parse: 'bcx' end: 3.	

   188     self assert: fsa fail: 'bx'.

   189     self assert: fsa fail: 'cx'.

   190     self assert: fsa fail: 'a'.	

   191     self assert: fsa fail: 'bc'.		

   192 !

   193 

   194 testAorB_Coptionaloptional

   195     | parser |

   196     parser := (($a asParser / $b asParser), $c asParser optional) optional.

   197     node := parser asCompilerTree.

   198         

   199     fsa := self fsaFrom: node.

   200 

   201     self assert: fsa parse: ''.	

   202     self assert: fsa parse: 'a'.	

   203     self assert: fsa parse: 'b'.	

   204     self assert: fsa parse: 'ac'.	

   205     self assert: fsa parse: 'bc'.	

   206     self assert: fsa parse: 'ad' end: 1.	

   207     self assert: fsa parse: 'bd' end: 1.	

   208     self assert: fsa parse: 'd' end: 0.	

   209     self assert: fsa parse: 'c' end: 0.

   210 !

   211 

   212 testAstarA

   213     | parser |

   214     parser := $a asParser star, $a asParser.

   215     node := parser asCompilerTree.

   216         

   217     fsa := self fsaFrom: node.

   218     

   219     self assert: fsa fail: 'a'.

   220     self assert: fsa fail: 'aa'.

   221     self assert: fsa fail: 'aaa'.

   222 !

   223 

   224 testAstarB

   225     | parser |

   226     parser := $a asParser star, $b asParser.

   227     node := parser asCompilerTree.

   228         

   229     fsa := self fsaFrom: node.

   230     

   231     self assert: fsa parse: 'b'.	

   232     self assert: fsa parse: 'ab'.	

   233     self assert: fsa parse: 'aaab'.	

   234     self assert: fsa fail: 'a'.

   235     self assert: fsa fail: 'ac'.

   236     self assert: fsa fail: 'aac'.

   237 !

   238 

   239 testCharSet

   240     | parser |

   241     parser := #letter asParser.

   242     node := parser asCompilerTree.

   243         

   244     fsa := self fsaFrom: node.

   245     

   246     self assert: fsa parse: 'a'.	

   247     self assert: fsa parse: 'z'.	

   248     self assert: fsa parse: 'A'.	

   249     self assert: fsa parse: 'Z'.	

   250     self assert: fsa fail: '_'.

   251     self assert: fsa fail: '()'.

   252     self assert: fsa fail: ''.

   253 !

   254 

   255 testCharSetPredicateNode

   256     node := PPCCharSetPredicateNode new 

   257         predicate: (PPCharSetPredicate on: [ :e | e = $a ]);

   258         yourself.

   259         

   260     fsa := self fsaFrom: node.

   261     

   262     self assert: fsa parse: 'a' end: 1.

   263     self assert: fsa parse: 'ab' end: 1.

   264     self assert: fsa fail: 'b'.

   265 !

   266 

   267 testCharSetPredicateNode2

   268     node := PPCCharSetPredicateNode new 

   269         predicate: (PPCharSetPredicate on: [ :e | e isDigit ]);

   270         yourself.

   271         

   272     fsa := self fsaFrom: node.

   273     

   274     self assert: fsa parse: '1' end: 1.

   275     self assert: fsa parse: '0' end: 1.

   276     self assert: fsa parse: '5' end: 1.

   277     self assert: fsa fail: 'a'.

   278 !

   279 

   280 testCharacterNode

   281     node := PPCCharacterNode new

   282         character: $a;

   283         yourself.

   284         

   285     fsa := self fsaFrom: node.

   286     

   287     self assert: fsa parse: 'a' end: 1.

   288     self assert: fsa parse: 'ab' end: 1.

   289     self assert: fsa fail: 'b'.

   290 !

   291 

   292 testChoiceNode

   293     | literal1 literal2 |

   294     literal1 := PPCLiteralNode new

   295         literal: 'foo';

   296         yourself.

   297     literal2 := PPCLiteralNode new

   298         literal: 'bar';

   299         yourself.

   300     

   301     node := PPCChoiceNode new

   302         children: { literal1 . literal2 };

   303         yourself.

   304         

   305     fsa := self fsaFrom: node.

   306     

   307     self assert: fsa parse: 'foo'.

   308     self assert: fsa parse: 'bar'.	

   309 self assert: fsa fail: 'fof'.		

   310 !

   311 

   312 testChoicePriorities

   313     | parser |

   314     parser := ($a asParser optional, $b asParser optional) / $a asParser.

   315     node := parser asCompilerTree.

   316         

   317     fsa := self fsaFrom: node.

   318     

   319     self assert: fsa parse: 'ab'.	

   320     self assert: fsa parse: 'a' end: 1.	

   321     self assert: fsa parse: 'b' end: 1.	

   322     self assert: fsa parse: ''.

   323     self assert: fsa parse: 'c' end: 0.

   324 !

   325 

   326 testLiteralNode

   327     node := PPCLiteralNode new

   328         literal: 'foo';

   329         yourself.

   330         

   331     fsa := self fsaFrom: node.

   332     

   333     self assert: fsa parse: 'foo' end: 3.

   334     self assert: fsa parse: 'foobar' end: 3.

   335     self assert: fsa fail: 'fox'.

   336     self assert: fsa fail: 'bar'.

   337 !

   338 

   339 testLiteralNode2

   340     node := PPCLiteralNode new

   341         literal: '';

   342         yourself.

   343         

   344     fsa := self fsaFrom: node.

   345     

   346     self assert: fsa parse: ''.

   347 !

   348 

   349 testNot

   350     | parser |

   351     parser := 'aaa' asParser not, $a asParser plus.

   352     node := parser asCompilerTree.

   353     fsa := self fsaFrom: node.

   354     

   355     self assert: fsa parse: 'a'.	

   356     self assert: fsa parse: 'aa'.	

   357     self assert: fsa fail: 'aaa'.

   358     self assert: fsa fail: 'aaaa'.

   359     self assert: fsa fail: ''.

   360 !

   361 

   362 testNotNode

   363     | literal  |

   364     literal := PPCLiteralNode new

   365         literal: 'foo';

   366         yourself.

   367 

   368     node := PPCNotNode new

   369         child: literal;

   370         yourself.

   371     

   372     fsa := self fsaFrom: node.

   373 

   374     self assert: fsa parse: 'fo' end: 0.	

   375     self assert: fsa parse: 'z' end: 0.	

   376     self assert: fsa parse: 'foO' end: 0.	

   377     self assert: fsa parse: 'bar' end: 0.	

   378     self assert: fsa parse: ''.

   379     self assert: fsa fail: 'foo'.

   380 !

   381 

   382 testPlusNode

   383     | literal |

   384     literal := PPCLiteralNode new

   385         literal: 'foo';

   386         yourself.

   387     

   388     node := PPCPlusNode new

   389         child: literal;

   390         yourself.

   391         

   392     fsa := self fsaFrom: node.

   393     

   394     self assert: fsa fail: ''.

   395     self assert: fsa parse: 'foo'.	

   396     self assert: fsa parse: 'foofoofoo'.		

   397 !

   398 

   399 testSequenceNode

   400     | literal1 literal2 |

   401     literal1 := PPCLiteralNode new

   402         literal: 'foo';

   403         yourself.

   404     literal2 := PPCLiteralNode new

   405         literal: 'bar';

   406         yourself.

   407     

   408     node := PPCSequenceNode new

   409         children: { literal1 . literal2 };

   410         yourself.

   411         

   412     fsa := self fsaFrom: node.

   413     

   414     self assert: fsa parse: 'foobar'.

   415     self assert: fsa fail: 'foo'.	

   416     self assert: fsa fail: 'bar'.		

   417 !

   418 

   419 testSequenceNode2

   420     | literal1 literal2 literal3 |

   421     literal1 := PPCLiteralNode new

   422         literal: 'b';

   423         yourself.

   424     literal2 := PPCLiteralNode new

   425         literal: 'a';

   426         yourself.

   427     literal3 := PPCLiteralNode new

   428         literal: 'z';

   429         yourself.

   430     

   431     node := PPCSequenceNode new

   432         children: { literal1 . literal2 . literal3 };

   433         yourself.

   434         

   435     fsa := self fsaFrom: node.

   436     

   437     self assert: fsa parse: 'baz'.

   438     self assert: fsa fail: 'bar'.	

   439     self assert: fsa fail: 'faz'.		

   440     self assert: fsa fail: 'boz'.				

   441 !

   442 

   443 testStarNode

   444     | literal |

   445     literal := PPCLiteralNode new

   446         literal: 'foo';

   447         yourself.

   448     

   449     node := PPCStarNode new

   450         child: literal;

   451         yourself.

   452         

   453     fsa := self fsaFrom: node.

   454     

   455     self assert: fsa parse: ''.

   456     self assert: fsa parse: 'foo'.	

   457     self assert: fsa parse: 'foofoofoo'.		

   458 ! !

   459 

   460 !PEGFsaGeneratorTest class methodsFor:'documentation'!

   461 

   462 version_HG

   463 

   464     ^ '$Changeset: <not expanded> $'

   465 ! !

   466