compiler/tests/PPCInliningVisitorTest.st
changeset 438 20598d7ce9fa
child 444 a3657ab0ca6b
child 452 9f4558b3be66
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCInliningVisitorTest.st	Thu Apr 30 23:43:14 2015 +0200
@@ -0,0 +1,174 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestCase subclass:#PPCInliningVisitorTest
+	instanceVariableNames:'node result visitor'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-Visitors'
+!
+
+!PPCInliningVisitorTest methodsFor:'as yet unclassified'!
+
+assert: object type: class
+	self assert: object class == class
+!
+
+setUp
+	visitor := PPCInliningVisitor new.
+!
+
+testCharacterNode
+	node := PPCCharacterNode new
+		character: $a;
+		yourself.
+	result := visitor visit: node.
+	
+	self assert: result type: PPCCharacterNode.
+	self assert: result isMarkedForInline not.
+	self assert: result character = $a.
+!
+
+testCharacterNode2
+	| charNode |
+	charNode := PPCCharacterNode new
+		character: $a;
+		yourself.
+	node := PPCStarNode new
+		child: charNode;
+		yourself.
+	result := visitor visit: node.
+	
+	self assert: result child type: PPCCharacterNode.
+	self assert: result child isMarkedForInline.
+	self assert: result child character = $a.
+!
+
+testLiteralNode
+	| literalNode |
+	literalNode := PPCLiteralNode new
+		literal: 'foo';
+		yourself.
+	node := PPCOptionalNode new
+		child: literalNode;
+		yourself.
+
+	result := visitor visit: node.
+	
+	self assert: result child type: PPCLiteralNode.
+	self assert: result child isMarkedForInline.
+	self assert: result child literal = 'foo'.
+!
+
+testNil
+	node := PPCNilNode new.
+	result := visitor visit: node.
+
+	self assert: result type: PPCNilNode.
+	self assert: result isMarkedForInline not.
+!
+
+testNil2
+	node := PPCStarNode new
+		child: PPCNilNode new;
+		yourself.
+	result := visitor visit: node.
+
+	self assert: result type: PPCStarNode.
+	self assert: result child type: PPCNilNode.
+	self assert: result child isMarkedForInline.
+!
+
+testNotLiteralNode
+	| notLiteralNode |
+
+	notLiteralNode := PPCNotLiteralNode new
+		literal: 'foo';
+		yourself.
+
+	node := PPCOptionalNode new
+		child: notLiteralNode;
+		yourself.
+
+	result := visitor visit: node.
+	
+	self assert: result child type: PPCNotLiteralNode.
+	self assert: result child isMarkedForInline.
+	self assert: result child literal = 'foo'.
+!
+
+testPluggable
+	| pluggableNode |
+	pluggableNode := PPCPluggableNode new
+		block: [:ctx | nil] asParser.
+	node := PPCSequenceNode new
+		children: { pluggableNode  };
+		yourself.
+
+	result := visitor visit: node.
+	    
+	((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:
+	[  
+		self skip: 'skipped test, inlining of pluggable nodes not supported!!'.
+	].
+
+	self assert: result children first type: PPCPluggableNode.
+	self assert: result children first isMarkedForInline.
+
+    "Modified: / 23-04-2015 / 12:18:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testSequenceInline
+	| charNode1 charNode2 |
+	charNode1 := PPCCharacterNode new
+		character: $a;
+		yourself.
+	charNode2 := PPCCharacterNode new
+		character: $b;
+		yourself.
+
+	node := PPCSequenceNode new
+		children: { charNode1 . charNode2 };
+		yourself.
+	result := visitor visit: node.
+	
+	self assert: result type: PPCSequenceNode .
+	self assert: result children first type: PPCCharacterNode.
+	self assert: result children second type: PPCCharacterNode.	
+!
+
+testTokenStarMessagePredicateNode
+	| tokenNode |
+	tokenNode := (PPCTokenStarMessagePredicateNode new)
+		child: PPCSentinelNode new;
+		yourself.
+	node := PPCForwardNode new
+		child: tokenNode;
+		yourself.	
+	result := visitor visit: node.
+	
+	self assert: result child type: PPCTokenStarMessagePredicateNode.
+	self assert: result child isMarkedForInline.
+!
+
+testTokenStarSeparatorNode
+	| tokenNode |
+	tokenNode := (PPCTokenStarSeparatorNode new)
+		name: #name;
+		message: #message;
+		child: PPCNilNode new;
+		yourself.
+
+	node := PPCForwardNode new
+		child: tokenNode;
+		yourself.	
+
+		
+	result := visitor visit: node.
+	
+	self assert: result child type: PPCTokenStarSeparatorNode.
+	self assert: result child isMarkedForInline.
+	self assert: result child child type: PPCNilNode.
+! !
+