Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1390.mcz
==================== Summary ====================
Name: Morphic-mt.1390 Author: mt Time: 25 January 2018, 9:52:54.634682 am UUID: 9e8d30da-71db-904c-8e9f-3fd71c497ad9 Ancestors: Morphic-mt.1389
Fixes error recursion handling for Morphic's interactive debugger.
You can do-it this now in your workspace:
[1 halt] fork. Processor yield. 2 halt.
=============== Diff against Morphic-mt.1389 ===============
Item was changed: ----- Method: Debugger class>>morphicOpenOn:context:label:contents:fullView: (in category '*Morphic-opening') ----- morphicOpenOn: process context: context label: title contents: contentsStringOrNil fullView: full "Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger." + + ErrorRecursionGuard critical: [ + + | errorWasInUIProcess debugger | + ErrorRecursion ifTrue: [ + "self assert: process == Project current uiProcess -- DOCUMENTATION ONLY" + self clearErrorRecursion. + ^ Project current handleFatalDrawingError: title]. + + [ErrorRecursion not & Preferences logDebuggerStackToFile + ifTrue: [Smalltalk logSqueakError: title inContext: context]] + on: Error + do: [:ex | ex return: nil]. + - ErrorRecursionGuard critical: - [ | errorWasInUIProcess debugger | - ErrorRecursion ifTrue: - [ "self assert: process == Project current uiProcess -- DOCUMENTATION ONLY" - ErrorRecursion := false. - ^ Project current handleFatalDrawingError: title ]. - [ ErrorRecursion not & Preferences logDebuggerStackToFile ifTrue: - [ Smalltalk - logSqueakError: title - inContext: context ] ] - on: Error - do: [ : ex | ex return: nil ]. - ErrorRecursion := true. errorWasInUIProcess := Project current spawnNewProcessIfThisIsUI: process. + "Schedule debugging in deferred UI message because + 1) If process is the current UI process, it is already broken. + 2) If process is some other process, it must not execute UI code" + Project current addDeferredUIMessage: [ + self setErrorRecursion. + + debugger := self new process: process controller: nil context: context. - 1) If process is the current UI process, it is already broken. - 2) If process is some other process, it must not execute UI code" - Project current addDeferredUIMessage: - [ debugger := self new - process: process - controller: nil - context: context. full + ifTrue: [debugger openFullNoSuspendLabel: title] + ifFalse: [debugger openNotifierContents: contentsStringOrNil label: title]. - ifTrue: [ debugger openFullNoSuspendLabel: title ] - ifFalse: - [ debugger - openNotifierContents: contentsStringOrNil - label: title ]. debugger errorWasInUIProcess: errorWasInUIProcess. + "Try drawing the debugger tool at least once to avoid freeze." Project current world displayWorldSafely. + + self clearErrorRecursion]]. + + process suspend.! - ErrorRecursion := false ]]. - process suspend !
Item was changed: ----- Method: WorldState>>displayWorldSafely: (in category 'update cycle') ----- displayWorldSafely: aWorld "Update this world's display and keep track of errors during draw methods."
| finished errors previousClasses | finished := false. errors := nil. [finished] whileFalse: [ [aWorld displayWorld. finished := true] on: Error do: [:ex | "Handle a drawing error" | err rcvr errCtx errMorph | err := ex description. rcvr := ex receiver.
errCtx := thisContext. [ errCtx := errCtx sender. "Search the sender chain to find the morph causing the problem" [errCtx notNil and:[(errCtx receiver isMorph) not]] whileTrue:[errCtx := errCtx sender]. "If we're at the root of the context chain then we have a fatal drawing problem" errCtx ifNil:[^Project current handleFatalDrawingError: err]. errMorph := errCtx receiver. "If the morph causing the problem has already the #drawError flag set, then search for the next morph above in the caller chain." errMorph hasProperty: #errorOnDraw ] whileTrue. errMorph setProperty: #errorOnDraw toValue: true.
"Catch all errors, one for each receiver class." errors ifNil: [errors := OrderedCollection new]. previousClasses ifNil: [previousClasses := IdentitySet new]. (previousClasses includes: rcvr class) ifFalse: [ previousClasses add: rcvr class. errors add: (Process forContext: ex signalerContext copyStack priority: Processor activeProcess priority) -> err]. aWorld fullRepaintNeeded. ]].
"Open debuggers for all different errors found." errors ifNotNil: [ + Debugger setErrorRecursion. + errors do: [:ea | - [errors do: [:ea | (Debugger new process: ea key controller: nil context: ea key suspendedContext) errorWasInUIProcess: Processor activeProcess = Project current uiProcess; openNotifierContents: nil label: ea value]. "Try to draw the debuggers or else there will be no chance to escape from this catch-drawing-error loop." + ActiveWorld displayWorld. + Debugger clearErrorRecursion].! - ActiveWorld displayWorld] on: Error do: [:ex | Project current handleFatalDrawingError: ex description] ].!