Squeak-dev June 2022

squeak-dev@lists.squeakfoundation.org

30 participants
309 discussions

The Inbox: KernelTests-jar.433.mcz
by commits＠source.squeak.org 07 Jun '22

07 Jun '22

A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/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!

1 0

The Inbox: Kernel-jar.1476.mcz
by commits＠source.squeak.org 07 Jun '22

07 Jun '22

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1476.mcz ==================== Summary ==================== Name: Kernel-jar.1476 Author: jar Time: 7 June 2022, 5:26:20.195964 pm UUID: 485a13c3-c632-aa4b-bc0d-a1a7fb9a3376 Ancestors: Kernel-jar.1475 - fix synchronization between the terminating process and the process that invoked the termination - add further protection against multiple termination (it makes the code uglier but I can't help it) - improve the comment (it's still too long and insufficient though ;) ) Complemented by additional tests (I'll bundle all of them in one changeset) =============== Diff against Kernel-jar.1475 =============== Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending #ensure:/#ifCurtailed: blocks before terminating; allow all unwind blocks to run; if they are currently in progress, let them finish." "This is the kind of behavior we expect when terminating a healthy process. See further comments in #terminateAggressively and #destroy methods dealing with process termination when closing the debugger or after a catastrophic failure. If terminating the active process, create a new stack and run unwinds from there. If terminating a suspended process (including runnable and blocked), always suspend the terminating process first so it doesn't accidentally get woken up. Equally important is the side effect of the suspension: In 2022 a new suspend semantics has been introduced: the revised #suspend backs up a process waiting on a conditional variable to the send that invoked the wait state, while the previous #suspend simply removed the process from the conditional variable's list it was previously waiting on; see #suspend and #suspendAndUnblock comments. If the process is in the middle of a #critical: critical section, release it properly. To allow a suspended process to unwind itself, create a new stack for the process being terminated and resume the suspended process to complete its termination from the new parallel stack. Use a semaphore to make the process that invoked the termination wait for self's completion. Execute the termination in the ensure argument block to ensure it completes even if the terminator process itself gets + terminated before it's finished; see testTerminateInTerminate and others." - terminated before it's finished; see testTerminateInTerminate." | context | self isActiveProcess ifTrue: [ context := thisContext. + ^[[] ensure: [context unwindTo: nil]. self suspend] asContext jump]. - ^[context unwindTo: nil. self suspend] asContext jump]. [] ensure: [ | terminator | self suspendAndReleaseCriticalSection. context := suspendedContext ifNil: [^self]. terminator := Semaphore new. + context bottomContext insertSender: (Context contextEnsure: [terminator signal]). + self suspendedContext: [[] ensure: [context unwindTo: nil]. self suspend] asContext; + priority: Processor activePriority; + resume. - suspendedContext := [context unwindTo: nil. terminator signal. self suspend] asContext. - self priority: Processor activePriority; resume. terminator wait]!

1 0

NetNameResolver useOldNetwork seems perhaps too conservative?
by Tony Garnock-Jones 07 Jun '22

07 Jun '22

Hi all, In Socket>>initialize:family:, there's a line NetNameResolver useOldNetwork ifTrue: [ ^self initialize: socketType ]. that has been conserved across all the versions of the method I have in my image (back to 2010). What harm would be done if we simply *removed it*, do we think? It seems bad to *pretend* to allocate a socket of the requested family but really to not do so! Tony

2 3

The Trunk: Network-tonyg.260.mcz
by commits＠source.squeak.org 07 Jun '22

07 Jun '22

Tony Garnock-Jones uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-tonyg.260.mcz ==================== Summary ==================== Name: Network-tonyg.260 Author: tonyg Time: 2 June 2022, 1:38:03.620567 pm UUID: 56f1d277-cb0f-4d18-8022-b387d4be3f83 Ancestors: Network-pre.259 Repair error messages: the `printString` had been lost in the most recent change, leading to unreadable output when a hostAddress like #[127 0 0 1] was in use. =============== Diff against Network-pre.259 =============== Item was changed: + SystemOrganization addCategory: #'Network-UUID'! + SystemOrganization addCategory: #'Network-Url'! + SystemOrganization addCategory: #'Network-URI'! + SystemOrganization addCategory: #'Network-RemoteDirectory'! + SystemOrganization addCategory: #'Network-Protocols'! SystemOrganization addCategory: #'Network-Exceptions'! - SystemOrganization addCategory: #'Network-Kernel'! SystemOrganization addCategory: #'Network-MailSending'! + SystemOrganization addCategory: #'Network-Kernel'! - SystemOrganization addCategory: #'Network-Protocols'! SystemOrganization addCategory: #'Network-RFC822'! - SystemOrganization addCategory: #'Network-RemoteDirectory'! - SystemOrganization addCategory: #'Network-URI'! - SystemOrganization addCategory: #'Network-UUID'! - SystemOrganization addCategory: #'Network-Url'! Item was changed: ----- Method: Socket>>connectTo:port:waitForConnectionFor: (in category 'connection open/close') ----- connectTo: hostAddress port: port waitForConnectionFor: timeout "Initiate a connection to the given port at the given host address. Waits until the connection is established or time outs." self connectNonBlockingTo: hostAddress port: port. self waitForConnectionFor: timeout + ifTimedOut: [ConnectionTimedOut signal: ('Cannot connect to {1}' translated format: {hostAddress printString})] + ifRefused: [ConnectionRefused signal: ('Cannot connect to {1}' translated format: {hostAddress printString})]! - ifTimedOut: [ConnectionTimedOut signal: ('Cannot connect to {1}' translated format: {hostAddress})] - ifRefused: [ConnectionRefused signal: ('Cannot connect to {1}' translated format: {hostAddress})]!

3 6

The Trunk: Network-tonyg.262.mcz
by commits＠source.squeak.org 07 Jun '22

07 Jun '22

Tony Garnock-Jones uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-tonyg.262.mcz ==================== Summary ==================== Name: Network-tonyg.262 Author: tonyg Time: 7 June 2022, 9:32:58.541461 am UUID: 510fd136-5da5-43a8-93c3-d5adbe439d14 Ancestors: Network-mt.261 I missed a case in Network-tonyg.260. This change fixes connectTo:waitForConnectionFor: in the same way as the previous fix to connectTo:port:waitForConnectionFor:. =============== Diff against Network-mt.261 =============== Item was changed: ----- Method: Socket>>connectTo:waitForConnectionFor: (in category 'ipv6') ----- connectTo: aSocketAddress waitForConnectionFor: timeout self connectNonBlockingTo: aSocketAddress. self waitForConnectionFor: timeout + ifTimedOut: [ConnectionTimedOut signal: ('Cannot connect to {1}' translated format: {aSocketAddress printString})] + ifRefused: [ConnectionRefused signal: ('Cannot connect to {1}' translated format: {aSocketAddress printString})]! - ifTimedOut: [ConnectionTimedOut signal: ('Cannot connect to {1}' translated format: {aSocketAddress})] - ifRefused: [ConnectionRefused signal: ('Cannot connect to {1}' translated format: {aSocketAddress})]!

1 0

The Inbox: KernelTests-jar.432.mcz
by commits＠source.squeak.org 06 Jun '22

06 Jun '22

A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-jar.432.mcz ==================== Summary ==================== Name: KernelTests-jar.432 Author: jar Time: 6 June 2022, 11:57:50.959098 pm UUID: 7ac20a02-7d4d-fb48-9586-14ab9844b799 Ancestors: KernelTests-jar.431 Three more Process tests: non-local returns and another test case for terminating a process that has already started unwinding. Hope this is all. =============== Diff against KernelTests-jar.431 =============== 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. + self assert: terminator 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!

1 0

The Inbox: KernelTests-jar.431.mcz
by commits＠source.squeak.org 06 Jun '22

06 Jun '22

A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-jar.431.mcz ==================== Summary ==================== Name: KernelTests-jar.431 Author: jar Time: 6 June 2022, 4:26:06.000182 pm UUID: 1c79cb69-dd24-6440-917f-0d3142fd4a17 Ancestors: KernelTests-jar.430 One more Process test; this verifies that if a terminating process gets stopped and terminated again, all unwinds execute correctly and the original terminator process terminates as well. 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: it's a different situation than in 'testTerminateTerminatingProcess' where the second termination is invoked "too early" and may cause unpredictable outcome - that test is still WIP. Add testTerminateWithDelayInUnwind to the expectedFailures for the moment. Adopting #teminate for that scenario is WIP. =============== Diff against KernelTests-jar.430 =============== Item was changed: ----- Method: ProcessTest>>expectedFailures (in category 'failures') ----- expectedFailures + ^ #(testTerminateTerminatingProcess testResumeTerminatingProcess testTerminateWithDelayInUnwind)! - ^ #(testTerminateTerminatingProcess testResumeTerminatingProcess)! 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. + self assert: terminator isTerminated!

1 0

storePop followed by push is inefficient?
by Craig Latta 06 Jun '22

06 Jun '22

Hi-- Apologies if this is obvious, or I misunderstood. I notice many compiled methods with storePop instructions followed by push instructions for the same location. E.g., in the Sista version of Parser>>method:context: 305 <D7> popIntoTemp: 7 306 <47> pushTemp: 7 Aren't those two instructions the same as a single storeTemp instruction? Even if that optimization were made, would it result in the same machine code from cogit anyway, and is that why the optimization isn't made at the Smalltalk compiler level? If so, where in cogit can I find the optimization? Wouldn't there be less work for cogit to do if it could expect this optimization from the Smalltalk compiler? If cogit doesn't make this optimization, would system performance improve if the Smalltalk compiler did it? I see that well over 10% of the methods in the upcoming release would be affected. Is there some reason why doing this optimization isn't a good idea? I'm writing a new Smalltalk compiler (based on a more straightforward parser) and I'd like to try this optimization. thanks! -C -- Craig Latta :: research computer scientist Black Page Digital :: Berkeley, California 663137D7940BF5C0AFC :: 1349FB2ADA32C4D5314CE

2 1

Review Request: genericDropSourceCode.cs & complements
by christoph.thiede＠student.hpi.uni-potsdam.de 05 Jun '22

05 Jun '22

This review requests consists of 3 changesets, for each of which I am appending a summary below: - genericDropSourceCode.cs - browse&drop-Monticello.cs - browse&drag-Tools+System.cs tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-) Screencast: https://shorturl.at/gkwC6 Please review & let me know when I can merge it! :D Best, Christoph =============== Summary (genericDropSourceCode.cs) =============== Change Set: genericDropSourceCode Date: 26 January 2022 Author: Christoph Thiede This changeset simplifies & generalizes the #dropSourceCode mechanism which you can observe by dragging a class or method from a tool into the world. With this patch, the coupling between PasteUpMorph and tools is eliminated, and other classes can easily participate in the mechanism by specifying the dragTransferType #sourceCode and providing a passenger that implements #browse and answers the tool-buildable or a window. In addition, it is now also possible to drag a string or text into the world to spawn a new workspace. =============== Diff =============== Object>>browse {*Tools-Browsing} · ct 1/26/2022 21:54 (changed) browse - ToolSet browseClass: self class + ^ ToolSet browseClass: self class PasteUpMorph>>acceptDroppingMorph:event: {dropping/grabbing} · ct 1/27/2022 00:39 (changed) acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied" | aMorph | (self isWorldMorph and: [dropped isTransferMorph]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode - ifTrue: [^ self dropSourceCode: dropped passenger event: evt]]. + ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. + (dropped passenger isString or: [dropped passenger isText]) + ifTrue: [^ self dropEditable: dropped passenger event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. aMorph allMorphsDo: "Establish any penDown morphs in new world" [:m | | tfm mm | m player ifNotNil: [m player getPenDown ifTrue: [((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) forPlayer: m player]]]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. " self presenter morph: aMorph droppedIntoPasteUpMorph: self." self showingListView ifTrue: [self sortSubmorphsBy: (self valueOfProperty: #sortOrder). self currentWorld abandonAllHalos]. self bringTopmostsToFront. PasteUpMorph>>dropEditable:event: {event handling} · ct 1/27/2022 00:38 + dropEditable: aStringOrText event: evt + + ^ self dropTool: aStringOrText edit event: evt PasteUpMorph>>dropSourceCode:event: {event handling} · ct 1/27/2022 00:37 (changed) dropSourceCode: anObject event: evt - (anObject isMethodReference and: [anObject isValid]) - ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt]. - - (anObject isBehavior or: [anObject isCompiledMethod]) - ifTrue: [ - | tool window | - tool := anObject isBehavior - ifTrue: [Browser new - setClass: anObject] - ifFalse: [CodeHolder new - setClass: anObject methodClass - selector: anObject selector]. - window := ToolBuilder open: tool. - window center: evt position. - window bounds: (window bounds translatedToBeWithin: self bounds)]. - - anObject isString - ifTrue: [anObject edit]. + ^ self dropTool: anObject browse event: evt PasteUpMorph>>dropTool:event: {event handling} · ct 1/27/2022 00:37 + dropTool: tool event: evt + + | window | + tool ifNil: [^ self]. + + window := tool containingWindow ifNil: [ToolBuilder open: tool]. + window center: evt position. + window bounds: (window bounds translatedToBeWithin: self bounds). + ^ window PasteUpMorph>>wantsDroppedTransferMorph: {dropping/grabbing} · ct 1/26/2022 22:11 (changed) wantsDroppedTransferMorph: transferMorph ^ self hasTransferMorphConverter or: [transferMorph dragTransferType = #filesAndDirectories] - or: [transferMorph dragTransferType = #sourceCode] + or: [transferMorph dragTransferType = #sourceCode] + or: [transferMorph passenger isString or: [transferMorph passenger isText]] String>>edit {*toolbuilder-kernel} · ct 1/26/2022 22:13 (changed) edit - UIManager default edit: self. + ^ Project uiManager edit: self. SystemWindow>>openAsTool {*ToolBuilder-Morphic-opening} · ct 1/26/2022 21:53 (changed) openAsTool "Open this window as a tool, that is, honor the preferences such as #reuseWindows and #openToolsAttachedToMouseCursor." - + | meOrSimilarWindow | meOrSimilarWindow := self openInWorldExtent: self extent. - (Project uiManager openToolsAttachedToMouseCursor "and: [ | event | - event := self currentEvent. - event isMouse and: [event isMouseUp]]") ifTrue: [ - meOrSimilarWindow setProperty: #initialDrop toValue: true. - meOrSimilarWindow hasDropShadow: false. - self currentHand attachMorph: meOrSimilarWindow]. + (Project uiManager openToolsAttachedToMouseCursor + and: [ | event | + event := self currentEvent. + (event isMouse and: [event isMouseUp]) or: [event isDropEvent]]) + ifTrue: [ + meOrSimilarWindow setProperty: #initialDrop toValue: true. + meOrSimilarWindow hasDropShadow: false. + self currentHand attachMorph: meOrSimilarWindow]. ^ meOrSimilarWindow Text>>edit {*ToolBuilder-Kernel} · ct 1/26/2022 22:13 (changed) edit - UIManager default edit: self. + ^ Project uiManager edit: self. =============== Summary (browse&drop-Monticello.cs) =============== Change Set: browse&drop-Monticello Date: 27 January 2022 Author: Christoph Thiede This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for most tools in the Monticello UI and providing proper implementations of #browse in the model classes. At a few places, multilingual support is improved, too. As an entrypoint to this changeset, please read: MCToolWindowBuilder>>#listMorph:selection:menu:keystroke:drag: =============== Diff =============== MCClassDefinition>>browseVersions {browsing} · ct 1/26/2022 22:59 + browseVersions + + ^ self actualClass browse MCConfiguration>>browse {actions} · ct 1/26/2022 22:02 (changed) browse | browser | browser := MCConfigurationBrowser new configuration: self copyForEdit. name ifNotNil: [:nm | browser label: browser defaultLabel , ' ' , nm]. - browser show + ^ browser show MCDefinition>>browseVersions {browsing} · ct 1/26/2022 22:58 + browseVersions + + ^ nil MCFileBasedRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:22 (changed) morphicOpen: aWorkingCopy - (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) + ^ (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) show MCMethodDefinition>>actualMethod {accessing} · ct 1/26/2022 22:39 + actualMethod + ^ self actualMethodIn: Environment current MCMethodDefinition>>actualMethodIn: {accessing} · ct 1/27/2022 00:43 + actualMethodIn: anEnvironment + "Answer the installed compiled method that belongs to this definition, or a change record if this version of the method is no longer installed." + | class method | + class := (self actualClassIn: anEnvironment) ifNil: [^ nil]. + method := class compiledMethodAt: self selector ifAbsent: [nil]. + (method isNil or: [method timeStamp = self timeStamp]) + ifFalse: [method := (class changeRecordsAt: self selector) + detect: [:record | record stamp = self timeStamp] + ifNone: [nil]]. + ^ method MCMethodDefinition>>browse {browsing} · ct 1/26/2022 23:00 (changed and recategorized) browse - | browser | - browser := MCSnapshotBrowser forSnapshot: (MCSnapshot fromDefinitions: {self}). - browser - categorySelection: 1; - classSelection: 1. - classIsMeta ifTrue: [browser switchBeClass]. - browser - protocolSelection: 1; - methodSelection: 1; - showLabelled: 'Snapshot of ', self summary. - ^ browser + + ^ self actualMethod ifNotNil: [:method | method isCompiledMethod + ifTrue: [method browse] + ifFalse: [self browseVersions]] MCMethodDefinition>>browseVersions {browsing} · ct 1/26/2022 23:00 + browseVersions + + ^ ToolSet browseVersionsOf: self actualClass selector: self selector MCOperationsBrowser>>methodAt: {accessing} · ct 1/26/2022 22:53 + methodAt: index + + ^ self items at: index MCOperationsBrowser>>widgetSpecs {ui} · ct 1/26/2022 22:51 (changed) widgetSpecs Preferences annotationPanes ifFalse: [ ^#( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: text) (0 0.4 1 1)) ) ]. ^ #( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultAnnotationPaneHeight)) ((textMorph: text) (0 0.4 1 1) (0 defaultAnnotationPaneHeight 0 0)) ) MCOperationsList>>browse {ui} · ct 1/26/2022 22:02 (changed) browse - (self browserClass items: operations) show + ^ (self browserClass items: operations) show MCPatch>>browse {ui} · ct 1/26/2022 22:02 (changed) browse - (self browserClass forPatch: self) show + ^ (self browserClass forPatch: self) show MCPatchOperation>>browse {browsing} · ct 1/26/2022 22:58 + browse + + ^ self definition browseVersions MCRepository>>browse {user interface} · ct 1/26/2022 22:21 + browse + + ^ self morphicOpen MCRepository>>morphicOpen {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen - self morphicOpen: nil + ^ self morphicOpen: nil MCRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen: aWorkingCopy - (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show + ^ (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show MCRepositoryInspector>>packageAt: {morphic ui} · ct 1/26/2022 22:24 + packageAt: index + ^ nil MCRepositoryInspector>>versionAt: {morphic ui} · ct 1/26/2022 22:25 + versionAt: index + + ^ repository versionNamed: (self versionNames at: index) MCSnapshotBrowser>>categoryAt: {listing} · ct 1/26/2022 22:36 + categoryAt: index + ^ nil MCSnapshotBrowser>>classAt: {listing} · ct 1/26/2022 22:37 + classAt: index + | className environment | + className := self visibleClasses at: index. + environment := self environmentInDisplayingImage. + ^ environment at: className ifAbsent: + [environment valueOf: className] MCSnapshotBrowser>>methodAt: {listing} · ct 1/26/2022 22:34 + methodAt: index + ^ self visibleMethods at: index MCSnapshotBrowser>>protocolAt: {listing} · ct 1/26/2022 22:35 + protocolAt: index + ^ nil MCSnapshotBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:24 (changed) widgetSpecs Preferences annotationPanes ifFalse: [ ^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) + ((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4)) ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ((codePane: text) (0 0.4 1 1)) ) ]. ^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) + ((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4)) ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ((inputMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultInputFieldHeight)) ((codePane: text) (0 0.4 1 1) (0 defaultInputFieldHeight 0 0)) ) MCTool>>dragType: {morphic ui} · ct 1/26/2022 22:16 + dragType: anObject + + ^ #sourceCode MCToolWindowBuilder>>listMorph: {building-parts} · ct 1/26/2022 22:19 (changed) listMorph: listSymbol ^ self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol - menu: (listSymbol, 'ListMenu:') asSymbol + menu: (listSymbol, 'ListMenu:') asSymbol + keystroke: nil + drag: (listSymbol, 'At:') asSymbol MCToolWindowBuilder>>listMorph:selection: {building-parts} · ct 1/26/2022 22:27 (changed) listMorph: listSymbol selection: selectionSymbol - self listMorph: listSymbol selection: selectionSymbol menu: nil + ^ self listMorph: listSymbol selection: selectionSymbol menu: nil MCToolWindowBuilder>>listMorph:selection:menu: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol - self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil + ^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil MCToolWindowBuilder>>listMorph:selection:menu:keystroke: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol - | list | - list := builder pluggableListSpec new. - list - model: tool; - list: listSymbol; - getIndex: selectionSymbol; - setIndex: (selectionSymbol, ':') asSymbol; - frame: currentFrame. - menuSymbol ifNotNil: [list menu: menuSymbol]. - keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. - window children add: list + ^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil drag: nil MCToolWindowBuilder>>listMorph:selection:menu:keystroke:drag: {building-parts} · ct 1/26/2022 22:27 + listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol drag: dragSymbol + | list | + list := builder pluggableListSpec new. + list + model: tool; + list: listSymbol; + getIndex: selectionSymbol; + setIndex: (selectionSymbol, ':') asSymbol; + frame: currentFrame; + dragItem: dragSymbol; + dragType: #dragType:. + menuSymbol ifNotNil: [list menu: menuSymbol]. + keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. + window children add: list MCVersion>>browse {actions} · ct 1/27/2022 00:24 (changed) browse - (MCSnapshotBrowser forSnapshot: self snapshot) - label: 'Snapshot of ', self fileName; + ^ (MCSnapshotBrowser forSnapshot: self snapshot) + label: ('Snapshot of {1}' translated format: {self fileName}); show MCVersionHistoryBrowser>>versionAt: {accessing} · ct 1/27/2022 00:16 + versionAt: index + ^ self repositoryGroup versionWithInfo: (self infos at: index) MCVersionHistoryBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:16 (changed) widgetSpecs ^ #( - ((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1)) + ((listMorph:selection:menu:keystroke:drag: list selection getMenu: nil versionAt:) (0 0 0.3 1)) ((textMorph: summary) (0.3 0 1 1)) ) MCVersionInspector>>browse {accessing} · ct 1/26/2022 22:02 (changed) browse - self version browse + ^ self version browse MCWorkingCopy>>browse {ui} · ct 1/27/2022 00:25 (changed) browse - (MCSnapshotBrowser forSnapshot: self package snapshot) - label: 'Snapshot Browser: ', self packageName; - show. + ^ (MCSnapshotBrowser forSnapshot: self package snapshot) + label: ('Snapshot Browser: {1}' translated format: {self packageName}); + show MCWorkingCopyBrowser>>repositoryAt: {morphic ui} · ct 1/26/2022 22:20 + repositoryAt: index + ^ self repositories at: index MCWorkingCopyBrowser>>workingCopyAt: {morphic ui} · ct 1/26/2022 22:19 + workingCopyAt: index + ^ self workingCopies at: index =============== Summary (browse&drag-Tools+System.cs) =============== Change Set: browse&drag-Tools+System Date: 27 January 2022 Author: Christoph Thiede This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for some changes tools and browsers, and providing proper implementations of #browse for changes. All affected tools: - Change sorters (single + dual), change set browser - Dependency browser - Package browser - Preferences (no UI support yet, just follow the idiom to answer the browsing tool from #browse) =============== Postscript =============== ('accessing' author classChanges classRemoves editPostscript hasPostscript methodChanges methodInfoFromRemoval: name name: numberOfChanges postscriptHasDependents printOn: removePostscript structures superclasses) ('change logging' addClass: changeClass:from: event: noteNewMethod:forClass:selector:priorMethod: removeSelector:class:priorMethod:lastMethodInfo: renameClass:from:to:) ('class changes' changedClassNames changedClasses changedClassesDo: classChangeAt: commentClass: containsClass: fatDefForClass: noteClassForgotten: noteClassStructure: noteRemovalOf: reorganizeClass: trimHistory) ('converting' convertApril2000:using: convertToCurrentVersion:refStream:) ('fileIn/Out' askAddedInstVars: askRemovedInstVars: askRenames:addTo:using: assurePostscriptExists assurePreambleExists buildMessageForMailOutWithUser: checkForAlienAuthorship checkForAnyAlienAuthorship checkForConversionMethods checkForSlips checkForUnclassifiedMethods checkForUncommentedClasses checkForUncommentedMethods checkForUnsentMessages chooseSubjectPrefixForEmail defaultChangeSetDirectory fileOut fileOutChangesFor:on: fileOutOn: fileOutPSFor:on: fileOutPostscriptOn: fileOutPreambleOn: lookForSlips mailOut objectForDataStream: postscript postscriptString postscriptString: postscript: preamble preambleString preambleString: preambleTemplate preamble: setPreambleToSay: summaryString summaryStringDelta: verboseFileOut) ('initialize-release' beIsolationSetFor: clear initialize isMoribund veryDeepCopyWith: wither zapHistory) ('isolation layers' invoke isolatedProject isolationSet: revoke uninstall) ('method changes' adoptSelector:forClass: atSelector:class:put: changedMessageList changedMessageListAugmented changedMethods changedMethodsDo: hasAnyChangeForSelector: messageListForChangesWhich:ifNone: methodChangesAtClass: removeSelectorChanges:class: selectorsInClass:) ('moving changes' absorbClass:from: absorbMethod:class:from: absorbStructureOfClass:from: assimilateAllChangesFoundIn: editPreamble expungeEmptyClassChangeEntries expungeUniclasses forgetAllChangesFoundIn: forgetChangesForClass:in: hasPreamble methodsWithAnyInitialsOtherThan: methodsWithInitialsOtherThan: methodsWithoutComments removeClassAndMetaClassChanges: removeClassChanges: removePreamble) ('testing' belongsToAProject containsMethodAtPosition: correspondingProject isEmpty methodsWithoutClassifications okayToRemove okayToRemoveInforming: projectsBelongedTo) ('private' addCoherency: atClass:add: atClass:includes: atSelector:class: changed:with: changeRecorderFor: fileOutClassDefinition:on: oldNameFor:) ('*Monticello-testing' isForPackageLoad) ('*Etoys-Squeakland-fileIn/Out' checkForSUnit) ('*Tools-Browsing' browse) =============== Diff =============== ChangeSet>>browse {*Tools-Browsing} · ct 1/26/2022 22:03 + browse + + ^ ChangeSetBrowser openOn: self ChangeSorter>>buildChangeSetListWith: {toolbuilder} · ct 1/26/2022 22:04 (changed) buildChangeSetListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #changeSetList; getSelected: #currentCngSet; setSelected: #showChangeSetNamed:; menu: #changeSetMenu:shifted:; keyPress: #changeSetListKey:from:; dragItem: #dragChangeSet:; + dragType: #dragTypeForChangeSet:; autoDeselect: false. ^ listSpec ChangeSorter>>buildClassListWith: {toolbuilder} · ct 1/26/2022 22:06 (changed) buildClassListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #classList; getSelected: #currentClassName; setSelected: #currentClassName:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:; - dragItem: #dragClass:. + dragItem: #dragClass:; + dragType: #dragTypeForClass:. ^ listSpec ChangeSorter>>buildMessageListWith: {toolbuilder} · ct 1/26/2022 22:07 (changed) buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageList; getSelected: #currentSelector; setSelected: #currentSelector:; menu: #messageMenu:shifted:; keyPress: #messageListKey:from:; - dragItem: #dragMessage:. + dragItem: #dragMessage:; + dragType: #dragTypeForMessage:. ^ listSpec ChangeSorter>>dragTypeForChangeSet: {dragging} · ct 1/26/2022 22:04 + dragTypeForChangeSet: anIndex + + ^ #sourceCode ChangeSorter>>dragTypeForClass: {dragging} · ct 1/26/2022 22:06 + dragTypeForClass: anIndex + + ^ #sourceCode ChangeSorter>>dragTypeForMessage: {dragging} · ct 1/26/2022 22:06 + dragTypeForMessage: anIndex + + ^ #sourceCode DependencyBrowser>>buildClassDepsWith: {toolbuilder} · ct 1/27/2022 00:03 (changed) buildClassDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Required Classes' ; list: #classDepsList; getIndex: #classDepsIndex; setIndex: #classDepsIndex:; menu: #classDepsMenu:; - keyPress: #classDepsKey:from:. + keyPress: #classDepsKey:from:; + dragItem: #dragFromClassDepAt:; + dragType: #dragTypeForClassDepAt:. ^listSpec DependencyBrowser>>buildClassListWith: {toolbuilder} · ct 1/27/2022 00:07 (changed) buildClassListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client classes' ; list: #classList; getIndex: #classListIndex; setIndex: #classListIndex:; menu: #classListMenu:; - keyPress: #classListKey:from:. + keyPress: #classListKey:from:; + dragItem: #dragFromClassAt:; + dragType: #dragTypeForClassAt:. ^listSpec DependencyBrowser>>buildMessageListWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client methods' ; list: #messageList; getIndex: #messageListIndex; setIndex: #messageListIndex:; menu: #messageListMenu:; - keyPress: #messageListKey:from:. + keyPress: #messageListKey:from:; + dragItem: #dragFromMessageAt:; + dragType: #dragTypeForMessageAt:. ^listSpec DependencyBrowser>>buildPackageDepsWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildPackageDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. - listSpec + listSpec model: self; - name: 'Required Packages' ; - list: #packageDepsList; - getIndex: #packageDepsIndex; - setIndex: #packageDepsIndex:; - menu: #packageDepsMenu:; - keyPress: #packageDepsKey:from:. - ^listSpec + name: 'Required Packages'; + list: #packageDepsList; + getIndex: #packageDepsIndex; + setIndex: #packageDepsIndex:; + menu: #packageDepsMenu:; + keyPress: #packageDepsKey:from:; + dragItem: #dragFromPackageDepAt:; + dragType: #dragTypeForPackageDepAt:. + ^ listSpec DependencyBrowser>>buildPackageListWith: {toolbuilder} · ct 1/27/2022 00:06 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Packages' ; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageListMenu:; - keyPress: #packageListKey:from:. + keyPress: #packageListKey:from:; + dragItem: #dragFromPackageAt:; + dragType: #dragTypeForPackageAt:. ^listSpec DependencyBrowser>>dragFromClassAt: {class list} · ct 1/27/2022 00:08 + dragFromClassAt: anInteger + + ^ self environment classNamed: (self classList at: anInteger) DependencyBrowser>>dragFromClassDepAt: {class dependencies} · ct 1/27/2022 00:04 + dragFromClassDepAt: anInteger + + ^ self environment classNamed: (self classDeps at: anInteger) DependencyBrowser>>dragFromMessageAt: {message list} · ct 1/27/2022 00:08 + dragFromMessageAt: anInteger + + ^ self selectedClass >> (self messageList at: anInteger) DependencyBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:10 + dragFromPackageAt: anInteger + + ^ PackageInfo named: (self packageList at: anInteger) DependencyBrowser>>dragFromPackageDepAt: {package dependencies} · ct 1/27/2022 00:11 + dragFromPackageDepAt: anInteger + + ^ PackageInfo named: (self packageDeps at: anInteger) DependencyBrowser>>dragTypeForClassAt: {class list} · ct 1/27/2022 00:07 + dragTypeForClassAt: anInteger + + ^ #sourceCode DependencyBrowser>>dragTypeForClassDepAt: {class dependencies} · ct 1/27/2022 00:04 + dragTypeForClassDepAt: anInteger + + ^ #sourceCode DependencyBrowser>>dragTypeForMessageAt: {message list} · ct 1/27/2022 00:08 + dragTypeForMessageAt: anInteger + + ^ #sourceCode DependencyBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:10 + dragTypeForPackageAt: anInteger + + ^ #sourceCode DependencyBrowser>>dragTypeForPackageDepAt: {package dependencies} · ct 1/27/2022 00:09 + dragTypeForPackageDepAt: anInteger + + ^ #sourceCode PackagePaneBrowser>>buildPackageListWith: {toolbuilder} · ct 1/27/2022 00:11 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: #packageList; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageMenu:; - keyPress: #packageListKey:from:. + keyPress: #packageListKey:from:; + dragItem: #dragFromPackageAt:; + dragType: #dragTypeForPackageAt:. ^listSpec PackagePaneBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:12 + dragFromPackageAt: anInteger + + ^ PackageInfo named: (self packageList at: anInteger) PackagePaneBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:11 + dragTypeForPackageAt: anInteger + + ^ #sourceCode PragmaPreference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse - ToolSet + ^ ToolSet browse: self provider class - selector: self selectors first. + selector: self selectors first Preference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse - ToolSet + ^ ToolSet browse: Preferences class - selector: self selectors first. + selector: self selectors first --- Sent from Squeak Inbox Talk ["genericDropSourceCode.1.cs"] ["browse&drop-Monticello.1.cs"] ["browse&drag-Tools+System.1.cs"]

8 10

The Inbox: KernelTests-jar.429.mcz
by commits＠source.squeak.org 05 Jun '22

05 Jun '22

A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-jar.429.mcz ==================== Summary ==================== Name: KernelTests-jar.429 Author: jar Time: 5 June 2022, 7:16:44.422705 pm UUID: 39150694-f022-7643-83f7-b548fb60b03a Ancestors: KernelTests-jar.428 One more process test to check correct handling of unwind error (errors signaled inside unwind blocks during termination). =============== Diff against KernelTests-jar.428 =============== 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: unwindBlock ] 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!

1 0

Jump to page: