The Trunk: Morphic-mt.1390.mcz

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