compiler/tests/PPCNodeTest.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Mon, 24 Nov 2014 00:09:23 +0000
changeset 421 7e08b31e0dae
parent 405 0470a5e6e712
child 422 116d2b2af905
permissions -rw-r--r--
Merged JK's version from Monticello Name: PetitParser-JanKurs.260 Author: JanKurs Time: 17-11-2014, 12:09:05.490 PM UUID: 07411cef-ef69-40db-9d93-d4018a9b34ef Name: PetitTests-JanKurs.65 Author: JanKurs Time: 17-11-2014, 12:09:04.530 PM UUID: f98d613f-f4ce-4e0e-a7e9-310ee7c7e7a6 Name: PetitSmalltalk-JanKurs.78 Author: JanKurs Time: 14-11-2014, 05:05:07.765 PM UUID: 3d68330d-44d5-46c3-9705-97f627b3edbc Name: PetitCompiler-JanKurs.71 Author: JanKurs Time: 18-11-2014, 09:48:35.425 AM UUID: 06352c33-3c76-4382-8536-0cc48e225117 Name: PetitCompiler-Tests-JanKurs.21 Author: JanKurs Time: 17-11-2014, 05:51:53.134 PM UUID: 8d6c0799-14e7-4871-8d91-8b0f9886db83 Name: PetitCompiler-Benchmarks-JanKurs.2 Author: JanKurs Time: 17-11-2014, 05:51:07.887 PM UUID: d5e3a980-7871-487a-a232-e3ca93fc2483

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

TestCase subclass:#PPCNodeTest
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Tests-Nodes'
!


!PPCNodeTest methodsFor:'as yet unclassified'!

testCopy
	| n1 n2 |
	n1 := PPCDelegateNode new
		child: #foo;
		yourself.
	n2 := n1 copy.
	self assert: (n1 = n2).
	
	n2 child: #bar.
	self assert: (n1 = n2) not.
!

testCopy2
	| n1 n2 |
	n1 := PPCSequenceNode new
		children: (Array with: #foo with: #bar);
		yourself.
	n2 := n1 copy.
	self assert: (n1 = n2).
	
	n2 children at: 1 put: #zorg.
	self assert: (n1 = n2) not.
!

testEquals
	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.
! !

!PPCNodeTest methodsFor:'test support'!

assert: object type: class
	self assert: object class == class
! !

!PPCNodeTest methodsFor:'tests - converting'!

testConvertBlock
	| parser tree |
	parser := [ :ctx | [ctx atEnd] whileFalse ] asParser.
	tree := parser asCompilerTree.
	
	self assert: tree type: PPCPluggableNode.
	self assert: tree block asString = '[ :ctx | [ ctx atEnd ] whileFalse ]'.
!

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.
!

testConvertNil
	| 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.
!

testConvertToken
	| 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.
!

testConvertTrimmingToken
	| parser tree |
	parser := 'foo' asParser trimmingToken.
	tree := parser asCompilerTree optimizeTree.
	
	self assert: tree type: PPCTrimmingTokenNode.
	self assert: tree child type: PPCInlineLiteralNode.
	self assert: (tree whitespace allNodes allSatisfy: [ :n | n isKindOf: PPCNode ]).

	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: PPCInlineTokenStarSeparatorNode.
	
	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: PPCInlineCharacterNode.
! !

!PPCNodeTest methodsFor:'tests - epsilon'!

testActionAcceptsEpsilon
	| 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.
!

testLiteralAcceptsEpsilon
	| 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.
!

testSequenceAcceptsEpsilon
	| 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.
!

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.
! !

!PPCNodeTest class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !