Merge NewTools v0.4.2.2 with debugger fixes

src/NewTools-Debugger-Breakpoints-Tools/StHaltAndBreakpointControlTest.class.st

@@ -45,7 +45,8 @@ StHaltAndBreakpointControlTest >> setUp [
 
 { #category : #running }
 StHaltAndBreakpointControlTest >> tearDown [
-	StHaltCache defaultCache registerSubscriptions.
+	StHaltCache defaultCache updateSubscriptions.
+	cache removeSubscriptions.
 	cache := nil.
 	self removeMethodsWithHalts.
 	super tearDown

src/NewTools-Debugger-Breakpoints-Tools/StHaltAndBreakpointController.class.st

@@ -45,7 +45,6 @@ StHaltAndBreakpointController >> areHaltsAndBreakpoinsEnabledFor: aProgramNode [
 
 { #category : #control }
 StHaltAndBreakpointController >> disableBreakpointNode: aProgramNode [
-	self flag: 'Fix for PR 6952: should be removed in newtools merge 4.2.2'.
 	aProgramNode breakpoints do: [ :bp | bp disable ].
 	self skipNode: aProgramNode
 ]
@@ -81,7 +80,6 @@ StHaltAndBreakpointController >> disableObjectCentricBreakpoint: anObjectCentric
 
 { #category : #control }
 StHaltAndBreakpointController >> enableBreakpointNode: aProgramNode [
-	self flag: 'Fix for PR 6952: should be removed in newtools merge 4.2.2'.
 	aProgramNode breakpoints do: [ :bp | bp enable ].
 	self removeSkipLinksFor: aProgramNode
 ]

src/NewTools-Debugger-Breakpoints-Tools/StHaltCacheTest.class.st

@@ -29,6 +29,7 @@ StHaltCacheTest >> testAddingHaltToMethod [
 
 { #category : #'testing - cache initialization' }
 StHaltCacheTest >> testCacheActivation [
+	cache removeSubscriptions.
 	cache := StHaltCache new.
 	cache isActive: true.
 	self assert: cache isActive.
@@ -37,6 +38,7 @@ StHaltCacheTest >> testCacheActivation [
 
 { #category : #'testing - cache initialization' }
 StHaltCacheTest >> testCacheDectivation [
+	cache removeSubscriptions.
 	cache := StHaltCache new.
 	cache isActive: true.
 	self assert: (SystemAnnouncer uniqueInstance hasSubscriber: cache).

src/NewTools-Debugger-Extensions/DebugSession.extension.st

@@ -8,15 +8,16 @@ DebugSession >> browse: aContext [
 
 { #category : #'*NewTools-Debugger-Extensions' }
 DebugSession >> isInterruptedContextAnAssertionFailure [
-	| exceptionClass |
-	exceptionClass := self interruptedContext temporaries
-		at: #exception
-		ifAbsent: [ ^ false ].
-	self flag: 'Will be simplified when debug sessions will know their exception'.
-	^ exceptionClass notNil
-		and: [ (exceptionClass isKindOf: TestFailure)
-				or: [ exceptionClass isClass
-						and: [ exceptionClass includesBehavior: TestFailure ] ] ]
+	| variable exceptionClass |
+	variable := (self interruptedContext temporaryVariableNamed:
+		             #exception) ifNil: [ ^ false ].
+	exceptionClass := variable readInContext: self interruptedContext.
+	self flag:
+		'Will be simplified when debug sessions will know their exception'.
+	^ exceptionClass notNil and: [ 
+		  (exceptionClass isKindOf: TestFailure) or: [ 
+			  exceptionClass isClass and: [ 
+				  exceptionClass includesBehavior: TestFailure ] ] ]
 ]
 
 { #category : #'*NewTools-Debugger-Extensions' }

src/NewTools-Debugger/StDebugger.class.st

@@ -1138,13 +1138,14 @@ StDebugger >> updateExtensionsFrom: newSession [
 StDebugger >> updateInspectorFromContext: aContext [
 	inspector
 		updateLayoutForContexts: self session interruptedContext
-		isAssertionFailure: self debuggerActionModel isInterruptedContextAnAssertEqualsFailure.
-	inspector
-		updateWith:
-			(StDebuggerContext
-				context: aContext
-				session: self session
-				debugger: self)
+		isAssertionFailure:
+		self debuggerActionModel isInterruptedContextAnAssertEqualsFailure.
+	inspector updateWith: (StDebuggerContext
+			 context: aContext
+			 session: self session
+			 debugger: self).
+	self flag: #DBG_INSPECTOR_UPDATE_BUG.
+	inspector getRawInspectorPresenterOrNil ifNotNil: [:p| p update].
 ]
 
 { #category : #'updating actions' }
@@ -1173,6 +1174,8 @@ StDebugger >> updateStep [
 	self updateExtensionsFrom: self session.
 	self updateTitle.
 	self updateToolbarDebugActions.
+	self flag: #DBG_INSPECTOR_UPDATE_BUG.
+	inspector getRawInspectorPresenterOrNil ifNotNil: [:p| p update].
 ]
 
 { #category : #'updating actions' }

src/NewTools-Debugger/StDebuggerActionModel.class.st

@@ -114,10 +114,10 @@ StDebuggerActionModel >> isInterruptedContextDoesNotUnderstand [
 
 { #category : #'debug - predicates' }
 StDebuggerActionModel >> isInterruptedContextError [
-	self flag: 'Does not pass yet: we need a secure way of knowing the session was opened from **any** kind of exception'.
-	^ (self session interruptedContext temporaries
-		at: #exception
-		ifAbsent: [ ^ false ]) notNil
+	self flag:
+		'Does not pass yet: we need a secure way of knowing the session was opened from **any** kind of exception'.
+	^ (self session interruptedContext temporaryVariableNamed: #exception)
+		  notNil
 ]
 
 { #category : #'debug - predicates' }

src/NewTools-Debugger/StDebuggerContext.class.st

@@ -27,6 +27,7 @@ StDebuggerContext class >> context: aContext session: aDebugSession debugger: so
 { #category : #accessing }
 StDebuggerContext >> allInspectorNodes [
 	self flag: 'Removing the context from the inspected variables in the debugger. Should be added back as a debugger extension.'.
+
 	^ (self argumentsNodes)  addAll: ({	
 	(StDebuggerContextInspectorReceiverNode hostObject: self).
 	(StDebuggerContextInspectorTempsNode hostObject: self).
@@ -37,11 +38,11 @@ StDebuggerContext >> allInspectorNodes [
 { #category : #accessing }
 StDebuggerContext >> argumentsNodes [
 	| argNames |
-	argNames := self context method argumentNames.
+	argNames := self context sourceNode arguments.
 	^ (argNames collect: [ :argName | 
-		   StDebuggerContextInspectorArgumentNode new
-			   hostObject: (self context tempNamed: argName);
-			   argumentName: argName ]) asOrderedCollection
+		   (StInspectorTempNode hostObject: self context) tempVariable:
+			   (self context temporaryVariableNamed: argName name) ])
+		  asOrderedCollection
 ]
 
 { #category : #accessing }

src/NewTools-Debugger/StDebuggerContextInspectorReceiverNode.class.st

@@ -10,8 +10,10 @@ Class {
 
 { #category : #accessing }
 StDebuggerContextInspectorReceiverNode >> computeChildrenFromSourceObject [
-	^ hostObject context home receiver allInspectorNodes
-		reject: [ :node | node key = 'self' ]
+	"Let's experiment without children: we use the miller list instead"
+	^#()
+	"^ hostObject context home receiver allInspectorNodes
+		reject: [ :node | node key = 'self' ]"
 ]
 
 { #category : #accessing }

src/NewTools-Debugger/StDebuggerContextInspectorTempsNode.class.st

@@ -20,7 +20,15 @@ StDebuggerContextInspectorTempsNode >> label [
 
 { #category : #accessing }
 StDebuggerContextInspectorTempsNode >> rawValue [
-	^ hostObject context temporaries
+	| context variables mapping |
+	context := self hostObject context.
+	variables := context temporaryVariables.
+	mapping := Dictionary new.
+	variables do: [ :tempVariable | 
+		mapping
+			at: tempVariable name
+			put: (tempVariable readInContext: context) ].
+	^ mapping
 ]
 
 { #category : #accessing }

src/NewTools-Debugger/StDebuggerInspector.class.st

@@ -213,17 +213,14 @@ StDebuggerInspector >> updateLayoutForContexts: aContext isAssertionFailure: isT
 { #category : #updating }
 StDebuggerInspector >> updateWith: inspectedObject [
 	| oldContext newContext |
-	oldContext := self model inspectedObject
-		ifNotNil: [ :dbgCtx | dbgCtx context ].
+	oldContext := self model inspectedObject ifNotNil: [ :dbgCtx | 
+		              dbgCtx context ].
 	newContext := inspectedObject ifNotNil: [ :dbgCtx | dbgCtx context ].
-
-	(oldContext notNil and: [ newContext notNil ])
-		ifTrue: [ (oldContext receiver == newContext receiver
-				and: [ oldContext selector == newContext selector ])
-				ifTrue: [ self step.
-					^ self ] ].
+	(oldContext notNil and: [ newContext notNil ]) ifTrue: [ 
+		(oldContext receiver == newContext receiver and: [ 
+			 oldContext selector == newContext selector ]) ifTrue: [ ^ self ] ].
 	self saveRawInspectionSelectionForContext: oldContext.
-	self model: (StDebuggerInspectorModel on: inspectedObject).			
+	self model: (StDebuggerInspectorModel on: inspectedObject).
 	self updateEvaluationPaneReceiver.
 	self restoreRawInspectionSelectionForContext: newContext
 ]

src/NewTools-Inspector/StInspectorContextNamedTempNode.class.st

@@ -41,8 +41,9 @@ StInspectorContextNamedTempNode >> label [
 
 { #category : #accessing }
 StInspectorContextNamedTempNode >> rawValue [
-
-	^ self hostObject tempNamed: tempName
+	^ [ self hostObject tempNamed: tempName ]
+		  on: SubscriptOutOfBounds
+		  do: [ :err | 'cannot read ' , tempName ]
 ]
 
 { #category : #accessing }

src/NewTools-Inspector/StInspectorTempNode.class.st

@@ -0,0 +1,31 @@
+"
+I am a variable node for representing a temporary variable stored in a Context object that has a name attached. 
+This includes  local variables and method parameters.
+"
+Class {
+	#name : #StInspectorTempNode,
+	#superclass : #StInspectorNode,
+	#instVars : [
+		'tempVariable'
+	],
+	#category : #'NewTools-Inspector-Model'
+}
+
+{ #category : #accessing }
+StInspectorTempNode >> key [
+	^ tempVariable name
+]
+
+{ #category : #accessing }
+StInspectorTempNode >> rawValue [
+	"Answer the object value of this object variable (slot, indexed attribute, computed value)."
+
+	^ [ tempVariable readInContext: self hostObject ]
+		  on: SubscriptOutOfBounds
+		  do: [ :err | 'cannot read ' , tempVariable name ]
+]
+
+{ #category : #accessing }
+StInspectorTempNode >> tempVariable: anObject [
+	tempVariable := anObject
+]

src/NewTools-Inspector/StNodeCollector.class.st

@@ -91,15 +91,7 @@ StNodeCollector >> slotNodes [
 
 { #category : #building }
 StNodeCollector >> tempNodesForContext: aContext [
-	| nodes |
-	nodes := OrderedCollection new.
-	aContext tempNames
-		withIndexDo: [ :name :index | 
-			nodes
-				add:
-					(StInspectorContextNamedTempNode
-						hostObject: aContext
-						tempName: name
-						tempIndex: index) ].
-	^ nodes
+	^ aContext tempNames collect: [ :name | 
+		  (StInspectorTempNode hostObject: aContext) tempVariable:
+			  (aContext temporaryVariableNamed: name) ]
 ]

src/NewTools-Sindarin-Tools/StSindarinBytecodeContextInspectorModel.class.st

@@ -28,12 +28,7 @@ StSindarinBytecodeContextInspectorModel >> contextReceiverSlotNodes [
 
 { #category : #'*NewTools-Sindarin-Tools' }
 StSindarinBytecodeContextInspectorModel >> contextTempNodes [
-	| tempNodes |
-	tempNodes := StNodeCollector new tempNodesForContext: self inspectedObject.
-	tempNodes
-		do:
-			[ :node | node tempName: (node tempIndex - 1) asString , ' [' , node tempName , ']' ].
-	^ tempNodes
+	^ StNodeCollector new tempNodesForContext: self inspectedObject
 ]
 
 { #category : #accessing }

src/NewTools-Sindarin-Tools/StSindarinBytecodeContextInspectorModel.extension.st

@@ -11,10 +11,5 @@ StSindarinBytecodeContextInspectorModel >> contextReceiverSlotNodes [
 
 { #category : #'*NewTools-Sindarin-Tools' }
 StSindarinBytecodeContextInspectorModel >> contextTempNodes [
-	| tempNodes |
-	tempNodes := StNodeCollector new tempNodesForContext: self inspectedObject.
-	tempNodes
-		do:
-			[ :node | node tempName: (node tempIndex - 1) asString , ' [' , node tempName , ']' ].
-	^ tempNodes
+	^ StNodeCollector new tempNodesForContext: self inspectedObject
 ]

src/NewTools-Sindarin-Tools/StSindarinContextInteractionModel.class.st

@@ -1,10 +1,34 @@
 Class {
 	#name : #StSindarinContextInteractionModel,
-	#superclass : #StDebuggerContextInteractionModel,
+	#superclass : #SpCodeScriptingInteractionModel,
+	#instVars : [
+		'context'
+	],
 	#category : #'NewTools-Sindarin-Tools'
 }
 
 { #category : #binding }
 StSindarinContextInteractionModel >> bindingOf: aString [
-	^ self bindings at: aString ifAbsent: [ super bindingOf: aString ]
+	^ self bindings at: aString ifAbsent: [ 
+		  (context receiver class hasSlotNamed: aString)
+			  ifTrue: [ context receiver class slotNamed: aString ]
+			  ifFalse: [ context temporaryVariableNamed: aString ] ]
+]
+
+{ #category : #accessing }
+StSindarinContextInteractionModel >> context [
+	^ context
+]
+
+{ #category : #accessing }
+StSindarinContextInteractionModel >> context: anObject [
+	context := anObject
+]
+
+{ #category : #binding }
+StSindarinContextInteractionModel >> hasBindingOf: aString [
+	self bindings at: aString ifAbsent: [ 
+		^ (context receiver class hasSlotNamed: aString) or: [ 
+			  (context temporaryVariableNamed: aString) notNil ] ].
+	^ true
 ]

src/NewTools-Sindarin-Tools/StSindarinDebuggerScriptingPresenter.class.st

@@ -50,31 +50,27 @@ StSindarinDebuggerScriptingPresenter >> debugger [
 StSindarinDebuggerScriptingPresenter >> executeScript [
 	| stream result model receiver evaluationContext |
 	self debugger removeSessionHolderSubscriptions.
-	self flag: #SINDARIN.
-	"duplicated and adapted code from SpCodeDoItCommand but it could be refactored and mutualized"
-	stream := code text readStream.	
+	stream := code text readStream.
 	model := code interactionModel.
-	receiver := model doItReceiver.
-	evaluationContext := model doItContext.
+	receiver := model context receiver.
+	evaluationContext := model context.
 	result := receiver class compiler
-		source: stream;
-		context: evaluationContext;
-		receiver: receiver;
-		requestor: model;
-		failBlock:  [ nil ];
-		evaluate.		
+		          source: stream;
+		          context: evaluationContext;
+		          receiver: receiver;
+		          requestor: model;
+		          failBlock: [ nil ];
+		          evaluate.
 	resultInspection model: result.
 	resultInspection update.
-
-	self debugger setSessionHolderSubscriptions. 
-	self debugger forceSessionUpdate.
-
-
+	self debugger setSessionHolderSubscriptions.
+	self debugger forceSessionUpdate
 ]
 
 { #category : #initialization }
 StSindarinDebuggerScriptingPresenter >> initializePresenters [
 	code := self newCode.
+	code interactionModel: StSindarinContextInteractionModel new.
 	code syntaxHighlight: true.
 	"code contextMenu: [  ]."
 	code text: 'sindarin stepOver'.
@@ -140,8 +136,7 @@ StSindarinDebuggerScriptingPresenter >> toolbarActions [
 
 { #category : #initialization }
 StSindarinDebuggerScriptingPresenter >> updateCode [
-	code interactionModel:
-		(StSindarinContextInteractionModel on: self debugger currentContext).
+	code interactionModel context: self debugger currentContext.
 	code interactionModel bindings
 		at: #sindarin
 		put: (WorkspaceVariable key: #sindarin value: self sindarin)