tests/PPContextTest.st
changeset 377 6112a403a52d
child 381 0bbbcf5da2d4
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/PPContextTest.st	Fri Oct 03 02:33:08 2014 +0100
@@ -0,0 +1,175 @@
+"{ Package: 'stx:goodies/petitparser/tests' }"
+
+TestCase subclass:#PPContextTest
+	instanceVariableNames:'context'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitTests-Tests'
+!
+
+!PPContextTest methodsFor:'as yet unclassified'!
+
+context
+	^ PPContext new
+!
+
+setUp
+	context := self context.
+! !
+
+!PPContextTest methodsFor:'tests'!
+
+testFurthestFailure
+	| f1 f2 |
+	
+	f1 := PPFailure message: #foo context: context at: 1.
+	self assert: context furthestFailure = f1.	
+	f2 := PPFailure message: #foo context: context at: 1.
+	self assert: context furthestFailure = f1.	
+	f2 := PPFailure message: #foo context: context at: 3.
+	self assert: context furthestFailure = f2.
+!
+
+testMemoization
+	| stream memento memento2 collection |
+	stream := 'abc' asPetitStream.
+	context := context stream: stream.
+	collection := OrderedCollection new.
+
+	context propertyAt: #foo put: collection.
+	
+	memento := context remember.
+	
+	self assert: memento isNil not.
+	
+	context next.
+	collection add: #element.
+	self assert: (context propertyAt: #foo) size = 1. 	
+
+	memento2 := context remember.
+
+	context restore: memento.
+	self assert: (context propertyAt: #foo) size = 0. 
+	self assert: context position = 0.
+	
+	context restore: memento2.
+	self assert: (context propertyAt: #foo) size = 1. 
+	self assert: context position = 1.
+!
+
+testMemoization2
+	| stream memento |
+	stream := 'abc' asPetitStream.
+	context := context stream: stream.
+	
+	memento := context remember.
+	
+	context next.
+	self assert: context position = 1.
+	
+	context restore: memento.
+	self assert: context position = 0.
+!
+
+testPutGlobals
+	self assert: (context hasGlobal: #foo) not.
+	self assert: (context hasGlobal: #bar) not.	
+	
+	self should: [ context globalAt: #foo ] raise: Error.
+	self assert: (context globalAt: #foo ifAbsent: [ #bar ]) = #bar.
+	
+	self assert: (context globalAt: #foo ifAbsentPut: [ #bar ]) = #bar.	
+	self assert: (context hasGlobal: #foo).
+	self assert: (context hasGlobal: #bar) not.	
+	self assert: (context globalAt: #foo) = #bar.
+	
+	self assert: (context globalAt: #foo ifAbsentPut: [ #zorg ]) = #bar.	
+	self assert: (context hasGlobal: #foo).
+	self assert: (context hasGlobal: #bar) not.	
+	self assert: (context globalAt: #foo) = #bar.
+	
+	self assert: (context globalAt: #foo put: #zorg) = #zorg.	
+	self assert: (context hasGlobal: #foo).
+	self assert: (context hasGlobal: #bar) not.	
+	self assert: (context globalAt: #foo) = #zorg.
+	
+	self should: [ context globalAt: #bar ] raise: Error.
+	self assert: (context globalAt: #bar put: #foo) = #foo.
+	self assert: (context globalAt: #foo) = #zorg.
+	self assert: (context globalAt: #bar) = #foo.
+
+!
+
+testPutProperties
+	self assert: (context hasProperty: #foo) not.
+	self assert: (context hasProperty: #bar) not.	
+	
+	self should: [ context propertyAt: #foo ] raise: Error.
+	self assert: (context propertyAt: #foo ifAbsent: [ #bar ]) = #bar.
+	
+	self assert: (context propertyAt: #foo ifAbsentPut: [ #bar ]) = #bar.	
+	self assert: (context hasProperty: #foo).
+	self assert: (context hasProperty: #bar) not.	
+	self assert: (context propertyAt: #foo) = #bar.
+	
+	self assert: (context propertyAt: #foo ifAbsentPut: [ #zorg ]) = #bar.	
+	self assert: (context hasProperty: #foo).
+	self assert: (context hasProperty: #bar) not.	
+	self assert: (context propertyAt: #foo) = #bar.
+	
+	self assert: (context propertyAt: #foo put: #zorg) = #zorg.	
+	self assert: (context hasProperty: #foo).
+	self assert: (context hasProperty: #bar) not.	
+	self assert: (context propertyAt: #foo) = #zorg.
+	
+	self should: [ context propertyAt: #bar ] raise: Error.
+	self assert: (context propertyAt: #bar put: #foo) = #foo.
+	self assert: (context propertyAt: #foo) = #zorg.
+	self assert: (context propertyAt: #bar) = #foo.
+
+!
+
+testRemoveGlobals
+	context globalAt: #foo put: #zorg.
+	context globalAt: #bar put: #qwark.	
+
+	self assert: (context removeGlobal: #foo) = #zorg.
+	self assert: (context removeGlobal: #bar) = #qwark.
+	
+	self should: [context removeGlobal: #foo] raise: Error.
+	self assert: (context removeGlobal: #bar ifAbsent: [ #foobar ]) = #foobar.
+!
+
+testRemoveProperties
+	context propertyAt: #foo put: #zorg.
+	context propertyAt: #bar put: #qwark.	
+
+	self assert: (context removeProperty: #foo) = #zorg.
+	self assert: (context removeProperty: #bar) = #qwark.
+	
+	self should: [context removeProperty: #foo] raise: Error.
+	self assert: (context removeProperty: #bar ifAbsent: [ #foobar ]) = #foobar.
+!
+
+testStreamProtocol
+	context stream: 'hi there' asPetitStream.
+	
+	self assert: context position = 0.
+	self assert: context peek = $h.
+	self assert: context uncheckedPeek = $h.
+
+	self assert: context next = $h.
+	self assert: context peek = $i.
+	self assert: context uncheckedPeek = $i.
+	self assert: context position = 1.
+	
+	context skip: 2.
+	self assert: context position = 3.
+	self assert: context peek = $t.
+	self assert: context atEnd not.
+	
+	self assert: (context next: 5) = 'there'.
+	self assert: context position = 8.
+	self assert: context atEnd.
+! !
+