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

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 TestCase subclass:#PPCTokenVisitorTest

     6 	instanceVariableNames:'node result visitor'

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitCompiler-Tests-Visitors'

    10 !

    11 

    12 !PPCTokenVisitorTest methodsFor:'as yet unclassified'!

    13 

    14 asNode: aPPParser

    15 	self error: 'deprecated'.

    16 	^ aPPParser asCompilerTree

    17 !

    18 

    19 assert: object type: class

    20 	self assert: object class == class

    21 !

    22 

    23 setUp

    24 	visitor := PPCTokenVisitor new.

    25 !

    26 

    27 testAction

    28 	| letterNode |

    29 	letterNode := PPCMessagePredicateNode new

    30 		message: #isLetter;

    31 		yourself.

    32 	

    33 	node := PPCActionNode new

    34 		block: [ :nodes | #foo ];

    35 		child: letterNode;

    36 		yourself.

    37 		

    38 	result := visitor visit: node.

    39 	self assert: result type: PPCMessagePredicateNode.

    40 	self assert: result = letterNode.

    41 !

    42 

    43 testAction2

    44 	| letterNode actionNode |

    45 	

    46 	letterNode := PPCMessagePredicateNode new

    47 		predicate: #isLetter;

    48 		yourself.

    49 		

    50 	actionNode := PPCActionNode new

    51 		block:  #boo;

    52 		child: letterNode;

    53 		yourself.

    54 	

    55 	node := PPCTokenNode new

    56 		child: actionNode;

    57 		yourself.

    58 	

    59 	result := visitor visit: node.

    60 	

    61 	self assert: result type: PPCMessagePredicateNode.

    62 	self assert: result = letterNode.

    63 !

    64 

    65 testAction3

    66 	| letterNode actionNode |

    67 	

    68 	letterNode := PPCMessagePredicateNode new

    69 		predicate: #isLetter;

    70 		yourself.

    71 		

    72 	actionNode := PPCActionNode new

    73 		block: #foo;

    74 		child: letterNode;

    75 		yourself.

    76 	

    77 	node := PPCActionNode new

    78 		block: #foo;

    79 		child: actionNode;

    80 		yourself.

    81 	

    82 	result := visitor visit: node.

    83 	

    84 	self assert: result type: PPCMessagePredicateNode.

    85 	self assert: result = letterNode.

    86 !

    87 

    88 testNotAction

    89 	| literalNode actionNode |

    90 	literalNode := PPCLiteralNode new

    91 		literal: 'foo';

    92 		yourself.

    93 	

    94 	actionNode := PPCActionNode new

    95 		block: #foo;

    96 		child: literalNode;

    97 		yourself.

    98 	

    99 	node := PPCNotNode new

   100 		child: actionNode;

   101 		yourself.

   102 		

   103 	result := visitor visit: node.

   104 	

   105 	self assert: result type: PPCNotNode.

   106 	self assert: result child type: PPCLiteralNode.

   107 !

   108 

   109 testNotAction2

   110 	| literalNode actionNode seqNode |

   111 	literalNode := PPCLiteralNode new

   112 		literal: 'foo';

   113 		yourself.

   114 	

   115 	seqNode := PPCSequenceNode new

   116 		children: { literalNode . literalNode  };

   117 		yourself.

   118 	

   119 	actionNode := PPCActionNode new

   120 		block: #foo;

   121 		child: seqNode;

   122 		yourself.

   123 	

   124 	node := PPCNotNode new

   125 		child: actionNode;

   126 		yourself.

   127 		

   128 	result := visitor visit: node.

   129 	

   130 	self assert: result type: PPCNotNode.

   131 	

   132 	self assert: result child type: PPCTokenSequenceNode.

   133 	self assert: result child firstChild type: PPCLiteralNode.

   134 	self assert: result child secondChild type: PPCLiteralNode.	

   135 !

   136 

   137 testNotAction3

   138 	| literalNode actionNode seqNode |

   139 	literalNode := PPCLiteralNode new

   140 		literal: 'foo';

   141 		yourself.

   142 	

   143 	seqNode := PPCSequenceNode new

   144 		children: { literalNode . literalNode  };

   145 		yourself.

   146 	

   147 	actionNode := PPCSymbolActionNode new

   148 		symbol: #second;

   149 		child: seqNode;

   150 		yourself.

   151 	

   152 	node := PPCNotNode new

   153 		child: actionNode;

   154 		yourself.

   155 		

   156 	result := visitor visit: node.

   157 	

   158 	self assert: result type: PPCNotNode.

   159 	

   160 	self assert: result child type: PPCTokenSequenceNode.

   161 	self assert: result child firstChild type: PPCLiteralNode.

   162 	self assert: result child secondChild type: PPCLiteralNode.		

   163 !

   164 

   165 testStarMessagePredicate

   166 	| starNode |

   167 	starNode := PPCStarMessagePredicateNode new

   168 		message: #isLetter;

   169 		yourself.

   170 	

   171 	node := PPCTokenNode new

   172 		child: starNode;

   173 		yourself.

   174 	

   175 	result := visitor visit: node.

   176 	

   177 	self assert: result type: PPCTokenStarMessagePredicateNode.

   178 !

   179 

   180 testTokenSequence1

   181 	| letterNode1 letterNode2 |

   182 	letterNode1 := PPCCharacterNode new character: $a.

   183 	letterNode2 := PPCCharacterNode new character: $b.

   184 	

   185 	node := PPCSequenceNode new

   186 		children: { letterNode1 . letterNode2 };

   187 		yourself.

   188 	result := visitor visit: node.

   189 	

   190 	self assert: result type: PPCTokenSequenceNode.

   191 	self assert: result firstChild = letterNode1.

   192 	self assert: result secondChild = letterNode2.

   193 ! !

   194