"{ 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.

! !