[squeak-dev] The Trunk: KernelTests-jar.423.mcz

commits at source.squeak.org commits at source.squeak.org
Mon May 30 15:26:49 UTC 2022


Marcel Taeumel uploaded a new version of KernelTests to project The Trunk:
http://source.squeak.org/trunk/KernelTests-jar.423.mcz

==================== Summary ====================

Name: KernelTests-jar.423
Author: jar
Time: 29 May 2022, 4:27:14.426063 pm
UUID: 20a7b2ce-4161-674d-abd4-e80376bf00f3
Ancestors: KernelTests-nice.422

Update a battery of tests to complement Kernel-jar.1468 and Kernel-jar.1469 (revised suspend and terminate semantics and termination fixes). The update adjusts some tests for the revised suspend, plus adds some more. A few tests will be parked as expected failures as a reminder :)

Supersede KernelTests-jar.421; please remove it from the Inbox.

=============== Diff against KernelTests-nice.422 ===============

Item was added:
+ ----- Method: MutexTest>>expectedFailures (in category 'failures') -----
+ expectedFailures
+ 
+ 	^ #(testUnwindMutexBlockedInCritical)!

Item was added:
+ ----- Method: MutexTest>>testMutexInCriticalEnsureArgument (in category 'tests') -----
+ testMutexInCriticalEnsureArgument "self run: #testMutexInCriticalEnsureArgument"
+ 	"This tests whether a process that is in the ensure argument block in critical: but has yet to evaluate the primitiveExitCriticalSection
+ 	leaves it with the mutex unlocked."
+ 	
+ 	| terminatee mutex |
+ 	mutex := Mutex new.
+ 	terminatee := [mutex critical: []] newProcess.
+ 	self assert: terminatee isSuspended.
+ 	terminatee runUntil: [:ctx | ctx selectorToSendOrSelf = #primitiveExitCriticalSection].
+ 	self assert: terminatee isSuspended.
+ 	terminatee terminate.
+ 	self deny: mutex isOwned.
+ 	self assert: mutex isEmpty!

Item was added:
+ ----- Method: MutexTest>>testUnwindMutexBlockedInCritical (in category 'tests') -----
+ testUnwindMutexBlockedInCritical	"self run: #testMutexBlockedInCritical"
+ 	"This tests whether a mutex that is inside the primitiveEnterCriticalSection in Mutex>>critical:
+ 	leaves it unchanged."
+ 	| lock sock proc wait |
+ 	lock := Mutex new.
+ 	sock := Semaphore new.
+ 	proc := [lock critical: [sock wait]] fork.
+ 	wait := [[] ensure: [lock critical: []]] fork.
+ 	Processor yield.
+ 	self assert: proc suspendingList == sock.
+ 	self assert: wait suspendingList == lock.
+ 	self deny: lock isEmpty.
+ 	self assert: lock isOwned.
+ 	wait terminate.
+ 	Processor yield.
+ 	self assert: wait isTerminated.
+ 	self assert: proc suspendingList == sock.
+ 	self assert: wait suspendingList == nil.
+ 	self assert: lock isEmpty.
+ 	self assert: lock isOwned
+ !

Item was changed:
  ----- Method: Process>>suspendPrimitivelyOrFail (in category '*KernelTests-Processes') -----
  suspendPrimitivelyOrFail
+ 	"Test support. Execute primitive 578, or fail."
- 	"Test support. Execute primitive 88, or fail."
  
+ 	<primitive: 578>
- 	<primitive: 88>
  	^self primitiveFailed!

Item was added:
+ ----- Method: ProcessTest>>expectedFailures (in category 'failures') -----
+ expectedFailures
+ 
+ 	^ #(testTerminateTerminatingProcess testResumeTerminatingProcess)!

Item was changed:
  ----- Method: ProcessTest>>testAtomicSuspend (in category 'tests') -----
  testAtomicSuspend
+ 	"Test atomic suspend of foreign processes.
+ 	Note: this test will fail when run with older VMs without primitive suspend 578."
- 	"Test atomic suspend of foreign processes"
  
  	| list p |
  	p := [semaphore wait] fork.
  	Processor yield.
  	list := p suspendPrimitivelyOrFail.
+ 	self assert: list == nil.
- 	self assert: list == semaphore.
  !

Item was added:
+ ----- Method: ProcessTest>>testResumeTerminatingProcess (in category 'tests') -----
+ testResumeTerminatingProcess
+ 	"An attempt to resume a terminating process should probably raise an error;
+ 	leave this test as an expected failure for the moment."
+ 
+ 	| terminatee terminator resumed semaphore |
+ 	semaphore := Semaphore new.
+ 	terminatee := [semaphore critical:[]. resumed := true] fork.
+ 	Processor yield.
+ 	terminator := [terminatee terminate] newProcess.
+ 	self assert: terminatee suspendingList == semaphore.
+ 	self assert: terminator isSuspended. 
+ 	"run terminator and stop inside #terminate"
+ 	terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:].
+ 	self assert: terminator isSuspended.
+ 	"resume the terminatee process and and check if the VM raises an error;
+ 	an error is expected because terminatee's suspendedContext equals nil"
+ 	self should: [terminatee resume] raise: Error.
+ 	"now let the terminator finish terminating the terminatee process"
+ 	terminator resume.
+ 	Processor yield.
+ 	self assert: resumed isNil.
+ 	self assert: terminatee isTerminated.
+ 	self assert: terminator isTerminated!

