tests/PPContextMementoTest.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Mon, 24 Nov 2014 00:09:23 +0000
changeset 421 7e08b31e0dae
parent 377 6112a403a52d
child 427 a7f5e6de19d2
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/tests' }"

TestCase subclass:#PPContextMementoTest
	instanceVariableNames:'memento'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitTests-Tests'
!


!PPContextMementoTest methodsFor:'accessing'!

memento
	^ PPContextMemento new
! !

!PPContextMementoTest methodsFor:'running'!

setUp
	memento := self memento.
! !

!PPContextMementoTest methodsFor:'tests'!

testEquality
	| m1 m2  |
	m1 := self memento.
	m2 := self memento.
	
	self assert: m1 = m2.
	
	m1 propertyAt: #foo put: #bar.
	self assert: (m1 = m2) not.
	
	m2 propertyAt: #foo put: #bar.
	self assert: m1 = m2.
!

testEquality2
	| m1 m2  |
	m1 := self memento.
	m2 := self memento.
	
	self assert: m1 = m2.
	
	m1 propertyAt: #foo put: #bar.
	self assert: (m1 = m2) not.
	
	m2 propertyAt: #bar put: #foo.
	self assert: (m1 = m2) not.
!

testGetProperty
	
	| c retval retval2 |
	c := OrderedCollection new.
	
	memento propertyAt: #foo put: c.
	
	retval := memento propertyAt: #foo.
	self assert: retval size = c size.
	self assert: (retval == c) not.
	self assert: retval = c.
	
	c add: #element.
	self assert: (retval = c) not.

	retval2 := memento propertyAt: #foo.
	self assert: (retval = retval2).
	self assert: (retval == retval2) not.
	
	retval add: #element.
	self assert: (retval = retval2) not.
!

testKeysAndValuesDo
	|   |
	memento keysAndValuesDo: [ :key :value |
		self signalFailure: 'Should not be called'
	].
!

testKeysAndValuesDo2
	| c1 c2   |
	c1 := OrderedCollection new.
	c2 := OrderedCollection new.

	memento propertyAt: #foo put: c1.
	memento propertyAt: #bar put: c2.

	memento keysAndValuesDo: [ :key :value |
		self assert: (value == c1) not.
		self assert: (value == c2) not.
	].
!

testPutProperty
	| c retval  |
	c := OrderedCollection new.
	self assert: (memento hasProperty: #foo) not.
	self assert: (memento hasProperty: #bar) not.	
	
	self should: [ memento propertyAt: #foo ] raise: Error.
	self assert: (memento propertyAt: #foo ifAbsent: [ c ]) == c.
	
	retval := memento propertyAt: #foo ifAbsentPut: [ c ].
	self assert: retval size = c size.	
	self assert: (retval == c) not.
	self assert: retval = c.
	self assert: (memento hasProperty: #foo).
	
	retval := memento propertyAt: #bar put: c.
	self assert: retval size = c size.	
	self assert: (retval == c) not.
	self assert: retval = c.
	self assert: (memento hasProperty: #foo).	
! !

!PPContextMementoTest class methodsFor:'documentation'!

version_HG

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