diff -r 54b3bc9e3987 -r 20598d7ce9fa compiler/tests/PPCInliningVisitorTest.st --- /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 " +! + +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. +! ! +