'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 12 June 2008 at 1:03:19 pm'!
!classDefinition: #ProcessorTest category: #'System Tests'!
TestCase subclass: #ProcessorTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System Tests'!

!BlockContext methodsFor: 'private' stamp: 'jmv 6/12/2008 13:01'!
grabProcessor
	"Grab the CPU above most application processes and evaluate.
	Return to usual proprity after that."

	^self grabProcessorFor: nil onTimeout: nil! !

!BlockContext methodsFor: 'private' stamp: 'jmv 6/12/2008 13:01'!
grabProcessorFor: milliseconds onTimeout: timeoutBlock
	"Evaluate the receiver (block), without the possibility of preemption by regular priority processes.
	If not finished after milliseconds, restore original priority and evaluate timeoutBlock.
	Use with care!!"
	"Based on #valueUnpreemptively"
	
	| activeProcess oldPriority result done |
	activeProcess _ Processor activeProcess.
	oldPriority _ activeProcess priority.
	done _ false.
	
	activeProcess priority: Processor highIOPriority + Processor lowIOPriority // 2.
	milliseconds notNil ifTrue: [
		[
			(Delay forMilliseconds: milliseconds) wait.
			done ifFalse: [
				activeProcess priority: oldPriority.
				timeoutBlock value ]
		] forkAt: Processor highIOPriority ].

	result _ self ensure: [
		done _ true.
		activeProcess priority: oldPriority].
	
	"Yield after restoring priority to give the preempted processes a chance to run"
	Processor yield.
	^result! !

!BlockContext methodsFor: 'private' stamp: 'jmv 6/12/2008 13:01'!
grabProcessorOnlyFor: milliseconds
	"Grab the CPU above most application processes and evaluate, but only for some milliseconds.
	Return to usual prority after that and finish evaluation if incomplete."

	^self grabProcessorFor: milliseconds onTimeout: []! !


!ProcessorTest methodsFor: 'as yet unclassified' stamp: 'jmv 6/12/2008 13:02'!
testGrabProcessor
	| done semaphore consistentState tries updates observations meanInterval |
	done _ false.
	semaphore _ Semaphore new.
	consistentState _ true.
	tries _ 20.
	updates _ 0.
	[
		[ done ] whileFalse: [
			semaphore wait.
			[
				consistentState _ false.
				1000 atRandom timesRepeat: [1.23 asString asNumber].
				updates _ updates + 1.
				consistentState _ true
			] grabProcessor
		]
	] forkAt: Processor userBackgroundPriority.

	[
		tries timesRepeat: [
			(Delay forMilliseconds: 5) wait.
			semaphore signal].
		done _ true
	] forkAt: Processor userInterruptPriority.

	observations _ 0.
	[ done ] whileFalse: [
		(Delay forMilliseconds: 50) wait.
		observations _ observations + 1.
		self assert: consistentState description: 'The low priority process was preempted in inconsistent state!!'
	].
	meanInterval _ 1.0 * updates / observations.
	self 
		assert: meanInterval * 3 + updates > tries
		description: 'Too few updates done. It seems as if the low priority process was not allowed to finish processing'
! !

!ProcessorTest methodsFor: 'as yet unclassified' stamp: 'jmv 6/12/2008 13:02'!
testGrabProcessorOnlyForNoTimeout
	| done semaphore consistentState tries updates observations meanInterval |
	done _ false.
	semaphore _ Semaphore new.
	consistentState _ true.
	tries _ 20.
	updates _ 0.
	[
		[ done ] whileFalse: [
			semaphore wait.
			[
				consistentState _ false.
				1000 atRandom timesRepeat: [1.23 asString asNumber].
				updates _ updates + 1.
				consistentState _ true
			] grabProcessorOnlyFor: 1000
		]
	] forkAt: Processor userBackgroundPriority.

	[
		tries timesRepeat: [
			(Delay forMilliseconds: 5) wait.
			semaphore signal].
		done _ true
	] forkAt: Processor userInterruptPriority.

	observations _ 0.
	[ done ] whileFalse: [
		(Delay forMilliseconds: 50) wait.
		observations _ observations + 1.
		self assert: consistentState description: 'The low priority process was preempted in inconsistent state!!'
	].
	meanInterval _ 1.0 * updates / observations.
	self 
		assert: meanInterval * 3 + updates > tries
		description: 'Too few updates done. It seems as if the low priority process was not allowed to finish processing'
! !

!ProcessorTest methodsFor: 'as yet unclassified' stamp: 'jmv 6/12/2008 13:02'!
testGrabProcessorOnlyForTimeout
	| done semaphore consistentState tries updates observations meanInterval allConsistent |
	done _ false.
	semaphore _ Semaphore new.
	consistentState _ true.
	tries _ 20.
	updates _ 0.
	allConsistent _ true.
	[
		[ done ] whileFalse: [
			semaphore wait.
			[
				consistentState _ false.
				1000 atRandom timesRepeat: [1.23 asString asNumber].
				updates _ updates + 1.
				consistentState _ true
			] grabProcessorOnlyFor: 1
		]
	] forkAt: Processor userBackgroundPriority.

	[
		tries timesRepeat: [
			(Delay forMilliseconds: 5) wait.
			semaphore signal].
		done _ true
	] forkAt: Processor userInterruptPriority.

	observations _ 0.
	[ done ] whileFalse: [
		(Delay forMilliseconds: 50) wait.
		observations _ observations + 1.
		allConsistent _ allConsistent & consistentState.
	].
	self deny: allConsistent description: 'The low priority process was not preempted. Timout did not occur.'.
	meanInterval _ 1.0 * updates / observations.
	self 
		assert: meanInterval * 3 + updates < tries
		description: 'Too much updates done. It seems as if the low priority process did not timeout.'
! !

!ProcessorTest methodsFor: 'as yet unclassified' stamp: 'jmv 6/12/2008 12:50'!
testValueUnpreemptively
	| done semaphore consistentState tries updates observations meanInterval |
	done _ false.
	semaphore _ Semaphore new.
	consistentState _ true.
	tries _ 20.
	updates _ 0.
	[
		[ done ] whileFalse: [
			semaphore wait.
			[
				consistentState _ false.
				1000 atRandom timesRepeat: [1.23 asString asNumber].
				updates _ updates + 1.
				consistentState _ true
			] valueUnpreemptively
		]
	] forkAt: Processor userBackgroundPriority.

	[
		tries timesRepeat: [
			(Delay forMilliseconds: 5) wait.
			semaphore signal].
		done _ true
	] forkAt: Processor userInterruptPriority.

	observations _ 0.
	[ done ] whileFalse: [
		(Delay forMilliseconds: 50) wait.
		observations _ observations + 1.
 		self assert: consistentState description: 'The low priority process was preempted in inconsistent state!!'
	].
	meanInterval _ 1.0 * updates / observations.
	self 
		assert: meanInterval * 3 + updates > tries
		description: 'Too few updates done. It seems as if the low priority process was not allowed to finish processing'
! !

