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

     2 

     3 PPAbstractParserTest subclass:#PPCNodeCompilingTest

     4 	instanceVariableNames:'parser context tree result'

     5 	classVariableNames:''

     6 	poolDictionaries:''

     7 	category:'PetitCompiler-Tests-Nodes'

     8 !

     9 

    10 !PPCNodeCompilingTest methodsFor:'context'!

    11 

    12 context	

    13 	^ context := PPCProfilingContext new

    14 ! !

    15 

    16 !PPCNodeCompilingTest methodsFor:'test support'!

    17 

    18 assert: whatever parse: input

    19 	result := super assert: whatever parse: input.

    20 !

    21 

    22 compileTree: root 

    23 	^ self compileTree: root params: #()

    24 !

    25 

    26 compileTree: root params: params

    27 	| compiler mock |

    28 	compiler := PPCCompiler new.

    29 	compiler profile: true.

    30 	mock := nil asParser.

    31 	^ (compiler compileTree: root as: #PPGeneratedParser parser: mock params: params) new.

    32 ! !

    33 

    34 !PPCNodeCompilingTest methodsFor:'tests - compiling'!

    35 

    36 testCompileAction

    37 	tree := PPCActionNode new

    38 		block: [ :res | res collect: [:each | each asUppercase ]];

    39 		child: #letter asParser plus asCompilerTree;

    40 		yourself.

    41 	parser := self compileTree: tree.

    42 			

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

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

    45 	self assert: parser fail: ''.

    46 !

    47 

    48 testCompileAnd

    49 	tree := PPCAndNode new

    50 		child: #digit asParser asCompilerNode;

    51 		yourself.

    52 	parser := self compileTree: tree.

    53 	

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

    55 	self assert: parser fail: 'a'.

    56 	self assert: parser fail: ''.

    57 !

    58 

    59 testCompileAny

    60 	tree := PPCAnyNode new.

    61 	parser := self compileTree: tree.

    62 	

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

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

    65 	self assert: parser parse: '

    66 ' to: Character cr.

    67 !

    68 

    69 testCompileCharSetPredicate

    70 	tree := PPCCharSetPredicateNode new 

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

    72 		yourself.

    73 	parser := self compileTree: tree.

    74 	

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

    76 	self assert: parser fail: 'b'.

    77 !

    78 

    79 testCompileCharacter

    80 	tree := PPCCharacterNode new character: $a; yourself.

    81 	parser := self compileTree: tree.

    82 	

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

    84 	self assert: parser fail: 'b'.

    85 

    86 	parser := self compileTree: (PPCCharacterNode new character: $#; yourself).

    87 	self assert: parser parse: '#'.

    88 

    89 	parser := self compileTree: (PPCCharacterNode new character: Character lf; yourself).

    90 	self assert: parser parse: String lf.

    91 !

    92 

    93 testCompileChoice

    94 	tree := PPCChoiceNode new

    95 		children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode };

    96 		yourself.

    97 		

    98 	parser := self compileTree: tree.

    99 	

   100 	self assert: parser class methods size = 4.

   101 	

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

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

   104 	self assert: parser fail: '_'.

   105 !

   106 

   107 testCompileLiteral

   108 	tree := PPCLiteralNode new

   109 		literal: 'foo';

   110 		yourself.

   111 	parser := self compileTree: tree.

   112 	

   113 	self assert: parser class methods size = 2.

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

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

   116 	self assert: parser fail: 'boo'.

   117 !

   118 

   119 testCompileLiteral2

   120 	|  |

   121 	

   122 	tree := PPCLiteralNode new

   123 		literal: '''''';

   124 		yourself.

   125 	parser := self compileTree: tree.

   126 	

   127 	self assert: parser parse: ''''''  to: ''''''.

   128 !

   129 

   130 testCompileNil

   131 	tree := PPCNilNode new.

   132 	

   133 	parser := self compileTree: tree.

   134 	

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

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

   137 !

   138 

   139 testCompileNot

   140 	tree := PPCNotNode new

   141 		child: #digit asParser asCompilerNode;

   142 		yourself.

   143 	parser := self compileTree: tree.

   144 	

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

   146 	self assert: parser fail: '1'.

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

   148 !

   149 

   150 testCompileNotCharSetPredicate

   151 	tree := PPCNotCharSetPredicateNode new

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

   153 		yourself.

   154 	parser := self compileTree: tree.

   155 	

   156 	self assert: parser class methods size = 2.

   157 	self assert: parser parse: 'b' to: nil end: 0.

   158 	self assert: context invocationCount = 2.

   159 		

   160 	self assert: parser fail: 'a'.

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

   162 !

   163 

   164 testCompileNotLiteral

   165 	tree := PPCNotLiteralNode new

   166 		literal: 'foo';

   167 		yourself.

   168 	parser := self compileTree: tree.

   169 	

   170 	self assert: parser class methods size = 2.

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

   172 	self assert: context invocationCount = 2.

   173 		

   174 	self assert: parser fail: 'foo'.

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

   176 !

   177 

   178 testCompileNotMessagePredicate

   179 	tree := PPCNotMessagePredicateNode new

   180 		message: #isDigit;

   181 		yourself.

   182 	parser := self compileTree: tree.

   183 	

   184 	self assert: parser class methods size = 2.

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

   186 	self assert: context invocationCount = 2.

   187 		

   188 	self assert: parser fail: '1'.

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

   190 !

   191 

   192 testCompileOptional

   193 	tree := PPCOptionalNode new

   194 		child: ($a asParser asCompilerNode);

   195 		yourself.

   196 	parser := self compileTree: tree.

   197 	

   198 	self assert: parser parse: 'b' to: nil end: 0.

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

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

   201 !

   202 

   203 testCompilePluggable

   204 	tree := PPCPluggableNode new

   205 		block: [:ctx | ctx next ];

   206 		yourself.

   207 	parser := self compileTree: tree.

   208 		

   209 	self assert: parser parse: 'foo' to: $f end: 1.

   210 	self assert: parser parse: 'bar' to: $b end: 1.

   211 	self assert: parser parse: '' to: nil.

   212 !

   213 

   214 testCompilePlus

   215 	tree := PPCPlusNode new

   216 		child: ($a asParser asCompilerNode);

   217 		yourself.

   218 	parser := self compileTree: tree.

   219 	

   220 	self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.

   221 	self assert: parser parse: 'ab' to: #( $a ) end: 1.

   222 	self assert: parser fail: 'b'.

   223 !

   224 

   225 testCompileSequence

   226 	tree := PPCSequenceNode new

   227 		children: {  $a asParser asCompilerNode . $b asParser asCompilerNode . $c asParser asCompilerNode  }

   228 		yourself.

   229 	parser := self compileTree: tree.

   230 	

   231 	self assert: parser parse: 'abc' to: #($a $b $c) end: 3.

   232 	self assert: parser parse: 'abcd' to: #( $a $b $c ) end: 3.

   233 	self assert: parser fail: 'ab'.

   234 !

   235 

   236 testCompileStar

   237 	tree := PPCStarNode new

   238 		child: ($a asParser asCompilerNode);

   239 		yourself.

   240 	parser := self compileTree: tree.

   241 	

   242 	self assert: parser parse: 'aaa' to: #($a $a $a) end: 3.

   243 	self assert: parser parse: 'ab' to: #( $a ) end: 1.

   244 	self assert: parser parse: 'b' to: #( ) end: 0.

   245 !

   246 

   247 testCompileStarAny

   248 	tree := PPCStarAnyNode new.

   249 	parser := self compileTree: tree.

   250 	

   251 	self assert: parser parse: 'abc' to: #($a $b $c).

   252 	self assert: parser parse: 'a' to: #($a).

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

   254 !

   255 

   256 testCompileStarCharSetPredicate

   257 	tree := PPCStarCharSetPredicateNode new

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

   259 		yourself.

   260 	parser := self compileTree: tree.

   261 	

   262 	self assert: parser class methods size = 2.

   263 	self assert: parser parse: 'aaa1' to: #( $a $a $a) end: 3.

   264 	self assert: context invocationCount = 2.

   265 	self assert: parser parse: 'bba' to: #() end: 0.

   266 	self assert: context invocationCount = 2.

   267 	

   268 !

   269 

   270 testCompileStarMessagePredicate

   271 	tree := PPCStarMessagePredicateNode new

   272 		message: #isLetter;

   273 		yourself.

   274 	parser := self compileTree: tree.

   275 	

   276 	self assert: parser class methods size = 2.

   277 	self assert: parser parse: 'abc1' to: #( $a $b $c) end: 3.

   278 	self assert: context invocationCount = 2.

   279 	

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

   281 	self assert: context invocationCount = 2.

   282 	

   283 !

   284 

   285 testCompileSymbolAction

   286 	tree := PPCSymbolActionNode new

   287 		block: #second;

   288 		child: #letter asParser plus asCompilerTree;

   289 		yourself.

   290 	parser := self compileTree: tree.

   291 		

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

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

   294 	self assert: parser fail: ''.

   295 !

   296 

   297 testCompileToken

   298 	tree := PPCTokenNode new

   299 		child: #letter asParser plus asCompilerTree;

   300 		tokenClass: PPToken;

   301 		yourself.

   302 	

   303 	parser := self compileTree: tree.

   304 	

   305 	self assert: parser parse: 'abc'.

   306 	self assert: result class = PPToken.

   307 	self assert: result inputValue = 'abc'.

   308 

   309 	self assert: parser fail: '1a'.

   310 !

   311 

   312 testCompileTokenSequence

   313 	tree := PPCTokenSequenceNode new.

   314 	tree children: { #digit asParser asCompilerNode. #letter asParser asCompilerNode }.

   315 

   316 	parser := self compileTree: tree.

   317 	

   318 	self assert: parser parse: '1a' to: parser.

   319 	self assert: context rememberCount = 0.

   320 	self assert: context lwRememberCount = 1.

   321 	self assert: context restoreCount = 0.

   322 	self assert: context lwRestoreCount = 0.

   323 	

   324 	self assert: parser parse: '1ab' to: parser end: 2.

   325 	self assert: context lwRememberCount = 1.

   326 	self assert: context lwRestoreCount = 0.

   327 

   328 	self assert: parser fail: 'a1'. 	

   329 	self assert: context lwRememberCount = 1.

   330 	self assert: context lwRestoreCount = 0.

   331 

   332 	self assert: parser fail: 'aa'. 	

   333 	self assert: context lwRememberCount = 1.

   334 	self assert: context lwRestoreCount = 0.

   335 

   336 	self assert: parser fail: '11'. 	

   337 	self assert: context lwRememberCount = 1.

   338 	self assert: context lwRestoreCount = 1.

   339 	

   340 !

   341 

   342 testCompileTokenStarMessagePredicate

   343 	

   344 	tree := PPCTokenStarMessagePredicateNode new message: #isLetter.

   345 	parser := self compileTree: tree params: {#guards -> false}.

   346 	

   347 	self assert: parser class methods size = 2.

   348 	

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

   350 	self assert: context invocationCount = 2.

   351 	self assert: context lwRememberCount  = 0.

   352 	self assert: context lwRestoreCount  = 0.

   353 	self assert: context rememberCount = 0.

   354 	

   355 	self assert: parser parse: 'foo123' to: parser end: 3.

   356 ! !

   357 

   358 !PPCNodeCompilingTest methodsFor:'tests - guard'!

   359 

   360 testSequenceTokenGuard

   361 

   362 	tree := PPCSequenceNode new

   363 		children: { 

   364 			'foo' asParser trimmingToken asCompilerTree optimizeTree. 

   365 			'bar' asParser trimmingToken asCompilerTree optimizeTree. 

   366 		}

   367 		yourself.

   368 	parser := self compileTree: tree.

   369 	

   370 	self assert: parser parse: 'foobar'.

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

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

   373 

   374 	self assert: parser parse: ' foobar'.

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

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

   377 

   378 	self assert: parser fail: ' foo'.

   379 !

   380 

   381 testTrimmingTokenGuard

   382 

   383 	tree := PPCChoiceNode new

   384 		children: { 

   385 			'foo' asParser trimmingToken asCompilerTree optimizeTree. 

   386 			'bar' asParser trimmingToken asCompilerTree optimizeTree

   387 		}

   388 		yourself.

   389 	parser := self compileTree: tree.

   390 	

   391 	self assert: parser parse: 'foo'.

   392 	self assert: result inputValue = 'foo'.	

   393 

   394 	self assert: parser parse: 'bar'.

   395 	self assert: result inputValue = 'bar'.	

   396 

   397 	self assert: parser parse: ' foo'.

   398 	self assert: result inputValue = 'foo'.	

   399 

   400 	self assert: parser parse: ' bar'.	

   401 	self assert: result inputValue = 'bar'.

   402 

   403 	self assert: parser fail: 'zorg'.

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

   405 ! !

   406 

   407 !PPCNodeCompilingTest methodsFor:'tests - inlining'!

   408 

   409 testInlineAny

   410 	tree := PPCSequenceNode new

   411 		children: { PPCInlineAnyNode new. $a asParser asCompilerNode }.

   412 	

   413 	parser := self compileTree: tree.

   414 	

   415 	self assert: parser class methods size = 3.

   416 	self assert: parser parse: '.a' to: #($. $a).

   417 !

   418 

   419 testInlineCharSetPredicate

   420 	tree := PPCPlusNode new

   421 		child: (PPCInlineCharSetPredicateNode new 

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

   423 			yourself);

   424 		yourself.

   425 	

   426 	parser := self compileTree: tree.

   427 

   428 	self assert: parser class methods size = 2.

   429 	self assert: parser parse: 'a'  to: #($a).

   430 	self assert: parser fail: 'b'.

   431 !

   432 

   433 testInlineCharacter

   434 	tree := PPCSequenceNode new

   435 		children: { PPCInlineCharacterNode new character: $b . $a asParser asCompilerNode }.

   436 	

   437 	parser := self compileTree: tree.

   438 	

   439 	self assert: parser class methods size = 3.

   440 	self assert: parser parse: 'ba' to: #($b $a).

   441 !

   442 

   443 testInlineLiteral

   444 	tree := PPCSequenceNode new

   445 		children: { PPCInlineLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.

   446 	

   447 	parser := self compileTree: tree.

   448 	

   449 	self assert: parser class methods size = 3.

   450 	self assert: parser parse: 'fooa' to: #('foo' $a).

   451 !

   452 

   453 testInlineNil

   454 	tree := PPCSequenceNode new

   455 		children: { PPCInlineNilNode new . $a asParser asCompilerNode }.

   456 	

   457 	parser := self compileTree: tree.

   458 	

   459 	self assert: parser class methods size = 3.

   460 	self assert: parser parse: 'a' to: #(nil $a).

   461 !

   462 

   463 testInlineNotLiteral

   464 	tree := PPCSequenceNode new

   465 		children: { PPCInlineNotLiteralNode new literal: 'foo'. $a asParser asCompilerNode }.

   466 	

   467 	parser := self compileTree: tree.

   468 	

   469 	self assert: parser class methods size = 3.

   470 	self assert: parser parse: 'a' to: #(nil $a).

   471 !

   472 

   473 testInlinePluggable

   474 	tree := PPCSequenceNode new

   475 		children: { PPCInlinePluggableNode new block: [ :ctx | ctx next ]. $a asParser asCompilerNode }.

   476 	

   477 	parser := self compileTree: tree.

   478 	

   479 	self assert: parser class methods size = 3.

   480 	self assert: parser parse: 'ba' to: #($b $a).

   481 ! !

   482