fix debug points to be able to set a variable breakpoint, scoped to a…

… subclass (excluding all accesses in brother/cousin classes)
adri09070 · Apr 30, 2024 · 372702a · 372702a
1 parent 17e5ada
commit 372702a
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 16 deletions.
diff --git a/src/DebugPoints/DebugPoint.class.st b/src/DebugPoints/DebugPoint.class.st
@@ -204,19 +204,6 @@ DebugPoint >> install [
 	self target install: self link
 ]
 
-{ #category : 'API' }
-DebugPoint >> instanceVariable: aSlot accessStrategy: aSymbol [
-
-	target := DebugPointInstanceVariableTarget new
-		          instanceVariable: aSlot;
-		          accessStrategy: aSymbol;
-		          yourself.
-
-	name := 'var_{1}_{2}' format: {
-			        aSlot name.
-			        aSymbol }
-]
-
 { #category : 'accessing' }
 DebugPoint >> link [
 	^metaLink
@@ -374,6 +361,20 @@ DebugPoint >> targetClass [
 	^ self target targetClass
 ]
 
+{ #category : 'API' }
+DebugPoint >> targetClass: aClass instanceVariable: aSlot accessStrategy: aSymbol [
+
+	target := DebugPointInstanceVariableTarget new
+					 targetClass: aClass;
+		          instanceVariable: aSlot;
+		          accessStrategy: aSymbol;
+		          yourself.
+
+	name := 'var_{1}_{2}' format: {
+			        aSlot name.
+			        aSymbol }
+]
+
 { #category : 'scope' }
 DebugPoint >> targetInstance: anObject [
 

diff --git a/src/DebugPoints/DebugPointInstanceVariableTarget.class.st b/src/DebugPoints/DebugPointInstanceVariableTarget.class.st
@@ -7,7 +7,8 @@ Class {
 	#name : 'DebugPointInstanceVariableTarget',
 	#superclass : 'DebugPointClassTarget',
 	#instVars : [
-		'accessStrategy'
+		'accessStrategy',
+		'targetClass'
 	],
 	#category : 'DebugPoints-Implementations',
 	#package : 'DebugPoints',
@@ -110,5 +111,11 @@ DebugPointInstanceVariableTarget >> removeFromMethod: aMethod for: aDebugPoint [
 { #category : 'accessing' }
 DebugPointInstanceVariableTarget >> targetClass [
 
-	^ self instanceVariable owningClass
+	^ targetClass ifNil: [ targetClass := self instanceVariable owningClass ]
+]
+
+{ #category : 'accessing' }
+DebugPointInstanceVariableTarget >> targetClass: anObject [
+
+	^ targetClass := anObject
 ]
diff --git a/src/DebugPoints/DebugPointManager.class.st b/src/DebugPoints/DebugPointManager.class.st
@@ -102,6 +102,7 @@ DebugPointManager class >> installNew: aDebugPointClass forObject: anObject onVa
 	| dp instanceVariable |
 	instanceVariable := anObject class slotNamed: aSlotNameSymbol.
 	dp := aDebugPointClass new
+		      targetClass: anObject class
 		      instanceVariable: instanceVariable
 		      accessStrategy: anAccessStrategySymbol;
 		      targetInstance: anObject;
@@ -217,7 +218,8 @@ DebugPointManager class >> installNew: aDebugPointClass inClass: aClass onVariab
 	| dp instanceVariable |
 	instanceVariable := aClass lookupVar: aSlotNameSymbol.
 	dp := aDebugPointClass new
-		      instanceVariable: instanceVariable
+		      targetClass: aClass
+		      instanceVariable: instanceVariable 
 		      accessStrategy: anAccessStrategySymbol;
 		      yourself.