Item was added:
+ ----- Method: ProcessTest>>testRevisedSuspendExpectations (in category 'tests') -----
+ testRevisedSuspendExpectations
+ 	"Test revised suspend expectations vs. pre-2022 VM's suspend"
+ 
+ 	| s p list |
+ 	s := Semaphore new.
+ 	p := [s critical:[]] forkAt: Processor activePriority + 1.
+ 	list := p suspend.
+ 
+ 	Smalltalk processSuspensionUnblocks 
+ 		ifFalse: [
+ 			self assert: p suspendingList equals: nil.
+ 			self assert: list equals: nil.
+ 			self deny: p suspendedContext selectorJustSentOrSelf equals: #wait
+ 			]
+ 		ifTrue: [
+ 			self assert: p suspendingList equals: nil.
+ 			self assert: list equals: s.
+ 			self assert: p suspendedContext selectorJustSentOrSelf equals: #wait
+ 			]!

Item was added:
+ ----- Method: ProcessTest>>testTerminateEnsureAsStackTop (in category 'tests') -----
+ testTerminateEnsureAsStackTop
+ 	"Test #ensure unwind block is executed even when #ensure context is on stack's top."
+ 
+ 	| p1 p2 p3 x1 x2 x3 |
+ 	x1 := x2 := x3 := false.
+ 	
+ 	"p1 is at the beginning of the ensure block and the unwind block hasn't run yet"
+ 	p1 := Process
+ 		forBlock: [[] ensure: [x1 := x1 not]]
+ 		runUntil: [:ctx | ctx isUnwindContext and: [(ctx tempAt: 2) isNil]].
+ 	p1 step. p1 step. "move the pc behind the send: valueNoContextSwitch instruction"
+ 
+ 	"p2 has already set complete to true (tempAt: 2) but the unwind block hasn't run yet"
+ 	p2 := Process
+ 		forBlock: [[] ensure: [x2 := x2 not]]
+ 		runUntil: [:ctx | ctx isUnwindContext and: [(ctx tempAt: 2) notNil]].
+ 
+ 	"p3 has already set complete to true AND the unwind block has already run;
+ 	we have to verify the unwind block is not executed again during termination"
+ 	p3 := Process
+ 		forBlock: [[] ensure: [x3 := x3 not]]
+ 		runUntil: [:ctx | ctx isUnwindContext and: [ctx willReturn]].
+ 
+ 	"make sure all processes are running and only the p3's unwind block has finished"
+ 	self deny: p1 isTerminated | p2 isTerminated | p3 isTerminated.
+ 	self deny: x1 | x2.
+ 	self assert: x3. "p3 has already run its unwind block; we test it won't run it again"
+ 	"terminate all processes and verify all unwind blocks have finished correctly"
+ 	p1 terminate. p2 terminate. p3 terminate.
+ 	self assert: p1 isTerminated & p2 isTerminated & p3 isTerminated.
+ 	self assert: x1 & x2 & x3!

Item was added:
+ ----- Method: ProcessTest>>testTerminateInTerminate (in category 'tests') -----
+ testTerminateInTerminate
+ 	"Terminating a terminator process should unwind both the terminator and its terminatee process"
+ 	
+ 	| terminator terminatee unwound |
+ 	unwound := false.
+ 	terminatee := [[Processor activeProcess suspend] ensure: [unwound := true]] fork.
+ 	Processor yield.
+ 	terminator := [terminatee terminate] newProcess.
+ 	self assert: terminatee isSuspended.
+ 	self assert: terminator isSuspended.
+ 	"run terminator and stop inside #terminate"
+ 	terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:].
+ 	self assert: terminator isSuspended.
+ 	terminator terminate.
+ 	self assert: terminator isTerminated. 
+ 	self assert: unwound!

