The Trunk: Tools-ct.987.mcz

Eliot Miranda uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/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!