452 in the debugger create subclass responsibility button does not offers the possibility to create the responsibility in subclasses of the receiver but in the exception class subclass responsibility but only after performing steps

src/NewTools-Debugger-Tests/StDebuggerActionModelTest.class.st

@@ -807,6 +807,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 [
 

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 [
 

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 ]

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