Item was added:
+ ----- Method: ProcessTest>>testTerminateTerminatingProcess (in category 'tests') -----
+ testTerminateTerminatingProcess
+ 	"An attempt to terminate a terminating process should probably raise an error;
+ 	leave this test as an expected failure for the moment."
+ 
+ 	| terminatee terminator resumed semaphore |
+ 	semaphore := Semaphore new.
+ 	terminatee := [semaphore critical:[]. resumed := true] fork.
+ 	Processor yield.
+ 	terminator := [terminatee terminate] newProcess.
+ 	self assert: terminatee suspendingList == semaphore.
+ 	self assert: terminator isSuspended. 
+ 	"run terminator and stop inside #terminate"
+ 	terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:].
+ 	self assert: terminator isSuspended.
+ 	"terminate the terminatee process again and let the termination finish;
+ 	an error is expected because #terminate detected multiple termination"
+ 	self should: [terminatee terminate] raise: Error.
+ 	"now let the terminator finish terminating the terminatee process"
+ 	terminator resume.
+ 	Processor yield.
+ 	self assert: resumed isNil.
+ 	self assert: terminatee isTerminated.
+ 	self assert: terminator isTerminated!

Item was added:
+ ----- Method: SemaphoreTest>>expectedFailures (in category 'failures') -----
+ expectedFailures
+ 
+ 	^ #(testUnwindSemaInCriticalWait)!

