Mercurial Mercurial > hg > stx-goodies-petitparser / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
compiler/tests/PPCOptimizingTest.st
changeset 438 20598d7ce9fa
parent 422 116d2b2af905
child 444 a3657ab0ca6b
equal deleted inserted replaced
437:54b3bc9e3987 438:20598d7ce9fa 
    11 
    11 
    12 
    12 
    13 !PPCOptimizingTest methodsFor:'test support'!
 
    13 !PPCOptimizingTest methodsFor:'test support'!
 
    14 
    14 
    15 assert: object type: class
 
    15 assert: object type: class
 
    16 	self assert: object class == class
 
    16 	self assert: (object isKindOf: class)
 
    17 !
 
    17 !
 
    18 
    18 
    19 optimize: p
 
    19 optimize: p
 
    20 	^ self optimize: p parameters: #()
 
    20 	^ p asCompilerTree optimizeTree 
    21 !
 
    21 !
 
    22 
    22 
    23 optimize: p parameters: parameters
 
    23 optimize: p parameters: parameters
 
    24 	^ p asCompilerTree optimizeTree: parameters 
    24 	^ p asCompilerTree optimizeTree: parameters 
    25 ! !
 
    25 ! !
 
    43 testChoiceInlining
 
    43 testChoiceInlining
 
    44 	| tree |
 
    44 	| tree |
 
    45 	tree := self optimize: $a asParser  / $b asParser.
 
    45 	tree := self optimize: $a asParser  / $b asParser.
 
    46 
    46 
    47 	self assert: tree type: PPCChoiceNode.
 
    47 	self assert: tree type: PPCChoiceNode.
 
    48 	self assert: tree children first  type: PPCInlineCharacterNode.
 
    48 	self assert: tree children first  type: PPCCharacterNode.
 
    49 	self assert: tree children second type: PPCInlineCharacterNode.
 
    49 	self assert: tree children first isMarkedForInline.
 
       
    50 	self assert: tree children second type: PPCCharacterNode.
 
       
    51 	self assert: tree children first isMarkedForInline.
 
       
    52 	
    50 !
 
    53 !
 
    51 
    54 
    52 testForwarding
 
    55 testForwarding
 
    53 	| tree p1 p2 |
 
    56 	| tree p1 p2 |
 
    54 	p2 := $a asParser.
 
    57 	p2 := $a asParser.
 
    55 	p1 := p2 wrapped.
 
    58 	p1 := p2 wrapped.
 
    56 	p1 name: 'p1'.
 
    59 	p1 name: 'p1'.
 
    57 	tree := self optimize: p1.
 
    60 	tree := self optimize: p1.
 
    58 
    61 
    59 	self assert: tree type: PPCCharacterNode.
 
    62 	self assert: tree type: PPCAbstractCharacterNode.
 
    60 	self assert: tree name = 'p1'.
 
    63 	self assert: tree name = 'p1'.
 
    61 	
    64 	
    62 	p2 name: 'p2'.
 
    65 	p2 name: 'p2'.
 
    63 	tree := self optimize: p1.
 
    66 	tree := self optimize: p1.
 
    64 	self assert: tree type: PPCForwardNode.
 
    67 	self assert: tree type: PPCForwardNode.
 
    69 testInlineCharacter
 
    72 testInlineCharacter
 
    70 	| tree |
 
    73 	| tree |
 
    71 	tree := self optimize: $a asParser plus.
 
    74 	tree := self optimize: $a asParser plus.
 
    72 
    75 
    73 	self assert: tree type: PPCPlusNode.
 
    76 	self assert: tree type: PPCPlusNode.
 
    74 	self assert: tree child  type: PPCInlineCharacterNode.
 
    77 	self assert: tree child type: PPCCharacterNode.
 
       
    78 	self assert: tree child isMarkedForInline.
 
    75 	self assert: tree child character = $a.
 
    79 	self assert: tree child character = $a.
 
    76 !
 
    80 !
 
    77 
    81 
    78 testInlineCharacter2
 
    82 testInlineCharacter2
 
    79 	| tree |
 
    83 	| tree |
 
    80 	tree := self optimize: $a asParser star.
 
    84 	tree := self optimize: $a asParser star.
 
    81 
    85 
    82 	self assert: tree type: PPCStarNode.
 
    86 	self assert: tree type: PPCStarNode.
 
    83 	self assert: tree child  type: PPCInlineCharacterNode.
 
    87 	self assert: tree child type: PPCCharacterNode.
 
       
    88 	self assert: tree child isMarkedForInline.
 
    84 	self assert: tree child character = $a.
 
    89 	self assert: tree child character = $a.
 
    85 !
 
    90 !
 
    86 
    91 
    87 testInlineCharacter3
 
    92 testInlineCharacter3
 
    88 	| tree |
 
    93 	| tree |
 
    89 	tree := self optimize: $a asParser, $b asParser.
 
    94 	tree := self optimize: $a asParser, $b asParser.
 
    90 
    95 
    91 	self assert: tree type: PPCSequenceNode.
 
    96 	self assert: tree type: PPCSequenceNode.
 
    92 	self assert: tree children first type: PPCInlineCharacterNode.
 
    97 	self assert: tree children first type: PPCCharacterNode.
 
       
    98 	self assert: tree children first isMarkedForInline.
 
    93 	self assert: tree children first character = $a.
 
    99 	self assert: tree children first character = $a.
 
    94 	self assert: tree children second type: PPCInlineCharacterNode.
 
   100 	self assert: tree children second type: PPCCharacterNode.
 
       
   101 	self assert: tree children second isMarkedForInline.
 
    95 	self assert: tree children second character = $b.	
   102 	self assert: tree children second character = $b.	
    96 !
 
   103 !
 
    97 
   104 
    98 testInlineNil
 
   105 testInlineNil
 
    99 	| tree |
 
   106 	| tree |
 
   100 	tree := self optimize: nil asParser star.
 
   107 	tree := self optimize: nil asParser star.
 
   101 
   108 
   102 	self assert: tree type: PPCStarNode.
 
   109 	self assert: tree type: PPCStarNode.
 
   103 	self assert: tree child type: PPCInlineNilNode.
 
   110 	self assert: tree child type: PPCNilNode.
 
       
   111 	self assert: tree child isMarkedForInline.
 
   104 !
 
   112 !
 
   105 
   113 
   106 testInlineNotLiteral
 
   114 testInlineNotLiteral
 
   107 	| tree |
 
   115 	| tree |
 
   108 	tree := self optimize: 'foo' asParser not star.
 
   116 	tree := self optimize: 'foo' asParser not star.
 
   109 
   117 
   110 	self assert: tree type: PPCStarNode.
 
   118 	self assert: tree type: PPCStarNode.
 
   111 	self assert: tree child type: PPCInlineNotLiteralNode.
 
   119 	self assert: tree child type: PPCNotLiteralNode.
 
   112 	self assert: tree child literal = 'foo'.
 
   120 	self assert: tree child literal = 'foo'.
 
       
   121 	self assert: tree child isMarkedForInline.
 
   113 !
 
   122 !
 
   114 
   123 
   115 testInlineNotPredicate
 
   124 testInlineNotPredicate
 
   116 	| tree |
 
   125 	| tree |
 
   117 	tree := self optimize: (#letter asParser not, (PPPredicateObjectParser on: [ :e | e = $a or: [  e = $b ]] message: #foo) not).
 
   126 	tree := self optimize: (#letter asParser not, (PPPredicateObjectParser on: [ :e | e = $a or: [  e = $b ]] message: #foo) not).
 
   118 
   127 
   119 	self assert: tree type: PPCSequenceNode.
 
   128 	self assert: tree type: PPCSequenceNode.
 
   120 	self assert: tree children first type: PPCInlineNotMessagePredicateNode.
 
   129 	self assert: tree children first type: PPCNotMessagePredicateNode.
 
   121 	self assert: tree children second type: PPCInlineNotCharSetPredicateNode.
 
   130 	self assert: tree children first isMarkedForInline.
 
       
   131 	self assert: tree children second type: PPCNotCharSetPredicateNode.
 
       
   132 	self assert: tree children second isMarkedForInline.
 
       
   133 	
   122 !
 
   134 !
 
   123 
   135 
   124 testInlinePluggable
 
   136 testInlinePluggable
 
   125 	| tree |
 
   137 	| tree |
 
   126 	tree := self optimize: [:ctx | nil] asParser star.
 
   138 	tree := self optimize: [:ctx | nil] asParser star.
 
   127 
   139 
   128 	self assert: tree type: PPCStarNode.
 
   140 	((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) 
   129 	self assert: tree child type: PPCInlinePluggableNode.
 
   141 		ifTrue:[ self skip: 'not supported in St/X' ].
 
       
   142 
       
   143 	self assert: tree type: PPCStarNode.
 
       
   144 	self assert: tree child type: PPCPluggableNode.
 
       
   145 	self assert: tree child isMarkedForInline.
 
       
   146 
       
   147     "Modified: / 23-04-2015 / 12:19:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 
   130 !
 
   148 !
 
   131 
   149 
   132 testInlinePredicate
 
   150 testInlinePredicate
 
   133 	| tree |
 
   151 	| tree |
 
   134 	tree := self optimize: (#letter asParser, (PPPredicateObjectParser on: [ :e | e = $a or: [  e = $b ]] message: #foo)).
 
   152 	tree := self optimize: (#letter asParser, (PPPredicateObjectParser on: [ :e | e = $a or: [  e = $b ]] message: #foo)).
 
   135 
   153 
   136 	self assert: tree type: PPCSequenceNode.
 
   154 	self assert: tree type: PPCSequenceNode.
 
   137 	self assert: tree children first type: PPCInlineMessagePredicateNode.
 
   155 	self assert: tree children first type: PPCMessagePredicateNode.
 
   138 	self assert: tree children second type: PPCInlineCharSetPredicateNode.
 
   156 	self assert: tree children first isMarkedForInline.
 
       
   157 	self assert: tree children second type: PPCCharSetPredicateNode.
 
       
   158 	self assert: tree children second isMarkedForInline.
 
       
   159 	
   139 !
 
   160 !
 
   140 
   161 
   141 testLetterPredicate
 
   162 testLetterPredicate
 
   142 	| tree |
 
   163 	| tree |
 
   143 	tree := self optimize: #letter asParser.
 
   164 	tree := self optimize: #letter asParser.
 
   205 	self assert: tree type: PPCStarMessagePredicateNode.
 
   226 	self assert: tree type: PPCStarMessagePredicateNode.
 
   206 !
 
   227 !
 
   207 
   228 
   208 testStarSeparator
 
   229 testStarSeparator
 
   209 	| tree |
 
   230 	| tree |
 
   210 	tree := self optimize: #space asParser star trimmingToken parameters: { #inline -> false }.
 
   231 	tree := self optimize: #space asParser star trimmingToken parameters: { #rewrite . #token }.
 
   211 
   232 
   212 	self assert: tree type: PPCTrimmingTokenNode.
 
   233 	self assert: tree type: PPCTrimmingTokenNode.
 
   213 	self assert: tree child type: PPCTokenStarSeparatorNode.
 
   234 	self assert: tree child type: PPCTokenStarSeparatorNode.
 
   214 !
 
   235 !
 
   215 
   236 
   217 	| tree |
 
   238 	| tree |
 
   218 	tree := self optimize: (#space asParser star, 'whatever' asParser) trimmingToken.
 
   239 	tree := self optimize: (#space asParser star, 'whatever' asParser) trimmingToken.
 
   219 
   240 
   220 	self assert: tree type: PPCTrimmingTokenNode.
 
   241 	self assert: tree type: PPCTrimmingTokenNode.
 
   221 	self assert: tree child type: PPCTokenSequenceNode.
 
   242 	self assert: tree child type: PPCTokenSequenceNode.
 
   222 	self assert: tree child children first type: PPCInlineTokenStarSeparatorNode.
 
   243 	self assert: tree child children first type: PPCTokenStarSeparatorNode.
 
       
   244 	self assert: tree child children first isMarkedForInline.
 
   223 !
 
   245 !
 
   224 
   246 
   225 testSymbolAction
 
   247 testSymbolAction
 
   226 	| tree |
 
   248 	| tree |
 
   227 	tree := self optimize: (#letter asParser) ==> #second.
 
   249 	tree := self optimize: (#letter asParser) ==> #second.
 
   237 	tree := self optimize: ((#letter asParser, #word asParser star) token).
 
   259 	tree := self optimize: ((#letter asParser, #word asParser star) token).
 
   238 
   260 
   239 	self assert: tree type: PPCTokenNode.
 
   261 	self assert: tree type: PPCTokenNode.
 
   240 	self assert: tree child type: PPCTokenSequenceNode.
 
   262 	self assert: tree child type: PPCTokenSequenceNode.
 
   241 	self assert: tree child children size = 2.
 
   263 	self assert: tree child children size = 2.
 
   242 	self assert: tree child children first type: PPCInlineMessagePredicateNode.
 
   264 	self assert: tree child children first type: PPCMessagePredicateNode.
 
   243 	self assert: tree child children second type: PPCInlineTokenStarMessagePredicateNode.	
   265 	self assert: tree child children first isMarkedForInline.
 
   244 !
 
   266 	self assert: tree child children second type: PPCTokenStarMessagePredicateNode.	
   245 
   267 	self assert: tree child children second isMarkedForInline.
 
   246 testTokenSequence
 
   268 	
       
   269 !
 
       
   270 
       
   271 testTokenSequence2
 
   247 	| tree |
 
   272 	| tree |
 
   248 	tree := self optimize: ($a asParser, $b asParser) token.
 
   273 	tree := self optimize: ($a asParser, $b asParser) token.
 
   249 
   274 
   250 	self assert: tree type: PPCTokenNode.
 
   275 	self assert: tree type: PPCTokenNode.
 
   251 	self assert: tree child type: PPCTokenSequenceNode.
 
   276 	self assert: tree child type: PPCTokenSequenceNode.
 
   259 testTrimmingToken
 
   284 testTrimmingToken
 
   260 	| tree |
 
   285 	| tree |
 
   261 	tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken).
 
   286 	tree := self optimize: ((#letter asParser, #word asParser star) trimmingToken).
 
   262 
   287 
   263 	self assert: tree type: PPCTrimmingTokenNode.
 
   288 	self assert: tree type: PPCTrimmingTokenNode.
 
   264 	self assert: tree whitespace type: PPCInlineTokenStarSeparatorNode.
 
   289 	self assert: tree whitespace type: PPCTokenStarSeparatorNode.
 
       
   290 	self assert: tree whitespace isMarkedForInline.
 
       
   291 	
   265 	self assert: tree child type: PPCTokenSequenceNode.
 
   292 	self assert: tree child type: PPCTokenSequenceNode.
 
   266 	self assert: tree child children size = 2.
 
   293 	self assert: tree child children size = 2.
 
   267 	self assert: tree child children first type: PPCInlineMessagePredicateNode.
 
   294 	self assert: tree child children first type: PPCMessagePredicateNode.
 
   268 	self assert: tree child children second type: PPCInlineTokenStarMessagePredicateNode.	
   295 	self assert: tree child children first isMarkedForInline.
 
       
   296 	self assert: tree child children second type: PPCTokenStarMessagePredicateNode.	
       
   297 	self assert: tree child children first isMarkedForInline.
 
   269 !
 
   298 !
 
   270 
   299 
   271 testTrimmingToken2
 
   300 testTrimmingToken2
 
   272 	| parser tree |
 
   301 	| parser tree |
 
   273 	parser := 'foo' asParser trimmingToken.
 
   302 	parser := 'foo' asParser trimmingToken.
 
   274 	tree := parser asCompilerTree optimizeTree.
 
   303 	tree := parser asCompilerTree optimizeTree.
 
   275 	
   304 	
   276 	self assert: tree type: PPCTrimmingTokenNode.
 
   305 	self assert: tree type: PPCTrimmingTokenNode.
 
   277 	self assert: tree child type: PPCInlineLiteralNode.
 
   306 	self assert: tree child type: PPCLiteralNode.
 
       
   307 	self assert: tree child isMarkedForInline.
 
   278 	self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
 
   308 	self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
 
   279 
   309 
   280 	parser := ('foo' asParser, $b asParser) trimmingToken.
 
   310 	parser := ('foo' asParser, $b asParser) trimmingToken.
 
   281 	tree := parser asCompilerTree optimizeTree.
 
   311 	tree := parser asCompilerTree optimizeTree.
 
   282 	
   312 	
   283 	self assert: tree type: PPCTrimmingTokenNode.
 
   313 	self assert: tree type: PPCTrimmingTokenNode.
 
   284 	self assert: tree child type: PPCTokenSequenceNode.
 
   314 	self assert: tree child type: PPCTokenSequenceNode.
 
   285 	self assert: tree whitespace type: PPCInlineTokenStarSeparatorNode.
 
   315 	self assert: tree whitespace type: PPCTokenStarSeparatorNode.
 
       
   316 	self assert: tree whitespace isMarkedForInline.
 
   286 	
   317 	
   287 	parser := $d asParser trimmingToken star.
 
   318 	parser := $d asParser trimmingToken star.
 
   288 	tree := parser asCompilerTree optimizeTree.
 
   319 	tree := parser asCompilerTree optimizeTree.
 
   289 	
   320 	
   290 	self assert: tree type: PPCStarNode.
 
   321 	self assert: tree type: PPCStarNode.
 
   291 	self assert: tree child type: PPCTrimmingTokenNode.
 
   322 	self assert: tree child type: PPCTrimmingTokenNode.
 
   292 	self assert: tree child child type: PPCInlineCharacterNode.
 
   323 	self assert: tree child child type: PPCCharacterNode.
 
       
   324 	self assert: tree child child isMarkedForInline.
 
   293 !
 
   325 !
 
   294 
   326 
   295 testTrimmingToken3
 
   327 testTrimmingToken3
 
   296 	| parser tree |
 
   328 	| parser tree |
 
   297 	parser := ('foo' asParser trimmingToken name: 'foo'), ('bar' asParser trimmingToken name: 'bar').
 
   329 	parser := ('foo' asParser trimmingToken name: 'foo'), ('bar' asParser trimmingToken name: 'bar').
 
   308 	parser := (foo not, 'bar' asParser) trimmingToken name: 'token'.
 
   340 	parser := (foo not, 'bar' asParser) trimmingToken name: 'token'.
 
   309 	tree := self optimize: parser.
 
   341 	tree := self optimize: parser.
 
   310 	
   342 	
   311 	self assert: tree type: PPCTrimmingTokenNode.
 
   343 	self assert: tree type: PPCTrimmingTokenNode.
 
   312 	self assert: tree children second type: PPCTokenSequenceNode.
 
   344 	self assert: tree children second type: PPCTokenSequenceNode.
 
   313 	self assert: tree children second children first type: PPCInlineNotLiteralNode.
 
   345 	self assert: tree children second children first type: PPCNotLiteralNode.
 
       
   346 	self assert: tree children second children first isMarkedForInline.
 
   314 ! !
 
   347 ! !
 
   315 
   348 
   316 !PPCOptimizingTest class methodsFor:'documentation'!
 
   349 !PPCOptimizingTest class methodsFor:'documentation'!
 
   317 
   350 
   318 version_HG
 
   351 version_HG
hg/stx-goodies-petitparser