Marcel Taeumel uploaded a new version of KernelTests to project The Treated Inbox: http://source.squeak.org/treated/KernelTests-jar.433.mcz
==================== Summary ====================
Name: KernelTests-jar.433 Author: jar Time: 7 June 2022, 6:24:58.053964 pm UUID: b2a35851-6470-a643-9f6f-e939501100b6 Ancestors: KernelTests-mt.425
Bundle together all new Process and Semaphore tests from:
KernelTests-jar.431, 432 (multiple termination and NLR) KernelTests-jar.429, 430 (unwind errors test) KernelTests-jar.428 (more tests) KernelTests-jar.426, 427 (priority before suspendedContext)
Complements Kernel-jar.1476 (updated terminate with sync) and Kernel-jar.1473 (priority set before suspendedContext).
Please remove the individual changesets from the Inbox.
=============== Diff against KernelTests-mt.425 ===============
Item was added: + ----- Method: ProcessTest>>testPrioritySetBeforeSuspendedContext (in category 'tests') ----- + testPrioritySetBeforeSuspendedContext + "Test whether priority is set before suspendedContext during process creation." + + "Setting priority after causes an endless stream of error windows when debugging e.g. + [] newProcess + when Process Browser is open with auto-update on. + + Once the suspendedContext is set, the new process is no longer considered terminated + and Process Browser will try to place it in its list of processes but encounters a nil error + when reading its priority because it has not been set yet." + + | p inside | + inside := false. + p := [inside := true. [] newProcess] newProcess. + p runUntil: [:ctx | inside]. + p runUntil: [:ctx | ctx selectorToSendOrSelf = #suspendedContext:]. + "Now p is before assigning suspendedContext in Process class >> forContext:priority: + tempAt: 3 is the local variable 'newProcess' representing the newly created process; + verify whether the new process's priority has already been set." + self assert: (p suspendedContext tempAt: 3) priority notNil!
Item was added: + ----- Method: ProcessTest>>testTerminateByHighestPriorityProcess (in category 'tests') ----- + testTerminateByHighestPriorityProcess + "Test temination by a highest priority process." + + "Note: in case #terminate elevates the priority of the terminating + process it has to make sure it doesn't exceed the highest priority. + Workspace example: + q := [Semaphore new wait] fork. + p := [q terminate] forkAt: Processor highestPriority. + q isTerminated + + We have to catch the 'Invalid priority' error via the 'error' variable + because #shouldnt:raise: doesn't work between two processes." + + | p q error | + p := [Semaphore new wait] fork. + Processor yield. + self assert: p isBlocked. + error := false. + q := [[p terminate] on: Error do: [error := true]] newProcess. + q priority: Processor highestPriority. + q resume. + self deny: error. + self assert: p isTerminated. + self assert: q isTerminated!
Item was added: + ----- Method: ProcessTest>>testTerminateEnsureOnTopOfEnsure (in category 'tests') ----- + testTerminateEnsureOnTopOfEnsure + "Test two ensure contexts on top of each other unwind correctly, + that both their unwind blocks get executed." + + | beenHere beenHereToo bottom p top | + beenHere := beenHereToo := false. + bottom := Context contextEnsure: [beenHereToo := true]. + top := Context contextEnsure: [Processor activeProcess suspend. beenHere := true]. + top privSender: bottom. + p := Process forContext: top priority: Processor activeProcess priority. + p resume. + Processor yield. + self assert: p isSuspended. + p terminate. + self assert: beenHere & beenHereToo. + self assert: p isTerminated + + !
Item was added: + ----- Method: ProcessTest>>testTerminateHandlingUnwindError (in category 'tests') ----- + testTerminateHandlingUnwindError + "Test an error inside an unwind block is handled correctly." + + "Workspace example: + [ [[Processor activeProcess terminate] ensure: [1/0]] on: ZeroDivide do: [] ] fork + + ZeroDivide error should get caught by the handler without opening the Debugger. + + To model this example as a test case we have to keep in mind that an error signal + in one thread cannot be caught in a different thread: if process 'p' signals an error + it won't be searching for a handler in the thread that sent 'p terminate' message. + So we can't do something like: + p := [ [ [Semaphore new wait] ensure: [1/0] ] on: ZeroDivide do: [] ] fork. + Processor yield. + self shouldnt: [p terminate] raise: Error + Instead, in order to catch the situation the ZeroDivide error is not caught within 'p', + we try to catch the UnhandledError raised in 'p' indicating the ZeroDivide has been + missed. " + + | p error unwindBlock | + unwindBlock := [[1/0] on: UnhandledError do: [error := true]]. + p := [ [ [Semaphore new wait] ensure: unwindBlock ] on: ZeroDivide do: [] ] fork. + Processor yield. + self assert: p isBlocked. + error := false. + p terminate. + self deny: error. + self assert: p isTerminated!
Item was added: + ----- Method: ProcessTest>>testTerminateHighestPriorityProcess (in category 'tests') ----- + testTerminateHighestPriorityProcess + "Test termination of a highest priority process." + + | p | + p := [Semaphore new wait] forkAt: Processor highestPriority. + Processor yield. + self assert: p isBlocked. + p terminate. + self assert: p isTerminated!
Item was added: + ----- Method: ProcessTest>>testTerminateNiledSuspendedContextProcess (in category 'tests') ----- + testTerminateNiledSuspendedContextProcess + "Test a process with niled suspendedContext terminates correctly." + + | p | + p := [] newProcess. + self assert: p isSuspended. + p suspendedContext: nil. + p terminate. + self assert: p isTerminated!
Item was added: + ----- Method: ProcessTest>>testTerminateSingleEnsure (in category 'tests') ----- + testTerminateSingleEnsure + "Test a stack consisting of a single ensure context unwinds correctly." + + | beenHere p singleton | + beenHere := false. + singleton := Context contextEnsure: [beenHere := true]. + p := Process forContext: singleton priority: Processor activeProcess priority. + self assert: p isSuspended. + self assert: p suspendedContext sender isNil. + p terminate. + self assert: beenHere. + self assert: p isTerminated!
Item was added: + ----- Method: ProcessTest>>testTerminateTerminatingProcessAfterUnwindStarted (in category 'tests') ----- + testTerminateTerminatingProcessAfterUnwindStarted + "Terminating a terminatee process after the terminator process restarted the terminatee + process should unwind the terminatee process and let the terminator process terminate." + + "Such a situation may occur e.g. when a terminating process encounters an error and + opens a debugger (or calls another recovery machinery). In such case it's legitimate + to terminate the terminating process again (by closing the debugger or as a termination + by another recovery tool). + + Note: this is a different situation than in 'testTerminateTerminatingProcess' where + the second termination is invoked 'too early' and may cause unpredictable outcome." + + | terminator terminatee unwound unwindBlock | + unwound := false. + unwindBlock := [Processor activeProcess suspend. unwound := true]. + terminatee := [[Semaphore new wait] ensure: unwindBlock] fork. + Processor yield. + terminator := [terminatee terminate] newProcess. + self assert: terminatee isBlocked. + self assert: terminator isSuspended. + terminator resume. + Processor yield. + "terminator starts terminatee's unwind" + Processor yield. + "terminatee resumes and stops at unwindBlock's #suspend" + self assert: terminatee isSuspended. + terminatee terminate. + self assert: terminatee isTerminated. + self assert: unwound. + Processor yield. + self assert: terminator isTerminated!
Item was added: + ----- Method: ProcessTest>>testTerminateTerminatingProcessInUnwindTo (in category 'tests') ----- + testTerminateTerminatingProcessInUnwindTo + "Terminating a terminatee process after the terminator process restarted the terminatee + process should unwind the terminatee process and let the terminator process terminate." + + | terminator terminatee unwound | + unwound := false. + terminatee := [[Semaphore new wait] ensure: [unwound := true]] fork. + Processor yield. + terminator := [terminatee terminate] newProcess. + self assert: terminatee isBlocked. + self assert: terminator isSuspended. + terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #resume]. + "terminator steps until terminatee's unwind context is set" + terminator suspendedContext nextInstruction. "skip terminatee resume instruction" + terminator resume. "and run until parked at wait" + terminatee runUntil: [:ctx | ctx selectorToSendOrSelf = #unwindTo:]. + "terminatee steps until at #unwindTo:" + self assert: terminatee isSuspended. + terminatee terminate. + self assert: terminatee isTerminated. + self assert: unwound. + Processor yield. + self assert: terminator isTerminated!
Item was added: + ----- Method: ProcessTest>>testTerminateWithDelayInUnwind (in category 'tests') ----- + testTerminateWithDelayInUnwind + "Test the process that invoked the termination of another process waits + for the other process to finish unwinding." + + "Insert delay into the unwind block to force rescheduling; alternatively, + 'Processor yield' could be used instead of 'delay wait'." + + | delay p | + delay := Delay forMilliseconds: 10. + p := [[Processor activeProcess suspend] ensure: [delay wait]] fork. + Processor yield. + self assert: p isSuspended. + p terminate. + self assert: p isTerminated!
Item was added: + ----- Method: ProcessUnwindTest>>testTerminateNestedEnsureWithReturn1 (in category 'tests') ----- + testTerminateNestedEnsureWithReturn1 + "Terminate suspended process. + Test all nested unwind blocks are correctly executed; + all unwind blocks halfway through their execution should be completed." + + "While testTerminateInNestedEnsureWithReturn1 to 8 start unwinding + from inside a halfways through unwind block, this test (and the next) start + the unwind from outside any ensure argument (aka unwind) block, testing + the second half of the #unwindTo:safely: method." + + | p x1 x2 x3 x4 x5 | + x1 := x2 := x3 := x4 := x5 := false. + p := + [ + [:return | + [ Processor activeProcess suspend. + [ ] ensure: [ + [ ] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + return value. + x3 := true]. + x4 := true. + ] valueWithExit. + x5 := 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 | x5. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self deny: x1 & x2 & x3 & x4 & x5!
Item was added: + ----- Method: ProcessUnwindTest>>testTerminateNestedEnsureWithReturn2 (in category 'tests') ----- + testTerminateNestedEnsureWithReturn2 + "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 x5 | + x1 := x2 := x3 := x4 := x5 := false. + p := + [ + [:return | + [ + [Processor activeProcess suspend] ensure: [ + [ ] ensure: [ + x1 := true]. + return value. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit. + x5 := 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 | x5. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self deny: x1 & x2 & x3 & x4 & x5!
Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWaitSuspended (in category 'tests') ----- + testSemaAfterCriticalWaitSuspended "self run: #testSemaAfterCriticalWaitSuspended" + "This tests whether a semaphore that has just left the wait in Semaphore>>critical: but + has been suspended before termination, leaves it with signaling the associated semaphore." + | s p | + s := Semaphore new. + p := [s critical:[]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse:[(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + self assert: p suspendingList class == LinkedList. + p suspend. + self assert: p suspendingList == nil. + p terminate. + self assert: 1 equals: s excessSignals!
packages@lists.squeakfoundation.org