Item was added:
+ ----- Method: SemaphoreTest>>testSemaInCriticalEnsureArgument (in category 'tests') -----
+ testSemaInCriticalEnsureArgument	"self run: #testSemaInCriticalEnsureArgument"
+ 	"This tests whether a process that is in ensure argument block but has yet to evaluate the signal
+ 	leaves it with signaling the associated semaphore."
+ 	
+ 	| terminatee sema |
+ 	sema := Semaphore forMutualExclusion.
+ 	terminatee := [sema critical: []] newProcess.
+ 	self assert: terminatee isSuspended.
+ 	terminatee runUntil: [:ctx | ctx selectorToSendOrSelf = #signal].
+ 	self assert: terminatee isSuspended.
+ 	terminatee terminate.
+ 	self assert: terminatee isTerminated. 
+ 	self assert: sema excessSignals = 1 !

Item was added:
+ ----- Method: SemaphoreTest>>testUnwindSemaInCriticalWait (in category 'tests') -----
+ testUnwindSemaInCriticalWait	"self run: #testSemaInCriticalWait"
+ 	"This tests whether a semaphore that has entered the wait in Semaphore>>critical:
+ 	leaves it without signaling the associated semaphore."
+ 	| s p |
+ 	s := Semaphore new.
+ 	p := [[] ensure: [s critical:[]]] fork.
+ 	Processor yield.
+ 	self assert:(p suspendingList == s).
+ 	p terminate.
+ 	self assert: 0 equals: s excessSignals!

Item was added:
+ ProcessTest subclass: #UnwindTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'KernelTests-Processes'!

Item was added:
+ ----- Method: UnwindTest>>testTerminateActiveInNestedEnsure1 (in category 'tests') -----
+ testTerminateActiveInNestedEnsure1
+ 	"Terminate active process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 		[
+ 			[
+ 				[ ] ensure: [
+ 					[Processor activeProcess terminate] ensure: [
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateActiveInNestedEnsure2 (in category 'tests') -----
+ testTerminateActiveInNestedEnsure2
+ 	"Terminate active process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 		[
+ 			[
+ 				[ ] ensure: [
+ 					[ ] ensure: [
+ 						Processor activeProcess terminate.
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateBlockedInNestedEnsure1 (in category 'tests') -----
+ testTerminateBlockedInNestedEnsure1
+ 	"Terminate blocked process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 		[
+ 			[
+ 				[ ] ensure: [
+ 					[semaphore wait] ensure: [
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is blocked and none of the unwind blocks has finished yet"
+ 	self assert: p isBlocked.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateBlockedInNestedEnsure2 (in category 'tests') -----
+ testTerminateBlockedInNestedEnsure2
+ 	"Terminate blocked process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 		[
+ 			[
+ 				[ ] ensure: [
+ 					[ ] ensure: [
+ 						semaphore wait.
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is blocked and none of the unwind blocks has finished yet"
+ 	self assert: p isBlocked.
+ 	self deny: x1 | x2 | x3 | x4. 
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateInNestedEnsureWithReturn1 (in category 'tests') -----
+ testTerminateInNestedEnsureWithReturn1
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 	[
+ 		[:return | 
+ 			[
+ 				[ ] ensure: [
+ 					[Processor activeProcess suspend] ensure: [
+ 						x1 := true. return value]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] valueWithExit
+ 	] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x3.
+ 	self deny: x2 & x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateInNestedEnsureWithReturn2 (in category 'tests') -----
+ testTerminateInNestedEnsureWithReturn2
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 	[
+ 		[:return | 
+ 			[
+ 				[ ] ensure: [
+ 					[] ensure: [
+ 						Processor activeProcess suspend.
+ 						x1 := true. return value]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] valueWithExit
+ 	] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x3.
+ 	self deny: x2 & x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateInNestedEnsureWithReturn3 (in category 'tests') -----
+ testTerminateInNestedEnsureWithReturn3
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 	[
+ 		[:return | 
+ 			[
+ 				[ ] ensure: [
+ 					[Processor activeProcess suspend] ensure: [
+ 						x1 := true]. 
+ 					x2 := true. return value]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] valueWithExit
+ 	] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateInNestedEnsureWithReturn4 (in category 'tests') -----
+ testTerminateInNestedEnsureWithReturn4
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 	[
+ 		[:return | 
+ 			[
+ 				[ ] ensure: [
+ 					[] ensure: [
+ 						Processor activeProcess suspend.
+ 						x1 := true]. 
+ 					x2 := true. return value]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] valueWithExit
+ 	] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateInNestedEnsureWithReturn5 (in category 'tests') -----
+ testTerminateInNestedEnsureWithReturn5
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 	[
+ 		[:return | 
+ 			[
+ 				[ ] ensure: [
+ 					[Processor activeProcess suspend] ensure: [
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true. return value].
+ 			x4 := true.
+ 		] valueWithExit
+ 	] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateInNestedEnsureWithReturn6 (in category 'tests') -----
+ testTerminateInNestedEnsureWithReturn6
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 	[
+ 		[:return | 
+ 			[
+ 				[ ] ensure: [
+ 					[] ensure: [
+ 						Processor activeProcess suspend.
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true. return value].
+ 			x4 := true.
+ 		] valueWithExit
+ 	] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateInNestedEnsureWithReturn7 (in category 'tests') -----
+ testTerminateInNestedEnsureWithReturn7
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 	[
+ 		[:return | 
+ 			[
+ 				[ ] ensure: [
+ 					[Processor activeProcess suspend] ensure: [
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true. return value.
+ 		] valueWithExit
+ 	] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateInNestedEnsureWithReturn8 (in category 'tests') -----
+ testTerminateInNestedEnsureWithReturn8
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 	[
+ 		[:return | 
+ 			[
+ 				[ ] ensure: [
+ 					[] ensure: [
+ 						Processor activeProcess suspend.
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true. return value.
+ 		] valueWithExit
+ 	] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateRunnableInNestedEnsure1 (in category 'tests') -----
+ testTerminateRunnableInNestedEnsure1
+ 	"Terminate runnable process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 		[
+ 			[
+ 				[ ] ensure: [
+ 					[Processor yield] ensure: [
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is runnable and none of the unwind blocks has finished yet"
+ 	self assert: p isRunnable.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateRunnableInNestedEnsure2 (in category 'tests') -----
+ testTerminateRunnableInNestedEnsure2
+ 	"Terminate runnable process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 		[
+ 			[
+ 				[ ] ensure: [
+ 					[ ] ensure: [
+ 						Processor yield. 
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is runnable and none of the unwind blocks has finished yet"
+ 	self assert: p isRunnable.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateSuspendedInNestedEnsure1 (in category 'tests') -----
+ testTerminateSuspendedInNestedEnsure1
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 		[
+ 			[
+ 				[ ] ensure: [
+ 					[Processor activeProcess suspend] ensure: [
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!

Item was added:
+ ----- Method: UnwindTest>>testTerminateSuspendedInNestedEnsure2 (in category 'tests') -----
+ testTerminateSuspendedInNestedEnsure2
+ 	"Terminate suspended process.
+ 	Test all nested unwind blocks are correctly executed; 
+ 	all unwind blocks halfway through their execution should be completed."
+ 
+ 	| p x1 x2 x3 x4 |
+ 	x1 := x2 := x3 := x4 := false.
+ 	p := 
+ 		[
+ 			[
+ 				[ ] ensure: [
+ 					[ ] ensure: [
+ 						Processor activeProcess suspend. 
+ 						x1 := true]. 
+ 					x2 := true]
+ 			] ensure: [
+ 				x3 := true].
+ 			x4 := true.
+ 		] newProcess.
+ 	p resume.
+ 	Processor yield.
+ 	"make sure p is suspended and none of the unwind blocks has finished yet"
+ 	self assert: p isSuspended.
+ 	self deny: x1 | x2 | x3 | x4.
+ 	"now terminate the process and make sure all unwind blocks have finished"
+ 	p terminate.
+ 	self assert: p isTerminated.
+ 	self assert: x1 & x2 & x3.
+ 	self deny: x4.!



More information about the Squeak-dev mailing list