'From Squeak4.1 of 12 May 2010 [latest update: #10143] on 23 September 2010 at 8:37:33 pm'!
ClassTestCase subclass: #WeakRegistryTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CollectionsTests-Weak'!

!WeakRegistryTest methodsFor: 'tests' stamp: 'ar 4/6/2010 22:31'!
testFinalization

	| w finalized block object |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := ObjectFinalizer "an object that responds to #finalize"
		receiver: block
		selector: #value:
		argument: true.
	w add: object.
	object := nil. "let it go"
	Smalltalk garbageCollect. "finalize it"

	"This is an odd issue. It seems that in some situations the finalization
	process doesn't run 'in time' for the isEmpty assertion below to succeed.
	This really *shouldn't* happen since isEmpty is full of real sends and
	there ought to be an interrupt check in there somewhere. However,
	since there are no real-time guarantees about finalization, it's fair to
	just wait a little to ensure that the finalization process has been run."
	(Delay forMilliseconds: 100) wait.

	self assert: w isEmpty.
	self assert: finalized! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 13:59'!
testFinalizationWithMultipleFinalizersPerObject

	| object registry counter |
	registry := WeakRegistry new.
	object := Object new.
	counter := 0.
	5 timesRepeat: [
		registry add: object executor: (ObjectFinalizer
			receiver: [ counter := counter + 1 ]
			selector: #value) ].
	self assert: registry size = 1.
	object := nil. 
	Smalltalk garbageCollect.
	registry finalizeValues.
	self assert: registry isEmpty.
	self assert: counter = 5
! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 14:50'!
testGrowingByAHighPriorityProcessDoesntLeak

	| w finalized block object executor semaphore |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := Object new.
	executor := ObjectFinalizer
		receiver: block
		selector: #value:
		argument: true.
	w add: object executor: executor.
	semaphore := Semaphore new.
	[ 
		object := nil. "let it go"
		w addAll: (1 to: 1000). "force growing"
		semaphore signal ] 
			forkAt: WeakArray runningFinalizationProcess priority + 1.
	semaphore wait.
	Smalltalk garbageCollect. "finalize it"
	self assert: w size = 1000.
	self assert: finalized! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 14:50'!
testGrowingDoesntLeak

	| w finalized block object executor |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := Object new.
	executor := ObjectFinalizer
		receiver: block
		selector: #value:
		argument: true.
	w add: object executor: executor.
	object := nil. "let it go"
	w addAll: (1 to: 1000). "force growing"
	Smalltalk garbageCollect. "finalize it"
	self assert: w size = 1000.
	self assert: finalized! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 14:50'!
testRemovingByAHighPriorityProcessDoesntLeak

	| w finalized block hash object executor semaphore |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := Object new.
	executor := ObjectFinalizer
		receiver: block
		selector: #value:
		argument: true.
	hash := object hash.
	w add: hash.
	w add: object executor: executor.
	semaphore := Semaphore new.
	[ 
		object := nil. "let it go"
		w remove: hash.
		semaphore signal ] 
			forkAt: WeakArray runningFinalizationProcess priority + 1.
	semaphore wait.
	Smalltalk garbageCollect. "finalize it"
	self assert: w isEmpty.
	self assert: finalized! !

!WeakRegistryTest methodsFor: 'tests' stamp: 'ul 2/26/2010 14:46'!
testRemovingDoesntLeak

	| w finalized block hash object executor |
	w := WeakRegistry new: 1.
	finalized := false.
	block := [ :v | finalized := v ].
	object := Object new.
	executor := ObjectFinalizer
		receiver: block
		selector: #value:
		argument: true.
	hash := object hash.
	w add: hash.
	w add: object executor: executor.
	object := nil. "let it go"
	w remove: hash.
	Smalltalk garbageCollect. "finalize it"
	self assert: w isEmpty.
	self assert: finalized! !