From c370a99aef84848ceab2ddbc0d58fce7af951e57 Mon Sep 17 00:00:00 2001 From: Carolina Hernandez Date: Mon, 13 Nov 2023 13:12:59 -0300 Subject: [PATCH] Merge --- .../SpChangeSorterPresenter.class.st | 3 +- .../ClassDescription.extension.st | 8 ++++ .../CompiledMethod.extension.st | 14 +++++++ .../RPackage.extension.st | 8 ++++ .../StCritiqueBrowserPresenter.class.st | 38 ++++++++--------- .../StDebuggerActionModelTest.class.st | 28 +++++++++---- .../StDebuggerCommandTest.class.st | 41 +++++++++++++++++++ .../StTestDebuggerProvider.class.st | 25 +++++++++++ src/NewTools-Debugger/StDebugger.class.st | 16 +++++++- .../StDebuggerActionModel.class.st | 5 ++- .../Pragma.extension.st | 11 +++-- .../MessageListPresenter.class.st | 3 +- .../StRewriterRuleEditorPresenter.class.st | 2 +- .../SystemWindow.extension.st | 2 +- 14 files changed, 163 insertions(+), 41 deletions(-) create mode 100644 src/NewTools-CodeCritiques/ClassDescription.extension.st create mode 100644 src/NewTools-CodeCritiques/CompiledMethod.extension.st create mode 100644 src/NewTools-CodeCritiques/RPackage.extension.st diff --git a/src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st b/src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st index cd5d098e6..c6ea141cc 100644 --- a/src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st +++ b/src/NewTools-ChangeSorter/SpChangeSorterPresenter.class.st @@ -394,8 +394,7 @@ SpChangeSorterPresenter >> initialize [ SpChangeSorterPresenter >> initializeAnnouncements [ SystemAnnouncer uniqueInstance weak - when: ClassAdded , ClassCommented , ClassRecategorized , ClassModifiedClassDefinition , ClassRemoved , ClassRenamed , MethodAdded , MethodModified - , MethodRecategorized , MethodRemoved , ProtocolAnnouncement + when: ClassAdded , ClassCommented , ClassRepackaged , ClassModifiedClassDefinition , ClassRemoved , ClassRenamed , MethodAdded , MethodModified , MethodRecategorized , MethodRemoved , ProtocolAnnouncement send: #updateClassesList to: self ] diff --git a/src/NewTools-CodeCritiques/ClassDescription.extension.st b/src/NewTools-CodeCritiques/ClassDescription.extension.st new file mode 100644 index 000000000..a54b20207 --- /dev/null +++ b/src/NewTools-CodeCritiques/ClassDescription.extension.st @@ -0,0 +1,8 @@ +Extension { #name : 'ClassDescription' } + +{ #category : '*NewTools-CodeCritiques' } +ClassDescription >> criticNameOn: aStream [ + "This behavior may be folded later by changing the name of this method or using another one." + + aStream << self name << ' (' << self package name << ')' +] diff --git a/src/NewTools-CodeCritiques/CompiledMethod.extension.st b/src/NewTools-CodeCritiques/CompiledMethod.extension.st new file mode 100644 index 000000000..59b365696 --- /dev/null +++ b/src/NewTools-CodeCritiques/CompiledMethod.extension.st @@ -0,0 +1,14 @@ +Extension { #name : 'CompiledMethod' } + +{ #category : '*NewTools-CodeCritiques' } +CompiledMethod >> criticNameOn: aStream [ + "This behavior may be folded later by changing the name of this method or using another one." + + aStream + << self methodClass name + << '>>#' + << self selector + << ' (' + << self methodClass package name + << ')' +] diff --git a/src/NewTools-CodeCritiques/RPackage.extension.st b/src/NewTools-CodeCritiques/RPackage.extension.st new file mode 100644 index 000000000..cba13aac4 --- /dev/null +++ b/src/NewTools-CodeCritiques/RPackage.extension.st @@ -0,0 +1,8 @@ +Extension { #name : 'RPackage' } + +{ #category : '*NewTools-CodeCritiques' } +RPackage >> criticNameOn: aStream [ + "This behavior may be folded later by changing the name of this method or using another one." + + aStream << self packageName +] diff --git a/src/NewTools-CodeCritiques/StCritiqueBrowserPresenter.class.st b/src/NewTools-CodeCritiques/StCritiqueBrowserPresenter.class.st index 4d61da85f..4018bd5e5 100644 --- a/src/NewTools-CodeCritiques/StCritiqueBrowserPresenter.class.st +++ b/src/NewTools-CodeCritiques/StCritiqueBrowserPresenter.class.st @@ -143,32 +143,28 @@ StCritiqueBrowserPresenter >> allRules [ { #category : 'private' } StCritiqueBrowserPresenter >> applyRules [ + | packageCount nbPackage process rules | rules := self allRules. nbPackage := rbEnvironment packages size. packageCount := 0. self updateTree. - process := [ rbEnvironment packages - do: [ :package | - | windowTitle | - packageCount := packageCount + 1. - windowTitle := String - streamContents: [ :s | - s << 'run rules on ' << package packageName << ' (' - << packageCount asString << '/' << nbPackage asString << ')' ]. - self setTitle: windowTitle. - checker - runRules: rules - onPackage: package - withoutTestCase: removeTestCase ]. - checker rule: rules. - self setTitle: self defaultTitle. - cache packages: rbEnvironment. - cache initCache. - self rules: (self allRules select: [ :r | self hasBrokenRules: r]). - self rulesModel refresh. - self rebuildLayout. - self updateTree. ] newProcess. + process := [ + rbEnvironment packages do: [ :package | + | windowTitle | + packageCount := packageCount + 1. + windowTitle := String streamContents: [ :s | + s << 'run rules on ' << package name << ' (' << packageCount asString << '/' << nbPackage asString << ')' ]. + self setTitle: windowTitle. + checker runRules: rules onPackage: package withoutTestCase: removeTestCase ]. + checker rule: rules. + self setTitle: self defaultTitle. + cache packages: rbEnvironment. + cache initCache. + self rules: (self allRules select: [ :r | self hasBrokenRules: r ]). + self rulesModel refresh. + self rebuildLayout. + self updateTree ] newProcess. process name: 'SmallLint'. process resume ] diff --git a/src/NewTools-Debugger-Tests/StDebuggerActionModelTest.class.st b/src/NewTools-Debugger-Tests/StDebuggerActionModelTest.class.st index 5e05ecd41..cf339eb19 100644 --- a/src/NewTools-Debugger-Tests/StDebuggerActionModelTest.class.st +++ b/src/NewTools-Debugger-Tests/StDebuggerActionModelTest.class.st @@ -113,7 +113,7 @@ StDebuggerActionModelTest >> methodWithBlockContext [ { #category : 'helper' } StDebuggerActionModelTest >> methodWithDeadBlockContext [ - ^ [ (1+1 ) printString ] + ^ [ (1 + 1) printString ] ] { #category : 'helper' } @@ -127,14 +127,13 @@ StDebuggerActionModelTest >> newSessionWithBlockContext [ | process method | method := self class >> #methodWithBlockContext. methodWithBlockContextOriginalSource := method sourceCode. - process := [ method valueWithReceiver: self arguments: #( ) ] - newProcess. - self - setSessionAndDebuggerModelForMethod: method - inContext: process suspendedContext. + process := [ method valueWithReceiver: self arguments: #( ) ] newProcess. + self setSessionAndDebuggerModelForMethod: method inContext: process suspendedContext. - 4 timesRepeat: [ - debugActionModel stepInto: debugActionModel topContext ] + [ debugActionModel topContext closure isNil ] whileTrue: [ + debugActionModel stepInto: debugActionModel topContext ]. + "Step on (1 + 1) message" + debugActionModel stepInto: debugActionModel topContext ] { #category : 'helper' } @@ -807,6 +806,19 @@ StDebuggerActionModelTest >> testIsInterruptedContextSubclassResponsibilityExcep self assert: debugActionModel isInterruptedContextSubclassResponsibilityException ] +{ #category : 'tests - predicates' } +StDebuggerActionModelTest >> testIsInterruptedContextSubclassResponsibilityExceptionWithSteps [ + + | dummyActionModel | + dummyActionModel := StTestDebuggerProvider new + debuggerWithMissingSubclassResponsibilityContextWithSteps + debuggerActionModel. + self changeSession: dummyActionModel session. + dummyActionModel clear. + self assert: + debugActionModel isInterruptedContextSubclassResponsibilityException +] + { #category : 'tests - actions' } StDebuggerActionModelTest >> testPeelToFirstLike [ diff --git a/src/NewTools-Debugger-Tests/StDebuggerCommandTest.class.st b/src/NewTools-Debugger-Tests/StDebuggerCommandTest.class.st index b2ac601ae..a28b95a5d 100644 --- a/src/NewTools-Debugger-Tests/StDebuggerCommandTest.class.st +++ b/src/NewTools-Debugger-Tests/StDebuggerCommandTest.class.st @@ -241,6 +241,47 @@ StDebuggerCommandTest >> testCommandsInMissingSubclassResponsibilityContext [ debugger debuggerActionModel clear ] +{ #category : 'tests' } +StDebuggerCommandTest >> testCommandsInMissingSubclassResponsibilityContextWithSteps [ + + | debugger | + [ + debugger := debuggerProvider + debuggerWithMissingSubclassResponsibilityContextWithSteps. + self assert: debugger debuggerActionModel + isInterruptedContextSubclassResponsibilityException. + + "Executable commands relative to context" + self assert: + (StDefineSubclassResponsabilityCommand forContext: debugger) + canBeExecuted. + self assert: + (StDefineMissingEntityCommand forContext: debugger) canBeExecuted. + self assert: (StRestartCommand forContext: debugger) canBeExecuted. + self assert: + (StReturnValueCommand forContext: debugger) canBeExecuted. + + "Non-executable commands relative to context" + self deny: (StStepIntoCommand forContext: debugger) canBeExecuted. + self deny: (StStepOverCommand forContext: debugger) canBeExecuted. + self deny: (StStepThroughCommand forContext: debugger) canBeExecuted. + self deny: + (StRunToSelectionCommand forContext: debugger) canBeExecuted. + self deny: (StProceedCommand forContext: debugger) canBeExecuted. + self deny: (StDefineClassCommand forContext: debugger) canBeExecuted. + self deny: (StDefineMethodCommand forContext: debugger) canBeExecuted. + + "Executable commands, whatever the context" + self assert: + (StCopyStackToClipboardCommand forContext: debugger) canBeExecuted. + self assert: + (StFileOutMethodCommand forContext: debugger) canBeExecuted. + self assert: + (StPeelToFirstCommand forContext: debugger) canBeExecuted. + self assert: (StWhereIsCommand forContext: debugger) canBeExecuted ] + ensure: [ debugger ifNotNil: [ debugger clear ] ] +] + { #category : 'tests' } StDebuggerCommandTest >> testCommandsInRunnableContext [ diff --git a/src/NewTools-Debugger-Tests/StTestDebuggerProvider.class.st b/src/NewTools-Debugger-Tests/StTestDebuggerProvider.class.st index 625236ede..08490ea2d 100644 --- a/src/NewTools-Debugger-Tests/StTestDebuggerProvider.class.st +++ b/src/NewTools-Debugger-Tests/StTestDebuggerProvider.class.st @@ -94,6 +94,31 @@ StTestDebuggerProvider >> debuggerWithMissingSubclassResponsibilityContext [ ^ self newDebugger ] ] +{ #category : 'helpers' } +StTestDebuggerProvider >> debuggerWithMissingSubclassResponsibilityContextWithSteps [ + + | ctx dbg | + ctx := [ + StDummyDebuggerPresenter new + unimplementedSubclassResponsibility ] asContext. + + self + sessionFor: ctx + exception: (OupsNullException fromSignallerContext: ctx). + dbg := self newDebugger. + dbg + application: dbg class currentApplication; + initialize. + "We reach the subclass responsability" + dbg + stepOver; + stepOver; + stepInto; + stepOver. + + ^ dbg +] + { #category : 'helpers' } StTestDebuggerProvider >> debuggerWithObjectHalting [ [ StDebuggerObjectForTests new haltingMethod ] diff --git a/src/NewTools-Debugger/StDebugger.class.st b/src/NewTools-Debugger/StDebugger.class.st index 445620192..90fac8660 100644 --- a/src/NewTools-Debugger/StDebugger.class.st +++ b/src/NewTools-Debugger/StDebugger.class.st @@ -448,11 +448,13 @@ StDebugger >> createMissingMethodFor: aMessage in: aClass [ StDebugger >> createSubclassResponsibility [ | senderContext msg chosenClass | - senderContext := self interruptedContext sender. + senderContext := self signalingSubclassResponsabilityContext. msg := Message selector: senderContext selector arguments: senderContext arguments. - chosenClass := self requestClassFrom: senderContext receiver class to: senderContext methodClass. + chosenClass := self + requestClassFrom: senderContext receiver class + to: senderContext methodClass. chosenClass ifNil: [ ^ self ]. self debuggerActionModel implement: msg @@ -1126,6 +1128,16 @@ StDebugger >> setStackAndCodeContainer [ ifFalse: [ self stackAndCodeLayout ] ] +{ #category : 'accessing - context' } +StDebugger >> signalingSubclassResponsabilityContext [ + + | signalingContext | + signalingContext := self interruptedContext. + [ signalingContext selector = #subclassResponsibility ] whileFalse: [ + signalingContext := signalingContext sender ]. + ^ signalingContext sender +] + { #category : 'stack' } StDebugger >> stack [ ^ self debuggerActionModel stack diff --git a/src/NewTools-Debugger/StDebuggerActionModel.class.st b/src/NewTools-Debugger/StDebuggerActionModel.class.st index 5b500268e..b1a4b1f4d 100644 --- a/src/NewTools-Debugger/StDebuggerActionModel.class.st +++ b/src/NewTools-Debugger/StDebuggerActionModel.class.st @@ -338,15 +338,18 @@ StDebuggerActionModel >> recompileMethodTo: aString inContext: aContext notifyin | methodContext homePC | aContext ifNil: [ ^ self ]. + "Get the home before to recompile the method, we can lost it (for clean blocks)" + methodContext := aContext home. + self session recompileMethodTo: aString inContext: aContext notifying: aNotifyer. - methodContext := aContext home. homePC := methodContext isDead ifTrue: [ methodContext endPC ] ifFalse: [ methodContext pc ]. + previousASTScope := (methodContext compiledCode sourceNodeForPC: homePC) scope ] diff --git a/src/NewTools-Inspector-Extensions/Pragma.extension.st b/src/NewTools-Inspector-Extensions/Pragma.extension.st index ced61400e..3e1d01d59 100644 --- a/src/NewTools-Inspector-Extensions/Pragma.extension.st +++ b/src/NewTools-Inspector-Extensions/Pragma.extension.st @@ -3,9 +3,14 @@ Extension { #name : 'Pragma' } { #category : '*NewTools-Inspector-Extensions' } Pragma >> inspectionSourceCodeMethod [ - + | interval | + + interval := self sourceNode sourceInterval. ^ SpCodePresenter new - beForMethod: self method; - text: self method sourceCode; + beForMethod: method ast; + text: method sourceCode; + addTextSegmentDecoration: (SpTextPresenterDecorator forHighlight + interval: (interval first to: interval last + 1); + yourself); yourself ] diff --git a/src/NewTools-MethodBrowsers/MessageListPresenter.class.st b/src/NewTools-MethodBrowsers/MessageListPresenter.class.st index 0867e0876..46c2ccbf5 100644 --- a/src/NewTools-MethodBrowsers/MessageListPresenter.class.st +++ b/src/NewTools-MethodBrowsers/MessageListPresenter.class.st @@ -302,8 +302,7 @@ MessageListPresenter >> packageOf: anItem [ { #category : 'private' } MessageListPresenter >> protocolNameForItem: anItem [ - - ^ anItem protocolName ifNil: [ '' ] + ^ anItem category ifNil: [ '' ] ] { #category : 'actions' } diff --git a/src/NewTools-RewriterTools/StRewriterRuleEditorPresenter.class.st b/src/NewTools-RewriterTools/StRewriterRuleEditorPresenter.class.st index 7e52d8485..a7e625925 100644 --- a/src/NewTools-RewriterTools/StRewriterRuleEditorPresenter.class.st +++ b/src/NewTools-RewriterTools/StRewriterRuleEditorPresenter.class.st @@ -45,7 +45,7 @@ StRewriterRuleEditorPresenter class >> icon [ { #category : 'accessing' } StRewriterRuleEditorPresenter class >> iconName [ - ^ #workspaceIcon + ^ #workspace ] { #category : 'world menu' } diff --git a/src/NewTools-Spotter-Extensions/SystemWindow.extension.st b/src/NewTools-Spotter-Extensions/SystemWindow.extension.st index 28a11fbc1..5ec2a2ce9 100644 --- a/src/NewTools-Spotter-Extensions/SystemWindow.extension.st +++ b/src/NewTools-Spotter-Extensions/SystemWindow.extension.st @@ -5,7 +5,7 @@ SystemWindow >> stActDefault [ ^ self isTopWindow ifTrue: [ self comeToFront ] "rise above non-window morphs" - ifFalse:[ self activate ] + ifFalse:[ self restoreAndActivate ] ] { #category : '*NewTools-Spotter-Extensions' }