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.!