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

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 TestCase subclass:#PPCInliningVisitorTest

     6 	instanceVariableNames:'node result visitor'

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitCompiler-Tests-Visitors'

    10 !

    11 

    12 !PPCInliningVisitorTest methodsFor:'as yet unclassified'!

    13 

    14 assert: object type: class

    15 	self assert: object class == class

    16 !

    17 

    18 setUp

    19 	visitor := PPCInliningVisitor new.

    20 !

    21 

    22 testCharacterNode

    23 	node := PPCCharacterNode new

    24 		character: $a;

    25 		yourself.

    26 	result := visitor visit: node.

    27 	

    28 	self assert: result type: PPCCharacterNode.

    29 	self assert: result isMarkedForInline not.

    30 	self assert: result character = $a.

    31 !

    32 

    33 testCharacterNode2

    34 	| charNode |

    35 	charNode := PPCCharacterNode new

    36 		character: $a;

    37 		yourself.

    38 	node := PPCStarNode new

    39 		child: charNode;

    40 		yourself.

    41 	result := visitor visit: node.

    42 	

    43 	self assert: result child type: PPCCharacterNode.

    44 	self assert: result child isMarkedForInline.

    45 	self assert: result child character = $a.

    46 !

    47 

    48 testLiteralNode

    49 	| literalNode |

    50 	literalNode := PPCLiteralNode new

    51 		literal: 'foo';

    52 		yourself.

    53 	node := PPCOptionalNode new

    54 		child: literalNode;

    55 		yourself.

    56 

    57 	result := visitor visit: node.

    58 	

    59 	self assert: result child type: PPCLiteralNode.

    60 	self assert: result child isMarkedForInline.

    61 	self assert: result child literal = 'foo'.

    62 !

    63 

    64 testNil

    65 	node := PPCNilNode new.

    66 	result := visitor visit: node.

    67 

    68 	self assert: result type: PPCNilNode.

    69 	self assert: result isMarkedForInline not.

    70 !

    71 

    72 testNil2

    73 	node := PPCStarNode new

    74 		child: PPCNilNode new;

    75 		yourself.

    76 	result := visitor visit: node.

    77 

    78 	self assert: result type: PPCStarNode.

    79 	self assert: result child type: PPCNilNode.

    80 	self assert: result child isMarkedForInline.

    81 !

    82 

    83 testNotLiteralNode

    84 	| notLiteralNode |

    85 

    86 	notLiteralNode := PPCNotLiteralNode new

    87 		literal: 'foo';

    88 		yourself.

    89 

    90 	node := PPCOptionalNode new

    91 		child: notLiteralNode;

    92 		yourself.

    93 

    94 	result := visitor visit: node.

    95 	

    96 	self assert: result child type: PPCNotLiteralNode.

    97 	self assert: result child isMarkedForInline.

    98 	self assert: result child literal = 'foo'.

    99 !

   100 

   101 testPluggable

   102 	| pluggableNode |

   103 	pluggableNode := PPCPluggableNode new

   104 		block: [:ctx | nil] asParser.

   105 	node := PPCSequenceNode new

   106 		children: { pluggableNode  };

   107 		yourself.

   108 

   109 	result := visitor visit: node.

   110 	    

   111 	((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:

   112 	[  

   113 		self skip: 'skipped test, inlining of pluggable nodes not supported!!'.

   114 	].

   115 

   116 	self assert: result children first type: PPCPluggableNode.

   117 	self assert: result children first isMarkedForInline.

   118 

   119     "Modified: / 23-04-2015 / 12:18:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   120 !

   121 

   122 testSequenceInline

   123 	| charNode1 charNode2 |

   124 	charNode1 := PPCCharacterNode new

   125 		character: $a;

   126 		yourself.

   127 	charNode2 := PPCCharacterNode new

   128 		character: $b;

   129 		yourself.

   130 

   131 	node := PPCSequenceNode new

   132 		children: { charNode1 . charNode2 };

   133 		yourself.

   134 	result := visitor visit: node.

   135 	

   136 	self assert: result type: PPCSequenceNode .

   137 	self assert: result children first type: PPCCharacterNode.

   138 	self assert: result children second type: PPCCharacterNode.	

   139 !

   140 

   141 testTokenStarMessagePredicateNode

   142 	| tokenNode |

   143 	tokenNode := (PPCTokenStarMessagePredicateNode new)

   144 		child: PPCSentinelNode new;

   145 		yourself.

   146 	node := PPCForwardNode new

   147 		child: tokenNode;

   148 		yourself.	

   149 	result := visitor visit: node.

   150 	

   151 	self assert: result child type: PPCTokenStarMessagePredicateNode.

   152 	self assert: result child isMarkedForInline.

   153 !

   154 

   155 testTokenStarSeparatorNode

   156 	| tokenNode |

   157 	tokenNode := (PPCTokenStarSeparatorNode new)

   158 		name: #name;

   159 		message: #message;

   160 		child: PPCNilNode new;

   161 		yourself.

   162 

   163 	node := PPCForwardNode new

   164 		child: tokenNode;

   165 		yourself.	

   166 

   167 		

   168 	result := visitor visit: node.

   169 	

   170 	self assert: result child type: PPCTokenStarSeparatorNode.

   171 	self assert: result child isMarkedForInline.

   172 	self assert: result child child type: PPCNilNode.

   173 ! !

   174