Marcel Taeumel uploaded a new version of KernelTests to project The Treated Inbox: http://source.squeak.org/treated/KernelTests-jar.421.mcz
==================== Summary ====================
Name: KernelTests-jar.421 Author: jar Time: 5 January 2022, 3:15:22.031959 pm UUID: 97065f2d-925e-d04e-9bfb-69efecc5f415 Ancestors: KernelTests-ct.418
a battery of tests to complement new #terminate (Kernel-jar.1443 or later).
replacing individual changesets: KernelTests-jar.406 KernelTests-jar.407 KernelTests-jar.415 KernelTests-jar.416 KernelTests-jar.417 KernelTests-jar.419 KernelTests-jar.420
please kindly remove these from the Inbox
=============== Diff against KernelTests-ct.418 ===============
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 changed: ----- Method: ProcessTest>>testAtomicSuspend (in category 'tests') ----- testAtomicSuspend "Test atomic suspend of foreign processes"
| list p | p := [semaphore wait] fork. Processor yield. list := p suspendPrimitivelyOrFail. + self assert: + (Smalltalk processSuspensionUnblocks + ifFalse: [list isNil] + ifTrue: [list == semaphore])! - self assert: list == semaphore. - !
Item was added: + ----- Method: ProcessTest>>testResumeTerminatingProcess (in category 'tests') ----- + testResumeTerminatingProcess + + | 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 #releaseCriticalSection:" + terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #selectorJustSentOrSelf]. + 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]]. + + "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 run 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. + terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #suspend]. "first #suspend in #terminate" + self assert: terminator isSuspended. + terminator terminate. + self assert: terminator isTerminated. + self assert: unwound!
Item was added: + ----- Method: ProcessTest>>testTerminateTerminatingProcess (in category 'tests') ----- + testTerminateTerminatingProcess + + | 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 #releaseCriticalSection:" + terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #selectorJustSentOrSelf]. + 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>>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: + 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] forkAt: Processor activePriority + 1. + Smalltalk processSuspensionUnblocks ifFalse: [ + "terminate will suspend the process first and suspend will put the process back at #wait and + so unwind will put the process back at the wait; to continue, semaphore needs to be signaled" + "self assert: p isBlocked. <-- this wouldn't work because terminate set suspendedContext to nil" + self deny: x1 | x2 | x3 | x4. + semaphore signal. + Processor yield]. + 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] forkAt: Processor activePriority + 1. + Smalltalk processSuspensionUnblocks ifFalse: [ + "terminate will suspend the process first and suspend will put the process back at #wait and + so unwind will put the process back at the wait; to continue, semaphore needs to be signaled" + "self assert: p isBlocked. <-- this wouldn't work because terminate set suspendedContext to nil" + self deny: x1 | x2 | x3 | x4. + semaphore signal. + Processor yield]. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + 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] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.!
packages@lists.squeakfoundation.org