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