The Inbox: Tools-ct.987.mcz

Christoph Thiede uploaded a new version of Tools to project The Inbox:
http://source.squeak.org/inbox/Tools-ct.987.mcz

==================== Summary ====================

Name: Tools-ct.987
Author: ct
Time: 3 September 2020, 2:45:32.786083 pm
UUID: e07c870e-186e-f54a-9dbc-b766b1cb2bbb
Ancestors: Tools-ct.985

Fixes several issues with accepting source in debuggers. Applies overall refactoring to Debugger>>#contents:notifying:.

With this version, two concrete regressions are fixed that were introduced with the SistaV1 bytecode set (see [1]):
- When compiling a method from a block context and answering subsequent parser notifications, make sure the source code is not lost. A variant of this issue was filed by Eliot (emm) in [2].
- When removing a method from a block context, make sure the stack is unwinded correctly.

Further adjustments:
- Don't restart the current context if a different selector is changed.
- Update contentsSelection correctly without morphic hack. Works now in MVC, again.

[1] http://forum.world.st/The-Inbox-Kernel-dtl-1310-mcz-td5113032.html
[2] http://forum.world.st/tedious-programming-in-the-debugger-error-needs-fixing-td5109568.html

=============== Diff against Tools-ct.985 ===============

Item was changed:
  ----- Method: Debugger>>contents:notifying: (in category 'accessing') -----
  contents: aText notifying: aController
+ "Accept new method source of the selected context."
- "The retrieved information has changed and its source must now be updated.
- In this case, the retrieved information is the method of the selected context."
- | result selector classOfMethod category h ctxt newMethod |
- contextStackIndex = 0 ifTrue:
- [^false].
- self selectedContext isExecutingBlock ifTrue:
- [h := self selectedContext activeHome.
- h ifNil:
- [self inform: 'Method for block not found on stack, can''t edit and continue'.
- ^false].
- (self confirm: 'I will have to revert to the method from\which this block originated.  Is that OK?' withCRs) ifFalse:
- [^false].
- self resetContext: h changeContents: false.
- "N.B. Only reset the contents if the compilation succeeds.  If contents are reset
- when compilation fails both compiler error message and modifications are lost."
- (result := self contents: aText notifying: aController) ifTrue:
- [self contentsChanged].
- ^result].
 
+ | selector classOfMethod category ctxt newMethod |
+ contextStackIndex = 0 ifTrue: [^ false].
+
+ "First, handle some edge cases"
+ selector := self selectedClass newParser parseSelector: aText.
+ "selector isDoIt ifTrue: [
+ currentCompiledMethod := self compileDoIt: aText]."
+ self flag: #todo. "ct: Recompile doIt method *without* creating method litters!! See Compiler>>#evaluateCue:ifFail:."
+ selector = self selectedMessageName ifFalse: [
+ "Different message compiled, delegating to super"
+ ^ super contents: aText notifying: aController].
+
+ self selectedContext isExecutingBlock ifTrue: [
+ "If we are in a block context, we need to rewind the stack before ."
+ | home |
+ home := self selectedContext activeHome.
+ home ifNil: [
+ self inform: 'Method for block not found on stack, can''t edit and continue' translated.
+ ^ false].
+ (self confirm: 'I will have to revert to the method from\which this block originated. Is that OK?' withCRs translated) ifFalse: [
+ ^ false].
+
+ self resetContext: home changeContents: false.
+ "N.B. Only reset the contents if the compilation succeeds. If contents would be reset when compilation fails, both compiler error message and modifications were lost."
+ ^ (self contents: aText notifying: aController)
+ ifTrue: [self contentsChanged];
+ yourself].
+
  classOfMethod := self selectedClass.
  category := self selectedMessageCategoryName.
+
+ "Do the actual compilation"
- selector := self selectedClass newParser parseSelector: aText.
- (selector == self selectedMessageName
- or: [(self selectedMessageName beginsWith: 'DoIt')
- and: [selector numArgs = self selectedMessageName numArgs]]) ifFalse:
- [self inform: 'can''t change selector'.
- ^false].
  selector := classOfMethod
+ compile: aText
+ classified: category
+ notifying: aController.
+ selector ifNil: [^ false]. "compilation cancelled"
+
+ "Update views"
- compile: aText
- classified: category
- notifying: aController.
- selector ifNil: [^false]. "compile cancelled"
  contents := aText.
  newMethod := classOfMethod compiledMethodAt: selector.
+ newMethod isQuick ifTrue: [
+ self cutBackExecutionToSenderContext].
- newMethod isQuick ifTrue:
- [self cutBackExecutionToSenderContext].
  ctxt := interruptedProcess popTo: self selectedContext.
  ctxt == self selectedContext
+ ifFalse: [self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs translated]
+ ifTrue: [
+ newMethod isQuick ifFalse: [
+ interruptedProcess restartTopWith: newMethod.
+ self stepToStatement].
- ifFalse:
- [self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs]
- ifTrue:
- [newMethod isQuick ifFalse:
- [interruptedProcess
- restartTopWith: newMethod;
- stepToSendOrReturn].
  contextVariablesInspector object: nil].
  self resetContext: ctxt.
+
+ Project current addDeferredUIMessage: [
+ self changed: #contentsSelection].
+ ^ true!
- Smalltalk isMorphic ifTrue:
- [Project current world
- addAlarm: #changed:
- withArguments: #(contentsSelection)
- for: self
- at: (Time millisecondClockValue + 200)].
- ^true!

Item was changed:
  ----- Method: Debugger>>contextStackIndex:oldContextWas: (in category 'private') -----
  contextStackIndex: anInteger oldContextWas: oldContext
  "Change the context stack index to anInteger, perhaps in response to user selection."
 
  | isNewMethod |
  self saveReceiverInspectorState.
  self saveContextVariablesInspectorState.
  contextStackIndex := anInteger.
  anInteger = 0 ifTrue:
  [currentCompiledMethod := contents := nil.
  self changed: #contextStackIndex.
  self decorateButtons.
  self contentsChanged.
  contextVariablesInspector object: nil.
  receiverInspector context: nil; inspect: self receiver.
  ^self].
  isNewMethod := oldContext isNil
+ or: [oldContext home method ~= (currentCompiledMethod := self selectedContext home method)].
- or: [oldContext method ~~ (currentCompiledMethod := self selectedContext method)].
  isNewMethod ifTrue:
  [contents := self selectedMessage.
  self contentsChanged.
  self pcRange].
  self changed: #contextStackIndex.
  self decorateButtons.
  contextVariablesInspector object: self selectedContext.
  self restoreContextVariablesInspectorState.
  receiverInspector context: self selectedContext; inspect: self receiver.
  self restoreReceiverInspectorState.
  isNewMethod ifFalse:
  [self changed: #contentsSelection]!

Item was changed:
  ----- Method: Debugger>>findCleanHomeBelow: (in category 'context stack (message list)') -----
  findCleanHomeBelow: method
 
  | dirtyIndex |
  dirtyIndex := contextStack size + 1.
  contextStack reverse detect: [:context |
  dirtyIndex := dirtyIndex - 1.
+ context home method = method homeMethod].
- context method = method].
  ^ dirtyIndex + 1!

Item was added:
+ ----- Method: Debugger>>tallyMenu: (in category 'controls') -----
+ tallyMenu: aMenu
+
+ ^ aMenu
+ "title: 'Tally' translated;" flag: #todo; "ct: Implement on PluggableMenuSpec"
+ addTranslatedList: #(
+ ('Tally selection' tallyIt 'evaluate current selection and measure the time')
+ ('Record send' doRecord 'record next message send'));
+ yourself!