--- a/compiler/tests/PPCNodeTest.st Tue May 05 16:25:23 2015 +0200
+++ b/compiler/tests/PPCNodeTest.st Sun May 10 06:46:56 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
TestCase subclass:#PPCNodeTest
- instanceVariableNames:'node'
+ instanceVariableNames:'node configuration'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Tests-Nodes'
@@ -12,256 +12,551 @@
!PPCNodeTest methodsFor:'as yet unclassified'!
+testAllNodesDo1
+ | node1 node2 parser allChildren |
+ node1 := #letter asParser asCompilerNode.
+ node2 := #letter asParser asCompilerNode.
+ parser := PPChoiceParser new
+ setParsers: { node1 . node2 };
+ yourself.
+
+ node := PPCUnknownNode new
+ parser: parser;
+ yourself.
+
+ self assert: node parser children first == node1.
+ self assert: node parser children second == node2.
+
+ allChildren := OrderedCollection new.
+ node allNodesDo: [ :e |
+ allChildren add: e.
+ ].
+ self assert: allChildren size = 3.
+
+!
+
testCopy
- | newNode |
- node := PPCDelegateNode new
- child: #foo;
- yourself.
- newNode := node copy.
- self assert: (node = newNode).
- self assert: (node hash = newNode hash).
-
- newNode child: #bar.
- self assert: (node = newNode) not.
+ | newNode |
+ node := PPCDelegateNode new
+ child: #foo;
+ yourself.
+ newNode := node copy.
+ self assert: (node = newNode).
+ self assert: (node hash = newNode hash).
+
+ newNode child: #bar.
+ self assert: (node = newNode) not.
!
testCopy2
- | newNode |
- node := PPCSequenceNode new
- children: { #foo . #bar }
- yourself.
- newNode := node copy.
+ | newNode |
+ node := PPCSequenceNode new
+ children: { #foo . #bar }
+ yourself.
+ newNode := node copy.
- self assert: (node = newNode).
- self assert: (node hash = newNode hash).
-
- node children at: 1 put: #zorg.
- self assert: (node = newNode) not.
+ self assert: (node = newNode).
+ self assert: (node hash = newNode hash).
+
+ node children at: 1 put: #zorg.
+ self assert: (node = newNode) not.
!
testCopy3
- | newNode |
- node := PPCMessagePredicateNode new
- predicate: #block;
- message: #message;
- yourself.
-
- newNode := node copy.
-
- self assert: (node == newNode) not.
- self assert: (node = newNode).
- self assert: node hash = newNode hash.
+ | newNode |
+ node := PPCMessagePredicateNode new
+ predicate: #block;
+ message: #message;
+ yourself.
+
+ newNode := node copy.
+
+ self assert: (node == newNode) not.
+ self assert: (node = newNode).
+ self assert: node hash = newNode hash.
!
testCopy4
- | node1 node2 |
- node1 := #letter asParser asCompilerNode.
- node2 := #letter asParser asCompilerNode.
-
- self assert: (node == node2) not.
- self assert: (node1 = node2).
- self assert: node1 hash = node2 hash.
+ | node1 node2 |
+ node1 := #letter asParser asCompilerNode.
+ node2 := #letter asParser asCompilerNode.
+
+ self assert: (node == node2) not.
+ self assert: (node1 = node2).
+ self assert: node1 hash = node2 hash.
+!
+
+testCopy5
+ | node1 newNode |
+ node1 := #letter asParser asCompilerNode.
+
+ node := PPCUnknownNode new
+ parser: node1;
+ yourself.
+
+ self assert: node parser == node1.
+ newNode := node copy.
+ self assert: (newNode parser == node1) not.
+ self assert: newNode parser = node1.
!
testEquals
- self assert: (PPCNode new = PPCNode new).
+ self assert: (PPCNode new = PPCNode new).
!
testEquals2
- | n1 n2 n3 |
- n1 := PPCDelegateNode new
- child: #foo;
- yourself.
- n2 := PPCDelegateNode new
- child: #bar;
- yourself.
- n3 := PPCDelegateNode new
- child: #foo;
- yourself.
-
- self assert: (n1 = n3).
- self assert: (n1 = n2) not.
+ | n1 n2 n3 |
+ n1 := PPCDelegateNode new
+ child: #foo;
+ yourself.
+ n2 := PPCDelegateNode new
+ child: #bar;
+ yourself.
+ n3 := PPCDelegateNode new
+ child: #foo;
+ yourself.
+
+ self assert: (n1 = n3).
+ self assert: (n1 = n2) not.
!
testReplaceNode
- | literalNode anotherLiteralNode |
- literalNode := PPCLiteralNode new
- literal: 'foo';
- yourself.
-
- anotherLiteralNode := PPCLiteralNode new
- literal: 'bar';
- yourself.
-
- node := PPCForwardNode new
- child: literalNode;
- yourself.
-
- self assert: node child == literalNode.
- node replace: literalNode with: anotherLiteralNode.
- self assert: node child == anotherLiteralNode.
- self assert: (node child == literalNode) not.
+ | literalNode anotherLiteralNode |
+ literalNode := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+
+ anotherLiteralNode := PPCLiteralNode new
+ literal: 'bar';
+ yourself.
+
+ node := PPCForwardNode new
+ child: literalNode;
+ yourself.
+
+ self assert: node child == literalNode.
+ node replace: literalNode with: anotherLiteralNode.
+ self assert: node child == anotherLiteralNode.
+ self assert: (node child == literalNode) not.
! !
!PPCNodeTest methodsFor:'test support'!
assert: object type: class
- self assert: object class == class
+ self assert: object class == class
+!
+
+setUp
+ configuration := PPCConfiguration default.
+ configuration arguments generate: false.
+!
+
+treeFrom: parser
+ ^ parser compileWithConfiguration: configuration
! !
!PPCNodeTest methodsFor:'tests - converting'!
testConvertBlock
- | parser tree |
- parser := [ :ctx | [ctx atEnd] whileFalse ] asParser.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCPluggableNode.
+ | parser tree |
+ parser := [ :ctx | [ctx atEnd] whileFalse ] asParser.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCPluggableNode.
((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[
- self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'.
+ self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'.
]
"Modified: / 05-05-2015 / 16:24:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testConvertChoice
- | parser tree |
- parser := 'foo' asParser / $b asParser.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCChoiceNode.
- self assert: tree children size = 2.
- self assert: tree children first type: PPCLiteralNode.
- self assert: tree children second type: PPCCharacterNode.
+ | parser tree |
+ parser := 'foo' asParser / $b asParser.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCChoiceNode.
+ self assert: tree children size = 2.
+ self assert: tree children first type: PPCLiteralNode.
+ self assert: tree children second type: PPCCharacterNode.
!
testConvertNil
- | parser tree |
- parser := nil asParser.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCNilNode.
+ | parser tree |
+ parser := nil asParser.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCNilNode.
!
testConvertSequence
- | parser tree |
- parser := 'foo' asParser, $b asParser.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCSequenceNode.
- self assert: tree children size = 2.
- self assert: tree children first type: PPCLiteralNode.
- self assert: tree children second type: PPCCharacterNode.
+ | parser tree |
+ parser := 'foo' asParser, $b asParser.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCSequenceNode.
+ self assert: tree children size = 2.
+ self assert: tree children first type: PPCLiteralNode.
+ self assert: tree children second type: PPCCharacterNode.
!
testConvertToken
- | parser tree |
- parser := 'foo' asParser token.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCTokenNode.
- self assert: tree child type: PPCLiteralNode.
+ | parser tree |
+ parser := 'foo' asParser token.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCTokenNode.
+ self assert: tree child type: PPCLiteralNode.
- parser := ('foo' asParser, $b asParser) token.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCTokenNode.
- self assert: tree child type: PPCSequenceNode.
-
- parser := $d asParser token star.
- tree := parser asCompilerTree.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCTokenNode.
- self assert: tree child child type: PPCCharacterNode.
+ parser := ('foo' asParser, $b asParser) token.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCTokenNode.
+ self assert: tree child type: PPCSequenceNode.
+
+ parser := $d asParser token star.
+ tree := parser asCompilerTree.
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCTokenNode.
+ self assert: tree child child type: PPCCharacterNode.
!
testConvertTrimmingToken
- | parser tree |
- parser := 'foo' asParser trimmingToken.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCLiteralNode.
- self assert: tree child isMarkedForInline.
- self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
+ | parser tree |
+ parser := 'foo' asParser trimmingToken.
+ tree := self treeFrom: parser.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCLiteralNode.
+ self assert: tree child isMarkedForInline.
+ self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).
!
testConvertTrimmingToken2
- | parser tree |
- parser := ('foo' asParser, $b asParser) trimmingToken.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCTrimmingTokenNode.
- self assert: tree child type: PPCTokenSequenceNode.
- self assert: tree whitespace type: PPCTokenStarSeparatorNode.
- self assert: tree whitespace isMarkedForInline.
+ | parser tree |
+ parser := ('foo' asParser, $b asParser) trimmingToken.
+ tree := self treeFrom: parser.
+
+ self assert: tree type: PPCTrimmingTokenNode.
+ self assert: tree child type: PPCRecognizingSequenceNode.
+ self assert: tree whitespace type: PPCTokenStarSeparatorNode.
+ self assert: tree whitespace isMarkedForInline.
!
testConvertTrimmingToken3
- | parser tree |
-
- parser := $d asParser trimmingToken star.
- tree := parser asCompilerTree optimizeTree.
-
- self assert: tree type: PPCStarNode.
- self assert: tree child type: PPCTrimmingTokenNode.
- self assert: tree child child type: PPCCharacterNode.
- self assert: tree child child isMarkedForInline.
+ | parser tree |
+
+ parser := $d asParser trimmingToken star.
+ tree := self treeFrom: parser.
+
+ self assert: tree type: PPCStarNode.
+ self assert: tree child type: PPCTrimmingTokenNode.
+ self assert: tree child child type: PPCCharacterNode.
+ self assert: tree child child isMarkedForInline.
! !
!PPCNodeTest methodsFor:'tests - epsilon'!
testActionAcceptsEpsilon
- | tree |
- tree := ('foo' asParser token optional ==> [ :e | e ]) asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := ('foo' asParser token optional ==> [ :e | e ]) asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testChoiceAcceptsEpsilon
- | tree |
- tree := ($a asParser / $b asParser star) asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := ($a asParser / $b asParser star) asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testLiteralAcceptsEpsilon
- | tree |
- tree := 'foo' asParser asCompilerTree.
- self assert: tree acceptsEpsilon not.
-
- tree := '' asParser asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := 'foo' asParser asCompilerTree.
+ self assert: tree acceptsEpsilon not.
+
+ tree := '' asParser asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testPlusAcceptsEpsilon
- | tree |
- tree := ($b asParser plus) asCompilerTree.
- self assert: tree acceptsEpsilon not.
-
- tree := #letter asParser plus asCompilerTree.
- self assert: tree acceptsEpsilon not.
+ | tree |
+ tree := ($b asParser plus) asCompilerTree.
+ self assert: tree acceptsEpsilon not.
+
+ tree := #letter asParser plus asCompilerTree.
+ self assert: tree acceptsEpsilon not.
!
testSequenceAcceptsEpsilon
- | tree parser |
- parser := 'foo' asParser token optional, 'bar' asParser token star, ($a asParser / $b asParser star).
- tree := parser asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree parser |
+ parser := 'foo' asParser token optional, 'bar' asParser token star, ($a asParser / $b asParser star).
+ tree := parser asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testStarAcceptsEpsilon
- | tree |
- tree := $b asParser star asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := $b asParser star asCompilerTree.
+ self assert: tree acceptsEpsilon.
!
testTokenAcceptsEpsilon
- | tree |
- tree := ($a asParser / $b asParser plus) token asCompilerTree.
- self assert: tree acceptsEpsilon not.
-
- tree := ($a asParser / $b asParser star) token asCompilerTree.
- self assert: tree acceptsEpsilon.
+ | tree |
+ tree := ($a asParser / $b asParser plus) token asCompilerTree.
+ self assert: tree acceptsEpsilon not.
+
+ tree := ($a asParser / $b asParser star) token asCompilerTree.
+ self assert: tree acceptsEpsilon.
+!
+
+testTrimNode
+ | tree |
+ tree := $a asParser trim asCompilerTree.
+ self assert: tree type: PPCTrimNode.
+ self assert: tree child type: PPCCharacterNode.
+ self assert: tree trimmer type: PPCStarNode.
+! !
+
+!PPCNodeTest methodsFor:'tests - recognized sentences'!
+
+assert: array anySatisfy: block
+ self assert: (array anySatisfy: block)
+!
+
+testOverlapCharacterNode
+ | node1 node2 |
+ node1 := $a asParser asCompilerTree.
+ node2 := $b asParser asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapCharacterNode2
+ | node1 node2 |
+ node1 := $a asParser asCompilerTree.
+ node2 := $a asParser asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode1
+ | node1 node2 |
+ node1 := $a asParser asCompilerTree.
+ node2 := $a asParser asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode2
+ | node1 node2 |
+ node1 := $a asParser asCompilerTree.
+ node2 := 'a' asParser asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode3
+ | node1 node2 |
+ node1 := ($a asParser / $b asParser) asCompilerTree.
+ node2 := ('c' asParser / 'd' asParser) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapNode4
+ | node1 node2 |
+ node1 := ($a asParser / $b asParser) asCompilerTree.
+ node2 := ('c' asParser / #any asParser) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode5
+ | node1 node2 |
+ node1 := ($a asParser, $b asParser) asCompilerTree.
+ node2 := ('ab' asParser) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapNode6
+ | node1 node2 |
+ node1 := ($a asParser, $b asParser, $c asParser) asCompilerTree.
+ node2 := ('ab' asParser) asCompilerTree.
+
+ self flag: 'Not sure about this test...'.
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapNode7
+ | node1 node2 |
+ node1 := ($a asParser) asCompilerTree.
+ node2 := (#digit asParser) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapNode8
+ | node1 node2 |
+ node1 := ($a asParser) asCompilerTree.
+ node2 := (#digit asParser plus) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapNode9
+ | node1 node2 |
+ node1 := ($a asParser) asCompilerTree.
+ node2 := (#letter asParser plus) asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapTokenNode
+ | node1 node2 |
+ node1 := $a asParser token asCompilerTree.
+ node2 := $b asParser token asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapTokenNode2
+ | node1 node2 |
+ node1 := $a asParser token asCompilerTree.
+ node2 := $a asParser token asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testOverlapTrimmingTokenNode
+ | node1 node2 |
+ node1 := $a asParser token trim asCompilerTree.
+ node2 := $b asParser token trim asCompilerTree.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapTrimmingTokenNode1
+ | node1 node2 |
+ node1 := PPCTrimmingTokenNode new
+ child: (PPCCharacterNode new character: $a; yourself);
+ yourself.
+ node2 := PPCTrimmingTokenNode new
+ child: (PPCCharacterNode new character: $b; yourself);
+ yourself.
+
+ self assert: (node1 overlapsWith: node2) not.
+!
+
+testOverlapTrimmingTokenNode2
+ | node1 node2 |
+ node1 := PPCTrimmingTokenNode new
+ child: (PPCCharacterNode new character: $a; yourself);
+ yourself.
+ node2 := PPCTrimmingTokenNode new
+ child: (PPCCharacterNode new character: $a; yourself);
+ yourself.
+
+ self assert: (node1 overlapsWith: node2).
+!
+
+testRSCharacterNode
+ | sentences |
+ node := PPCCharacterNode new
+ character: $f;
+ yourself.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 1.
+ self assert: sentences anyOne = 'f'.
+!
+
+testRSChoiceNode
+ | sentences |
+ node := ('a' asParser / 'b' asParser) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 2.
+ self assert: sentences anySatisfy: [ :e | e = 'a' ].
+ self assert: sentences anySatisfy: [ :e | e = 'b' ].
+!
+
+testRSChoiceNode2
+ | sentences |
+ node := ('a' asParser / 'a' asParser) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 1.
+ self assert: sentences anySatisfy: [ :e | e = 'a' ].
+!
+
+testRSLiteralNode
+ | sentences |
+ node := PPCLiteralNode new
+ literal: 'foo';
+ yourself.
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 1.
+ self assert: sentences anyOne = 'foo'.
+!
+
+testRSPredicateNode
+ | sentences |
+ node := PPCPredicateNode new
+ predicate: (PPCharSetPredicate on: [:e | e isDigit]);
+ yourself.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 10.
+ self assert: sentences anySatisfy: [ :e | e = '0' ].
+!
+
+testRSSequenceNode
+ | sentences |
+ node := ('a' asParser, 'b' asParser) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 1.
+ self assert: sentences anySatisfy: [ :e | e = 'ab' ].
+!
+
+testRSSequenceNode2
+ | sentences |
+ node := ('a' asParser, ('b' asParser / 'c' asParser)) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 2.
+ self assert: sentences anySatisfy: [ :e | e = 'ab' ].
+ self assert: sentences anySatisfy: [ :e | e = 'ac' ].
+!
+
+testRSSequenceNode3
+ | sentences |
+ node := (#digit asParser, #digit asParser) asCompilerTree.
+
+ self assert: node hasFiniteLanguage.
+
+ sentences := node recognizedSentences.
+ self assert: sentences size = 100.
+ self assert: sentences anySatisfy: [ :e | e = '00' ].
+ self assert: sentences anySatisfy: [ :e | e = '99' ].
+ self assert: sentences anySatisfy: [ :e | e = '38' ].
+
! !
!PPCNodeTest class methodsFor:'documentation'!