Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Added a fastTDD mode, disabled by default.
When disabled, asks the user in which class and in which protocol to create methods in the debugger.
  • Loading branch information
StevenCostiou committed Aug 12, 2020
1 parent 721b5fe commit b95b2d8
Show file tree
Hide file tree
Showing 2 changed files with 101 additions and 28 deletions.
30 changes: 28 additions & 2 deletions src/NewTools-Debugger-Tests/StDebuggerTest.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,8 @@ Class {
#superclass : #TestCase,
#instVars : [
'session',
'debugger'
'debugger',
'oldFastTDD'
],
#category : #'NewTools-Debugger-Tests-Presenters'
}
Expand Down Expand Up @@ -82,13 +83,16 @@ StDebuggerTest >> setUp [
session := DebugSession
named: 'test session'
on: process
startedAt: context
startedAt: context.
oldFastTDD := self debuggerClass fastTDD.
self debuggerClass fastTDD: true
]

{ #category : #running }
StDebuggerTest >> tearDown [

session clear.
self debuggerClass fastTDD: oldFastTDD.
super tearDown
]

Expand Down Expand Up @@ -200,6 +204,12 @@ StDebuggerTest >> testExtendedToolsPragma [
self assert: StDebugger extendedToolsPragma equals: #debuggerExtensionOrder:showByDefault:
]

{ #category : #'tests - initialization' }
StDebuggerTest >> testFastTDD [
self debuggerClass fastTDD: nil.
self deny: self debuggerClass fastTDD
]

{ #category : #'tests - receiver inspector' }
StDebuggerTest >> testInspectorHeaderLabel [
| dbg displayedLabel |
Expand Down Expand Up @@ -306,6 +316,22 @@ StDebuggerTest >> testRegisterExtensionTool [
self assertCollection: dbg extensionTools includesAll: { object }
]

{ #category : #'tests - actions' }
StDebuggerTest >> testRequestClassFrom [

self
assert: (self debugger requestClassFrom: self class)
identicalTo: self class
]

{ #category : #'tests - actions' }
StDebuggerTest >> testRequestProtocolIn [

self
assert: (self debugger requestProtocolIn: self class)
equals: Protocol unclassified
]

{ #category : #'tests - raw inspection' }
StDebuggerTest >> testRestoreReceiverRawInspectionSelection [
]
Expand Down
99 changes: 73 additions & 26 deletions src/NewTools-Debugger/StDebugger.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,7 @@ Class {
'DefaultDebugger',
'ErrorRecursion',
'ExtensionToolsSettings',
'FastTDD',
'UsingSpecSelector'
],
#category : #'NewTools-Debugger-View'
Expand Down Expand Up @@ -315,6 +316,29 @@ StDebugger class >> extensionToolsSettings [
ifNil: [ ExtensionToolsSettings := Dictionary new ]
]

{ #category : #settings }
StDebugger class >> fastTDD [
^FastTDD ifNil:[FastTDD := false]
]

{ #category : #settings }
StDebugger class >> fastTDD: aBoolean [

FastTDD := aBoolean
]

{ #category : #settings }
StDebugger class >> fastTDDSettingsOn: aBuilder [
<systemsettings>
(aBuilder setting: #fastTDD)
label: 'Fast TDD';
target: self;
default: false;
parent: #debugging;
description: 'Create classes and methods directly in the receiver''s class
without requesting information from the user'
]

{ #category : #opening }
StDebugger class >> handlesContext: aContext [
^self availableAutomatically
Expand Down Expand Up @@ -551,15 +575,14 @@ StDebugger >> createMissingClass [

{ #category : #actions }
StDebugger >> createMissingMethod [

| msg chosenClass |
self flag: #DBG_MISSINGTEST.
msg := self interruptedContext tempAt: 1.
"chosenClass := (self
requestSuperclassOf: self interruptedContext receiver class
to: ProtoObject
toImplement: msg selector
ifCancel: [ ^ self ]) value."
chosenClass := self interruptedContext receiver class.
chosenClass := self requestClassFrom:
self interruptedContext receiver class.
chosenClass ifNil: [ ^ self ].

self createMissingMethodFor: msg in: chosenClass
]

Expand All @@ -568,26 +591,24 @@ StDebugger >> createMissingMethodFor: aMessage in: aClass [
self flag: #DBG_MISSINGTEST.
self debuggerActionModel
implement: aMessage
classified: Protocol unclassified
classified: (self requestProtocolIn: aClass)
inClass: aClass
forContext: self interruptedContext.
self selectTopContext
]

{ #category : #actions }
StDebugger >> createSubclassResponsibility [

| senderContext msg msgCategory chosenClass |
senderContext := self interruptedContext sender.
msg := Message
selector: senderContext selector
arguments: senderContext arguments.
msgCategory := senderContext methodClass organization
categoryOfElement: msg selector.
chosenClass := (self
requestSuperclassOf: senderContext receiver class
to: senderContext methodClass
toImplement: senderContext selector
ifCancel: [ ^ self ]) value.
selector: senderContext selector
arguments: senderContext arguments.
msgCategory := senderContext methodClass organization
categoryOfElement: msg selector.
chosenClass := self requestClassFrom: senderContext receiver class.
chosenClass ifNil: [ ^ self ].
self debuggerActionModel
implement: msg
classified: msgCategory
Expand Down Expand Up @@ -909,19 +930,45 @@ StDebugger >> removeSessionHolderSubscriptions [
]

{ #category : #'ui requests' }
StDebugger >> requestSuperclassOf: aClass to: aSuperclass toImplement: aSelector ifCancel: cancelBlock [
StDebugger >> requestClassFrom: aClass [

self class fastTDD ifTrue: [ ^ aClass ].
^ self requestSuperclassOf: aClass to: ProtoObject
]

{ #category : #'ui requests' }
StDebugger >> requestProtocolIn: aClass [

| entryCompletion applicants |
self class fastTDD ifTrue: [ ^ Protocol unclassified ].
applicants := AbstractTool protocolSuggestionsFor: aClass.
entryCompletion := EntryCompletion new
dataSourceBlock: [ :currText | applicants ];
filterBlock: [ :currApplicant :currText |
currText size > 3 and: [
currApplicant asLowercase includesSubstring:
currText asString asLowercase ] ].
^ (UIManager default
request: 'Start typing for suggestions (3 characters minimum)'
initialAnswer: Protocol unclassified
title: 'Choose a protocol'
entryCompletion: entryCompletion) ifEmpty: [
Protocol unclassified ]
]

{ #category : #'ui requests' }
StDebugger >> requestSuperclassOf: aClass to: aSuperclass [

| classes |
classes := OrderedCollection with: aClass.
classes addAll: (aClass allSuperclassesIncluding: aSuperclass).
classes
addAll: (aClass traits sort: [ :t1 :t2 | t1 asString < t2 asString ]).
classes size = 1
ifTrue: [ ^ classes first ].
^ (UIManager default
chooseFrom: (classes collect: [ :c | c name ])
values: classes
title: 'Define #' , aSelector , ' in which class?')
ifNil: [ cancelBlock ]
classes addAll:
(aClass traits sort: [ :t1 :t2 | t1 asString < t2 asString ]).
classes size = 1 ifTrue: [ ^ classes first ].
^ UIManager default
chooseFrom: (classes collect: [ :c | c name ])
values: classes
title: 'Define selector in:'
]

{ #category : #actions }
Expand Down

0 comments on commit b95b2d8

Please sign in to comment.