merge newtools 0.5.3

src/NewTools-Core/StPharoApplication.class.st

@@ -91,6 +91,14 @@ StPharoApplication >> start [
 StPharoApplication >> startUp: resuming [
 ]
 
+{ #category : #'accessing resources' }
+StPharoApplication >> styleSheet [
+
+	^ StPharoStyleContributor allSubclasses 
+			inject: super styleSheet 
+			into: [ :accum :each | accum , (each new styleSheetContribution) ]
+]
+
 { #category : #settings }
 StPharoApplication >> toolbarDisplayMode [
 

src/NewTools-Core/StPharoStyleContributor.class.st

@@ -0,0 +1,24 @@
+"
+This class presents an entry point to extend the stylesheet used by the Pharo application.
+Subclasses of it should implement #styleSheetContribution returning a StyleSheet that is composed with the default one. 
+
+Also subclasses are able to extend the #isApplicable method in the class side and decide to apply or not in different scenarios (e.g., different Operating Systems)
+"
+Class {
+	#name : #StPharoStyleContributor,
+	#superclass : #Object,
+	#category : #'NewTools-Core-Application'
+}
+
+{ #category : #testing }
+StPharoStyleContributor class >> isApplicable [ 
+
+	^ true
+]
+
+{ #category : #styles }
+StPharoStyleContributor >> styleSheetContribution [
+
+	^ self subclassResponsibility
+
+]

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

@@ -4,8 +4,5 @@ Simple announcement to signal any update in the halt cache
 Class {
 	#name : #StHaltCacheChanged,
 	#superclass : #Announcement,
-	#classVars : [
-		'DefaultCache'
-	],
 	#category : #'NewTools-Debugger-Breakpoints-Tools-Model'
 }

src/NewTools-Debugger-Commands/StDebuggerToggleFilterStackCommand.class.st

@@ -0,0 +1,24 @@
+"
+I toggle the stack filtering in the debugger on and off, and I trigger a debugger update.
+"
+Class {
+	#name : #StDebuggerToggleFilterStackCommand,
+	#superclass : #CmCommand,
+	#category : #'NewTools-Debugger-Commands'
+}
+
+{ #category : #default }
+StDebuggerToggleFilterStackCommand class >> defaultDescription [
+	^'Toggle stack filtering on and off'
+]
+
+{ #category : #default }
+StDebuggerToggleFilterStackCommand class >> defaultName [ 
+	^'Toggle stack filtering'
+]
+
+{ #category : #executing }
+StDebuggerToggleFilterStackCommand >> execute [
+	StDebuggerActionModel shouldFilterStack: StDebuggerActionModel shouldFilterStack not.
+	self context updateStep
+]

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

@@ -5,3 +5,9 @@ Exception >> signalContext [
 
 	^ signalContext
 ]
+
+{ #category : #'*NewTools-Debugger-Extensions' }
+Exception >> stDebuggerInspectorNodesFor: aStDebuggerContext [
+
+	^ aStDebuggerContext exceptionNodesFor: self
+]

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

@@ -0,0 +1,7 @@
+Extension { #name : #MessageNotUnderstood }
+
+{ #category : #'*NewTools-Debugger-Extensions' }
+MessageNotUnderstood >> stDebuggerInspectorNodesFor: aStDebuggerContext [
+
+	^ aStDebuggerContext doesNotUnderstandNodesFor: self
+]

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

@@ -0,0 +1,7 @@
+Extension { #name : #OupsNullException }
+
+{ #category : #'*NewTools-Debugger-Extensions' }
+OupsNullException >> stDebuggerInspectorNodesFor: aStDebuggerContext [
+
+	^ aStDebuggerContext nullExceptionNodesFor: self
+]

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

@@ -180,6 +180,67 @@ StDebuggerActionModelTest >> testCreateMissingMethod [
 StDebuggerActionModelTest >> testDefaultShouldFilterStack [
 
 	self assert: StDebuggerActionModel shouldFilterStack
+]
+
+{ #category : #'tests - stack filtering' }
+StDebuggerActionModelTest >> testDynamicShouldFilterStack [
+
+	|mockDebugActionModel|
+	mockDebugActionModel := StMockDebuggerActionModel new.
+
+	self assert: mockDebugActionModel filterStack.
+
+	StDebuggerActionModel shouldFilterStack: true.
+	self assert: mockDebugActionModel shouldFilterStack.
+
+	StDebuggerActionModel shouldFilterStack: false.
+	self deny: mockDebugActionModel shouldFilterStack 
+]
+
+{ #category : #'tests - stack filtering' }
+StDebuggerActionModelTest >> testDynamicShouldFilterStackUpdate [
+
+	|mockDebugActionModel context|
+	mockDebugActionModel := StMockDebuggerActionModel new.		
+	self assert: mockDebugActionModel filterStack.
+	self assert: mockDebugActionModel shouldFilterStack.
+
+	context := Context
+		sender: nil
+		receiver: nil
+		method: Object >> #doesNotUnderstand:
+		arguments: #(#message).
+	mockDebugActionModel interruptedContext: context.
+	mockDebugActionModel stepInto: nil.
+	self deny: mockDebugActionModel filterStack.
+	self deny: mockDebugActionModel shouldFilterStack.
+
+	mockDebugActionModel stepOver: nil.
+	self deny: mockDebugActionModel filterStack.
+	self deny: mockDebugActionModel shouldFilterStack.
+
+	mockDebugActionModel := StMockDebuggerActionModel new.		
+	self assert: mockDebugActionModel filterStack.
+	self assert: mockDebugActionModel shouldFilterStack.
+
+	context := Context
+		sender: nil
+		receiver: nil
+		method: Object >> #asString
+		arguments: #().
+	mockDebugActionModel interruptedContext: context.
+	mockDebugActionModel stepInto: nil.
+	self deny: mockDebugActionModel filterStack.
+	self deny: mockDebugActionModel shouldFilterStack.
+
+	mockDebugActionModel stepOver: nil.
+	self assert: mockDebugActionModel filterStack.
+	self assert: mockDebugActionModel shouldFilterStack.
+
+
+
+
+
 ]
 
 { #category : #'tests - actions' }
@@ -491,6 +552,19 @@ StDebuggerActionModelTest >> testStepThrough [
 		identicalTo: method ast statements second
 ]
 
+{ #category : #'tests - predicates' }
+StDebuggerActionModelTest >> testUpdateDebugSession [
+
+	| exception |
+	self changeSession:
+		StTestDebuggerProvider new debuggerWithErrorContext session.
+	exception := session exception.
+	session exception: nil.
+	debugActionModel updateDebugSession.
+	self assert: session exception notNil.
+	self assert: session exception identicalTo: exception
+]
+
 { #category : #'tests - contexts' }
 StDebuggerActionModelTest >> testUpdateTopContext [
 

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

@@ -119,6 +119,23 @@ StDebuggerContextTest >> testBuildInspectorNodes [
 	self assert: nodesNames size equals: 8
 ]
 
+{ #category : #tests }
+StDebuggerContextTest >> testBuildInspectorNodesForException [
+	| nodes object exception |
+	object := Object new.
+	[ object toto ]
+		on: Error
+		do: [ :e | 
+			exception := e freeze.
+			debuggerContext context: e signalerContext.
+			debuggerContext exception: e ].
+	nodes := debuggerContext buildInspectorNodes.
+	self assert: (nodes at: (nodes size - 1)) key equals: 'Exception'.
+	self assert: (nodes at: (nodes size - 1)) rawValue identicalTo: exception.
+	self assert: (nodes last) key equals: 'DNU receiver'. 
+	self assert: (nodes last) rawValue identicalTo: object
+]
+
 { #category : #tests }
 StDebuggerContextTest >> testContext [
 
@@ -133,6 +150,30 @@ StDebuggerContextTest >> testContext [
 	self assert: debuggerContext context identicalTo: ctx
 ]
 
+{ #category : #tests }
+StDebuggerContextTest >> testExceptionNodes [
+
+	| nodes object exception |
+	object := Object new.
+	[ object toto ]
+		on: Error
+		do: [ :e | 
+			exception := e freeze.
+			debuggerContext context: e signalerContext.
+			debuggerContext exception: e ].
+	nodes := debuggerContext exceptionNodes.
+	self assert: nodes size equals: 2.
+	self assert: nodes first key equals: 'Exception'.
+	self assert: nodes first rawValue equals: exception.
+	self assert: nodes first variableTag equals: 'implicit'.
+	self
+		assert: nodes first rawValue class
+		identicalTo: MessageNotUnderstood.
+	self assert: nodes second key equals: 'DNU receiver'.
+	self assert: nodes second rawValue identicalTo: object.
+	self assert: nodes first variableTag equals: 'implicit'.
+]
+
 { #category : #tests }
 StDebuggerContextTest >> testNoDuplicatesBetweenArgsAndTemps [
 	|nodes nodesNamesArray nodesNamesSet|
@@ -143,6 +184,12 @@ StDebuggerContextTest >> testNoDuplicatesBetweenArgsAndTemps [
 	self assertCollection: nodesNamesArray equals: nodesNamesSet
 ]
 
+{ #category : #tests }
+StDebuggerContextTest >> testNullExceptionNodes [
+
+	self assertEmpty: debuggerContext exceptionNodes
+]
+
 { #category : #tests }
 StDebuggerContextTest >> testReceiverNodes [
 

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

@@ -355,6 +355,26 @@ StDebuggerTest >> testInitialCodeSelectionAfterStepping [
 	"The pc range is highlighted with an additionnal index to encompass the full text of the node (why?)"
 ]
 
+{ #category : #'tests - context inspector' }
+StDebuggerTest >> testNewDebuggerContext [
+	|debuggerContext|
+	debugger := (self debuggerOn: session).
+	debuggerContext := debugger newDebuggerContext.
+	self assert: debuggerContext class identicalTo: debugger class debuggerContextClass.
+	self assert: debuggerContext exception equals: session exception
+]
+
+{ #category : #'tests - context inspector' }
+StDebuggerTest >> testNewDebuggerContextFor [
+	|debuggerContext ctx|
+	debugger := (self debuggerOn: session).
+	ctx := [  ] asContext.
+	debuggerContext := debugger newDebuggerContextFor: ctx.
+	self assert: debuggerContext class identicalTo: debugger class debuggerContextClass.
+	self assert: debuggerContext exception equals: session exception.
+	self assert: debuggerContext context identicalTo: ctx
+]
+
 { #category : #'tests - stack table' }
 StDebuggerTest >> testPrintReceiverClassInContext [
 	|ctx result|

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

@@ -5,7 +5,8 @@ Class {
 	#name : #StMockDebuggerActionModel,
 	#superclass : #StDebuggerActionModel,
 	#instVars : [
-		'tag'
+		'tag',
+		'interruptedContext'
 	],
 	#category : #'NewTools-Debugger-Tests-Utils'
 }
@@ -18,6 +19,23 @@ StMockDebuggerActionModel >> autoClassifyMessage: aMessage inClass: aClass [
 StMockDebuggerActionModel >> computeInitialTopContext [
 ]
 
+{ #category : #initialize }
+StMockDebuggerActionModel >> initialize [
+	super initialize.
+	self interruptedContext: (Context
+			 sender: nil
+			 receiver: nil
+			 method: Object >> #doesNotUnderstand:
+			 arguments: #( #message ))
+]
+
+{ #category : #accessing }
+StMockDebuggerActionModel >> interruptedContext: anObject [
+
+	interruptedContext := anObject.
+	topContext := anObject
+]
+
 { #category : #accessing }
 StMockDebuggerActionModel >> session [
 	^StMockSession new