diff --git a/DebuggingSpy-Tests/DSSpyInstrumenterTest.class.st b/DebuggingSpy-Tests/DSSpyInstrumenterTest.class.st index ca8ab17..c6dc679 100644 --- a/DebuggingSpy-Tests/DSSpyInstrumenterTest.class.st +++ b/DebuggingSpy-Tests/DSSpyInstrumenterTest.class.st @@ -189,6 +189,11 @@ DSSpyInstrumenterTest >> debuggerWithRunnableContext [ initialize ] +{ #category : 'helpers' } +DSSpyInstrumenterTest >> execute1Halt [ + 1 halt +] + { #category : 'helpers' } DSSpyInstrumenterTest >> executeHalt [ @@ -227,6 +232,18 @@ DSSpyInstrumenterTest >> metaPaneClassesItems: listName FromInspector: aMetaPane ^ (aMetaPane class slotNamed: listName) read: aMetaPane ] +{ #category : 'helpers' } +DSSpyInstrumenterTest >> methodWithDNU [ + + self unknownMessage +] + +{ #category : 'helpers' } +DSSpyInstrumenterTest >> methodWithException [ + + Exception new signal +] + { #category : 'helpers' } DSSpyInstrumenterTest >> newInspectorOn: anObject [ @@ -653,6 +670,14 @@ DSSpyInstrumenterTest >> testInstrumentHaltHits [ record := self registry fourth. self assert: record selector equals: #now:. self assertHaltHitRecordingMethod: (self class >> #executeHaltWithMessage) conditional: false once: false. + + [ self execute1Halt ] + on: Halt + do: [ ]. + self assert: self registry size equals: 5. + record := self registry fifth. + self assert: record selector equals: #halt. + self assertHaltHitRecordingMethod: (self class >> #execute1Halt) conditional: false once: false. ] { #category : 'tests - halts' } @@ -1316,3 +1341,42 @@ DSSpyInstrumenterTest >> testLoggingInteractionsWithNoSourceCode [ assert: record selectedString equals: DSSpy recordSourceCodeDisabledErrorMessage ] ] + +{ #category : #'tests - exceptions' } +DSSpyInstrumenterTest >> testRecordDNU [ + |capturedDNU| + + modifiedClass := Exception. + modifiedMethodSource := (Exception >> #raiseUnhandledError) sourceCode. + instrumenter instrumentExceptionSignalling. + + [self methodWithDNU] on: MessageNotUnderstood do:[:dnu| capturedDNU := dnu. [dnu raiseUnhandledError] on: UnhandledError do:[] ]. + + record := self registry first. + self assert: record class equals: DSUnhandledExceptionRecord. + self assert: record exceptionClass equals: MessageNotUnderstood name. + self assert: record errorString equals: capturedDNU description. + self assert: record receiver equals: self class name. + self assert: record node equals: (self class>>#methodWithDNU) ast children first sourceCode. + self assert: record method equals: (self class>>#methodWithDNU) selector +] + +{ #category : #'tests - exceptions' } +DSSpyInstrumenterTest >> testRecordException [ + |capturedException| + + modifiedClass := Exception. + modifiedMethodSource := (Exception >> #raiseUnhandledError) sourceCode. + instrumenter instrumentExceptionSignalling. + + [self methodWithException] on: Exception do:[:e| capturedException := e copy. [e raiseUnhandledError] on: UnhandledError do:[] ]. + + self assert: self registry size equals: 1. + record := self registry first. + self assert: record class equals: DSUnhandledExceptionRecord. + self assert: record exceptionClass equals: Exception name. + self assert: record errorString equals: capturedException description. + self assert: record receiver equals: self class name. + self assert: record node equals: (self class>>#methodWithException) ast children first sourceCode. + self assert: record method equals: (self class>>#methodWithException) selector +] diff --git a/DebuggingSpy-Tests/DSSpyTest.class.st b/DebuggingSpy-Tests/DSSpyTest.class.st index e632e07..f2ff53e 100644 --- a/DebuggingSpy-Tests/DSSpyTest.class.st +++ b/DebuggingSpy-Tests/DSSpyTest.class.st @@ -10,7 +10,8 @@ Class { 'breakpoint', 'task', 'survey', - 'recordSourceCode' + 'recordSourceCode', + 'breakpointHash' ], #category : 'DebuggingSpy-Tests', #package : 'DebuggingSpy-Tests' @@ -26,7 +27,8 @@ DSSpyTest >> assertBreakpointRecordedAs: aDSRecordClass forBreakpointEvent: aBre ifNotNil: [self assert: record objectCentric]. self deny: record once. self assert: record method equals: self breakpointedMethod name. - self assert: record node equals: self breakpointedMethod ast printString + self assert: record node equals: self breakpointedMethod ast printString. + self assert: record breakpointHash equals: breakpointHash ] { #category : 'assertions' } @@ -68,7 +70,8 @@ DSSpyTest >> assertVariableBreakpointRecordedAs: aDSRecordClass forBreakpointEve self deny: record once. self assert: record targetClassOrMethod equals: self breakpointedMethod name. self assert: record targetVariables first equals: #value. - self assert: record accessStrategy equals: #all + self assert: record accessStrategy equals: #all. + self assert: record breakpointHash equals: breakpointHash ] { #category : 'assertions' } @@ -114,7 +117,8 @@ DSSpyTest >> compileTestMethod [ DSSpyTest >> installBreakpoint [ breakpoint := Breakpoint new node: self breakpointedMethod ast. - breakpoint install + breakpoint install. + breakpointHash := breakpoint hash ] { #category : 'helpers' } @@ -122,7 +126,8 @@ DSSpyTest >> installVariableBreakpoint [ breakpoint := VariableBreakpoint watchVariable: #value - inClass: self breakpointedMethod + inClass: self breakpointedMethod. + breakpointHash := breakpoint hash ] { #category : 'helpers' } @@ -531,6 +536,7 @@ DSSpyTest >> testObjectCentricBreakpointRecord [ instrumenter listenToBreakpointChanges. breakpoint := target haltOnCallTo: #breakpointMethod. + breakpointHash := breakpoint hash. self assert: self registry size equals: 1. record := self registry first. self @@ -566,6 +572,7 @@ DSSpyTest >> testObjectCentricVariableBreakpointRecord [ breakpoint := (self breakpointedMethod newBreakpointForVariable: #value) scopeTo: target; install. + breakpointHash := breakpoint hash. self assert: self registry size equals: 1. record := self registry first. diff --git a/DebuggingSpy/DSAbstractBreakpointEventRecord.class.st b/DebuggingSpy/DSAbstractBreakpointEventRecord.class.st index a78d41c..f6a240a 100644 --- a/DebuggingSpy/DSAbstractBreakpointEventRecord.class.st +++ b/DebuggingSpy/DSAbstractBreakpointEventRecord.class.st @@ -9,18 +9,46 @@ Class { 'target', 'objectCentric', 'eventName', - 'once' + 'once', + 'breakpointHash' ], #category : 'DebuggingSpy-Records', #package : 'DebuggingSpy', #tag : 'Records' } + + +{ #category : 'converting' } +DSAbstractBreakpointEventRecord >> asBreakpointRecord [ + + ^ self modelClass + perform: eventName asLowercase asSymbol asMutator + with: self +] + +{ #category : 'accessing' } +DSAbstractBreakpointEventRecord >> breakpointHash [ + ^breakpointHash +] + +{ #category : 'testing' } +DSAbstractBreakpointEventRecord >> canOpenDebuggers [ + ^eventName = 'BreakpointHit' +] + { #category : 'accessing' } DSAbstractBreakpointEventRecord >> eventName [ ^eventName ] + +{ #category : 'converting' } +DSAbstractBreakpointEventRecord >> modelClass [ + + ^ self subclassResponsibility +] + { #category : 'accessing' } DSAbstractBreakpointEventRecord >> objectCentric [ @@ -55,7 +83,8 @@ DSAbstractBreakpointEventRecord >> record: aBreakpointEvent [ self printTargetInstance: aBreakpointEvent breakpoint targetInstance ] ifFalse: [ nil ]. - once := aBreakpointEvent breakpoint once + once := aBreakpointEvent breakpoint once. + breakpointHash := aBreakpointEvent breakpoint hash ] { #category : 'accessing' } diff --git a/DebuggingSpy/DSAbstractEventRecord.class.st b/DebuggingSpy/DSAbstractEventRecord.class.st index 7f56cdc..b7721c9 100644 --- a/DebuggingSpy/DSAbstractEventRecord.class.st +++ b/DebuggingSpy/DSAbstractEventRecord.class.st @@ -55,6 +55,13 @@ DSAbstractEventRecord >> >= aDSAbstractRecord [ ^self dateTime >= aDSAbstractRecord dateTime ] + +{ #category : 'testing' } +DSAbstractEventRecord >> canOpenDebuggers [ + + ^ true +] + { #category : 'accessing' } DSAbstractEventRecord >> dateTime [ @@ -83,6 +90,11 @@ DSAbstractEventRecord >> printOn: aStream [ aStream << self eventName ] +{ #category : 'accessing' } +DSAbstractEventRecord >> realRecord [ + ^self +] + { #category : 'actions api' } DSAbstractEventRecord >> record: aWindow [ windowId := aWindow identityHash @@ -110,3 +122,8 @@ DSAbstractEventRecord >> windowId: anObject [ windowId := anObject ] + +{ #category : #accessing } +DSAbstractEventRecord >> windowType [ + ^'Unknown Window' +] diff --git a/DebuggingSpy/DSAbstractExtendedRecord.class.st b/DebuggingSpy/DSAbstractExtendedRecord.class.st new file mode 100644 index 0000000..c16b0e5 --- /dev/null +++ b/DebuggingSpy/DSAbstractExtendedRecord.class.st @@ -0,0 +1,39 @@ +Class { + #name : #DSAbstractExtendedRecord, + #superclass : #DSAbstractEventRecord, + #instVars : [ + 'sourceRecord' + ], + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'instance creation' } +DSAbstractExtendedRecord class >> for: anObject [ + + ^ self new + record: anObject; + yourself +] + +{ #category : #'actions api' } +DSAbstractExtendedRecord >> dateTime [ + + ^ sourceRecord dateTime +] + +{ #category : #accessing } +DSAbstractExtendedRecord >> realRecord [ + + ^ sourceRecord +] + +{ #category : #'actions api' } +DSAbstractExtendedRecord >> record: aSourceRecord [ + sourceRecord := aSourceRecord +] + +{ #category : #'actions api' } +DSAbstractExtendedRecord >> windowId [ + + ^ sourceRecord windowId +] diff --git a/DebuggingSpy/DSBreakpointAdd.class.st b/DebuggingSpy/DSBreakpointAdd.class.st new file mode 100644 index 0000000..648ee71 --- /dev/null +++ b/DebuggingSpy/DSBreakpointAdd.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSBreakpointAdd, + #superclass : #DSMethodBreakpointRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSBreakpointAdd >> eventSymbol [ + ^'+b' +] diff --git a/DebuggingSpy/DSBreakpointEventRecord.class.st b/DebuggingSpy/DSBreakpointEventRecord.class.st index ec979ce..ea8481e 100644 --- a/DebuggingSpy/DSBreakpointEventRecord.class.st +++ b/DebuggingSpy/DSBreakpointEventRecord.class.st @@ -19,6 +19,12 @@ DSBreakpointEventRecord >> method [ ^ method ] +{ #category : 'converting' } +DSBreakpointEventRecord >> modelClass [ + + ^ DSMethodBreakpointRecord +] + { #category : 'accessing' } DSBreakpointEventRecord >> node [ diff --git a/DebuggingSpy/DSBreakpointHit.class.st b/DebuggingSpy/DSBreakpointHit.class.st new file mode 100644 index 0000000..ceda09f --- /dev/null +++ b/DebuggingSpy/DSBreakpointHit.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSBreakpointHit, + #superclass : #DSMethodBreakpointRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSBreakpointHit >> eventSymbol [ + ^'*b' +] diff --git a/DebuggingSpy/DSBreakpointRecord.class.st b/DebuggingSpy/DSBreakpointRecord.class.st new file mode 100644 index 0000000..83288ab --- /dev/null +++ b/DebuggingSpy/DSBreakpointRecord.class.st @@ -0,0 +1,75 @@ +Class { + #name : #DSBreakpointRecord, + #superclass : #DSAbstractExtendedRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #accessing } +DSBreakpointRecord >> breakpointHash [ + + ^ sourceRecord breakpointHash +] + +{ #category : #testing } +DSBreakpointRecord >> canOpenDebuggers [ + + ^ sourceRecord canOpenDebuggers +] + +{ #category : #accessing } +DSBreakpointRecord >> eventName [ + + ^ sourceRecord eventName +] + +{ #category : #'as yet unclassified' } +DSBreakpointRecord >> eventSymbol [ + ^self subclassResponsibility +] + +{ #category : #accessing } +DSBreakpointRecord >> objectCentric [ + + ^ sourceRecord objectCentric +] + +{ #category : #accessing } +DSBreakpointRecord >> once [ + + ^ sourceRecord once +] + +{ #category : #printing } +DSBreakpointRecord >> printContextAndNode [ + + ^ String streamContents: [ :s | + | nodeStream peek | + s << '['. + s << self eventName. + s << ']'. + s space. + s << self method] +] + +{ #category : #printing } +DSBreakpointRecord >> printTargetInstance: anObject [ + ^sourceRecord printTargetInstance: anObject +] + +{ #category : #accessing } +DSBreakpointRecord >> submethodTargets [ + + ^ self subclassResponsibility +] + +{ #category : #accessing } +DSBreakpointRecord >> target [ + + ^ sourceRecord target +] + +{ #category : #accessing } +DSBreakpointRecord >> targetClassOrMethod [ + + ^ self subclassResponsibility +] diff --git a/DebuggingSpy/DSBreakpointRemoved.class.st b/DebuggingSpy/DSBreakpointRemoved.class.st new file mode 100644 index 0000000..4a68e24 --- /dev/null +++ b/DebuggingSpy/DSBreakpointRemoved.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSBreakpointRemoved, + #superclass : #DSMethodBreakpointRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSBreakpointRemoved >> eventSymbol [ + ^'-b' +] diff --git a/DebuggingSpy/DSBreakpointReport.class.st b/DebuggingSpy/DSBreakpointReport.class.st new file mode 100644 index 0000000..51ed992 --- /dev/null +++ b/DebuggingSpy/DSBreakpointReport.class.st @@ -0,0 +1,41 @@ +Class { + #name : #DSBreakpointReport, + #superclass : #DSExceptionReport, + #instVars : [ + 'targets' + ], + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #adding } +DSBreakpointReport >> add: aBreakpointRecord [ + + super add: aBreakpointRecord. + aBreakpointRecord submethodTargets do: [ :target | + (self targets at: target ifAbsentPut: [ OrderedCollection new ]) add: + aBreakpointRecord ] +] + +{ #category : #printing } +DSBreakpointReport >> printOn: aStream [ + + super printOn: aStream. + aStream space. + aStream << 'breakpoints on'. + aStream space. + aStream << targets size asString. + aStream space. + aStream << 'submethod targets' +] + +{ #category : #accessing } +DSBreakpointReport >> targets [ + + ^ targets ifNil: [ targets := Dictionary new ] ifNotNil: [ targets ] +] + +{ #category : #accessing } +DSBreakpointReport >> targets: anObject [ + + targets := anObject +] diff --git a/DebuggingSpy/DSDebuggerOpeningRecord.class.st b/DebuggingSpy/DSDebuggerOpeningRecord.class.st index 4e0d29c..b743cef 100644 --- a/DebuggingSpy/DSDebuggerOpeningRecord.class.st +++ b/DebuggingSpy/DSDebuggerOpeningRecord.class.st @@ -29,8 +29,37 @@ DSDebuggerOpeningRecord >> eventName [ ^'Debugger open' ] +{ #category : 'as yet unclassified' } +DSDebuggerOpeningRecord >> primarySourcesOfWindowOpenings [ + + ^ ({ + DSBreakpointRecord. + DSAbstractBreakpointEventRecord. + DSHaltHitRecord } collect: [ :c | c withAllSubclasses ]) + flattened +] + { #category : 'actions api' } DSDebuggerOpeningRecord >> record: aDebugger [ debuggerId := aDebugger identityHash. super record: { aDebugger currentContext. aDebugger window window } ] + +{ #category : #'as yet unclassified' } +DSDebuggerOpeningRecord >> secondarySourcesOfWindowOpenings [ + + ^ ({ + DSCodeActionRecord. + DSStepActionRecord } collect: [ :c | c withAllSubclasses ]) + flattened +] + +{ #category : #accessing } +DSDebuggerOpeningRecord >> windowName [ + ^contextName +] + +{ #category : #'as yet unclassified' } +DSDebuggerOpeningRecord >> windowType [ + ^'Debugger' +] diff --git a/DebuggingSpy/DSExceptionReport.class.st b/DebuggingSpy/DSExceptionReport.class.st new file mode 100644 index 0000000..89bfb40 --- /dev/null +++ b/DebuggingSpy/DSExceptionReport.class.st @@ -0,0 +1,50 @@ +Class { + #name : #DSExceptionReport, + #superclass : #Object, + #instVars : [ + 'records', + 'method' + ], + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #adding } +DSExceptionReport >> add: aBreakpointRecord [ + + self records add: aBreakpointRecord +] + +{ #category : #accessing } +DSExceptionReport >> method [ + + ^ method +] + +{ #category : #accessing } +DSExceptionReport >> method: anObject [ + + method := anObject +] + +{ #category : #printing } +DSExceptionReport >> printOn: aStream [ + + aStream << method. + aStream << ':'. + aStream space. + aStream << records size asString +] + +{ #category : #accessing } +DSExceptionReport >> records [ + + ^ records + ifNil: [ records := OrderedCollection new ] + ifNotNil: [ records ] +] + +{ #category : #accessing } +DSExceptionReport >> records: anObject [ + + records := anObject +] diff --git a/DebuggingSpy/DSHaltChangeRecord.class.st b/DebuggingSpy/DSHaltChangeRecord.class.st index 3619b93..7bc785b 100644 --- a/DebuggingSpy/DSHaltChangeRecord.class.st +++ b/DebuggingSpy/DSHaltChangeRecord.class.st @@ -30,7 +30,7 @@ DSHaltChangeRecord class >> remove [ { #category : 'accessing' } DSHaltChangeRecord >> eventName [ - ^'Halt change' + ^haltChange, ' (', method, ')' ] { #category : 'accessing' } diff --git a/DebuggingSpy/DSHaltHitRecord.class.st b/DebuggingSpy/DSHaltHitRecord.class.st index 9abfcad..4e4fb71 100644 --- a/DebuggingSpy/DSHaltHitRecord.class.st +++ b/DebuggingSpy/DSHaltHitRecord.class.st @@ -22,7 +22,7 @@ DSHaltHitRecord >> conditional [ { #category : 'accessing' } DSHaltHitRecord >> eventName [ - ^'Halt hit' + ^'HALT_HIT (', method, ')' ] { #category : 'accessing' } diff --git a/DebuggingSpy/DSHaltReport.class.st b/DebuggingSpy/DSHaltReport.class.st new file mode 100644 index 0000000..d1d1a08 --- /dev/null +++ b/DebuggingSpy/DSHaltReport.class.st @@ -0,0 +1,13 @@ +Class { + #name : #DSHaltReport, + #superclass : #DSExceptionReport, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #printing } +DSHaltReport >> printOn: aStream [ + + super printOn: aStream. + aStream space. + aStream << 'halts' +] diff --git a/DebuggingSpy/DSInspectObjectRecord.class.st b/DebuggingSpy/DSInspectObjectRecord.class.st index b025b13..baadb2c 100644 --- a/DebuggingSpy/DSInspectObjectRecord.class.st +++ b/DebuggingSpy/DSInspectObjectRecord.class.st @@ -13,3 +13,14 @@ Class { DSInspectObjectRecord >> eventName [ ^'Inspect object' ] + +{ #category : #accessing } +DSInspectObjectRecord >> windowName [ + + ^ inspectedObject +] + +{ #category : #'as yet unclassified' } +DSInspectObjectRecord >> windowType [ + ^'Inspector' +] diff --git a/DebuggingSpy/DSIntoRecord.class.st b/DebuggingSpy/DSIntoRecord.class.st new file mode 100644 index 0000000..2a6133c --- /dev/null +++ b/DebuggingSpy/DSIntoRecord.class.st @@ -0,0 +1,5 @@ +Class { + #name : #DSIntoRecord, + #superclass : #DSStepRecord, + #category : #'DebuggingSpy-Records-Extensions' +} diff --git a/DebuggingSpy/DSMergedWindowActivityRecord.class.st b/DebuggingSpy/DSMergedWindowActivityRecord.class.st new file mode 100644 index 0000000..715042c --- /dev/null +++ b/DebuggingSpy/DSMergedWindowActivityRecord.class.st @@ -0,0 +1,62 @@ +Class { + #name : #DSMergedWindowActivityRecord, + #superclass : #DSWindowActivityRecord, + #instVars : [ + 'activities' + ], + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #accessing } +DSMergedWindowActivityRecord >> activities [ + + ^ activities + ifNil: [ activities := OrderedCollection new ] + ifNotNil: [ activities ] +] + +{ #category : #accessing } +DSMergedWindowActivityRecord >> activities: anObject [ + + activities := anObject +] + +{ #category : #accessing } +DSMergedWindowActivityRecord >> duration [ + + ^ (self activities + inject: 0 + into: [ :sum :n | sum + n duration asSeconds ]) asSeconds +] + +{ #category : #accessing } +DSMergedWindowActivityRecord >> eventName [ + + ^ String streamContents: [ :ws | + self window printTypeOn: ws. + ws << ':'. + ws space. + ws << self duration humanReadablePrintString ] +] + +{ #category : #accessing } +DSMergedWindowActivityRecord >> events [ + + ^ (self activities collect: #events) flattened +] + +{ #category : #merging } +DSMergedWindowActivityRecord >> merge: aDSWindowActivityRecord [ + + self mergeWith: aDSWindowActivityRecord +] + +{ #category : #merging } +DSMergedWindowActivityRecord >> mergeWith: anActivityRecord [ + self activities add: anActivityRecord. + windowId ifNil:[windowId := anActivityRecord windowId]. + start ifNil:[start := anActivityRecord start]. + window ifNil:[window := anActivityRecord window]. + next := anActivityRecord next. + stop := anActivityRecord stop. +] diff --git a/DebuggingSpy/DSMethodBreakpointRecord.class.st b/DebuggingSpy/DSMethodBreakpointRecord.class.st new file mode 100644 index 0000000..9fe1234 --- /dev/null +++ b/DebuggingSpy/DSMethodBreakpointRecord.class.st @@ -0,0 +1,66 @@ +Class { + #name : #DSMethodBreakpointRecord, + #superclass : #DSBreakpointRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSMethodBreakpointRecord class >> breakpointadded: event [ + + ^DSBreakpointAdd for: event + +] + +{ #category : #'as yet unclassified' } +DSMethodBreakpointRecord class >> breakpointhit: event [ + + ^DSBreakpointHit for: event + +] + +{ #category : #'as yet unclassified' } +DSMethodBreakpointRecord class >> breakpointremoved: event [ + + ^DSBreakpointRemoved for: event + +] + +{ #category : #'instance creation' } +DSMethodBreakpointRecord class >> for: anEvent [ + + | breakpoint | + breakpoint := self new. + breakpoint become: anEvent. + anEvent record: breakpoint. + ^ anEvent +] + +{ #category : #accessing } +DSMethodBreakpointRecord >> eventName [ + + ^ String streamContents: [ :s | + s << 'Method'. + s << super eventName ] +] + +{ #category : #accessing } +DSMethodBreakpointRecord >> method [ + ^sourceRecord method +] + +{ #category : #accessing } +DSMethodBreakpointRecord >> node [ + ^sourceRecord node +] + +{ #category : #accessing } +DSMethodBreakpointRecord >> submethodTargets [ + + ^ {self node} +] + +{ #category : #accessing } +DSMethodBreakpointRecord >> targetClassOrMethod [ + + ^ self method +] diff --git a/DebuggingSpy/DSMouseEnterTableItemRecord.class.st b/DebuggingSpy/DSMouseEnterTableItemRecord.class.st index fa49c1e..b0f9271 100644 --- a/DebuggingSpy/DSMouseEnterTableItemRecord.class.st +++ b/DebuggingSpy/DSMouseEnterTableItemRecord.class.st @@ -11,5 +11,22 @@ Class { { #category : 'accessing' } DSMouseEnterTableItemRecord >> eventName [ - ^'Mouse on table item' + + ^ String streamContents: [ :str | + str << 'Mouse on table item:'. + str space. + str << itemElement ] +] + +{ #category : #testing } +DSMouseEnterTableItemRecord >> isOverTestCase [ + + ^ itemElement isString and: [ + itemElement size > 4 and: [ + (itemElement copyFrom: 1 to: 4) = 'test' ] ] +] + +{ #category : #accessing } +DSMouseEnterTableItemRecord >> windowName [ + ^windowId ] diff --git a/DebuggingSpy/DSMouseEnterTextEditorRecord.class.st b/DebuggingSpy/DSMouseEnterTextEditorRecord.class.st index d1eac25..3cb50c1 100644 --- a/DebuggingSpy/DSMouseEnterTextEditorRecord.class.st +++ b/DebuggingSpy/DSMouseEnterTextEditorRecord.class.st @@ -1,6 +1,3 @@ -" -This record is generated when the mouse enters an item in a text editor. -" Class { #name : 'DSMouseEnterTextEditorRecord', #superclass : 'DSMouseEventRecord', @@ -13,3 +10,14 @@ Class { DSMouseEnterTextEditorRecord >> eventName [ ^'Mouse on text editor' ] + +{ #category : #accessing } +DSMouseEnterTextEditorRecord >> windowName [ + ^ windowId +] + +{ #category : #'as yet unclassified' } +DSMouseEnterTextEditorRecord >> windowType [ + + ^ 'External Window' +] diff --git a/DebuggingSpy/DSOverRecord.class.st b/DebuggingSpy/DSOverRecord.class.st new file mode 100644 index 0000000..06f53e4 --- /dev/null +++ b/DebuggingSpy/DSOverRecord.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSOverRecord, + #superclass : #DSStepRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSOverRecord >> eventSymbol [ + ^'>' +] diff --git a/DebuggingSpy/DSProceedRecord.class.st b/DebuggingSpy/DSProceedRecord.class.st new file mode 100644 index 0000000..d21b96f --- /dev/null +++ b/DebuggingSpy/DSProceedRecord.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSProceedRecord, + #superclass : #DSStepRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSProceedRecord >> eventSymbol [ + ^'P' +] diff --git a/DebuggingSpy/DSRecordHistory.class.st b/DebuggingSpy/DSRecordHistory.class.st index 7b09398..7b8ff86 100644 --- a/DebuggingSpy/DSRecordHistory.class.st +++ b/DebuggingSpy/DSRecordHistory.class.st @@ -1,6 +1,3 @@ -" -I represent a user experiment record and expose an API to extract data from this record. -" Class { #name : 'DSRecordHistory', #superclass : 'Object', @@ -10,7 +7,12 @@ Class { 'records', 'windowsHistory', 'tag', - 'windowNames' + 'windowNames', + 'windows', + 'windowJumps', + 'filteredWindowJumps', + 'filteredWindows', + 'mergedWindowJumps' ], #category : 'DebuggingSpy-Records', #package : 'DebuggingSpy', @@ -22,6 +24,25 @@ DSRecordHistory class >> on: anArray [ ^self new processRecords: anArray ] +{ #category : 'instance creation' } +DSRecordHistory class >> readTrace: aStringOrFilename [ + ^self on: (STON fromString: aStringOrFilename asFileReference contents) +] + +{ #category : 'as yet unclassified' } +DSRecordHistory class >> windowActivationEventTypes [ + + "Return a list of types that correspond to the user activating or entering a window." + ^{DSMouseEnterWindowRecord } +] + +{ #category : 'as yet unclassified' } +DSRecordHistory class >> windowLeaveEventTypes [ + + "Return a list of types that correspond to the user activating or entering a window." + ^{DSMouseLeaveWindowRecord. DSWindowClosedRecord } +] + { #category : 'API-history' } DSRecordHistory >> addWindowRecord: aDSRecord [ @@ -42,10 +63,25 @@ DSRecordHistory >> breakpointAdds [ ^ (self breakpointEvents: BreakpointAdded name) size ] +{ #category : 'API-history' } +DSRecordHistory >> breakpointAnalysisMap [ + + | report | + report := Dictionary new. + (self allRecordsOfKind: DSBreakpointRecord) do: [ :bp | + (report at: bp targetClassOrMethod ifAbsentPut: [ + DSBreakpointReport new + method: bp targetClassOrMethod; + yourself ]) add: bp ]. + ^ report +] + { #category : 'private - history' } DSRecordHistory >> breakpointEvents [ - ^ self records select: [ :r | r isKindOf: DSAbstractBreakpointEventRecord ] + ^ self records select: [ :r | + (r isKindOf: DSAbstractBreakpointEventRecord) or: [ + r isKindOf: DSBreakpointRecord ] ] ] { #category : 'private - history' } @@ -71,11 +107,60 @@ DSRecordHistory >> breakpointRemove [ DSRecordHistory >> buildWindowHistory [ self windowsHistory removeAll. - self fixMissingWindowIds. + self fixMissingWindowNames. self records do: [ :r | r recordWindowHistoryOn: self ]. self fixWindowRecordKeysNames ] +{ #category : 'private - history' } +DSRecordHistory >> buildWindowJumps [ + + | jumps previousWindowActivity nextWindowActivity | + windowJumps := OrderedCollection new. + jumps := self allRecordsOfKind: DSMouseEnterWindowRecord. + + jumps do: [ :jumpEvent | + (filteredWindows + detect: [ :w | w windowId = jumpEvent windowId ] + ifNone: [ nil ]) ifNotNil: [ :w | + (w activePeriods + detect: [ :period | period start == jumpEvent ] + ifNone: [ nil ]) ifNotNil: [ :period | windowJumps add: period ] ] ]. + + filteredWindowJumps := windowJumps "reject: [ :e | + e events size <= 3 or: [ + e stop dateTime - e start dateTime + < 500 milliSeconds" "or: [ ""self halt."" ""e type = 'Finish'"" true] "" ] ]". + + previousWindowActivity := nil. + filteredWindowJumps do: [ :period | + period previous: previousWindowActivity. + previousWindowActivity := period ]. + + nextWindowActivity := nil. + filteredWindowJumps reverseDo: [ :period | + period next: nextWindowActivity. + nextWindowActivity := period ]. + + self mergeFilteredWindowJumps + +] + +{ #category : 'private - history' } +DSRecordHistory >> buildWindows [ + + windows := OrderedCollection new. + windowsHistory valuesDo: [ :events | + windows add: (DSWindowRecord for: events) ]. + self reconstructSourcesOfDebuggerOpenings. + + filteredWindows := windows reject: [ :w | + (w totalTime < 0.5 seconds or: [ + (w respondsTo: #type) and: [ + #( 'Finish' 'Post-task' 'Survey' ) includes: + w type ] ]) or: [ w windowId = -1 ] ] +] + { #category : 'API-history' } DSRecordHistory >> callStackBrowing [ @@ -106,10 +191,9 @@ DSRecordHistory >> collectTimeDiscrepancies [ { #category : 'API-history' } DSRecordHistory >> countDebugActions [ - ^ self breakpointAdds + self breakpointHit + self breakpointRemove - + self executedCode + self methodsAdded + self methodsModified - + self methodsRemoved + self numberOfSteps + self openedDebuggers - + self callStackBrowing + ^ self breakpointAdds + self breakpointRemove + self executedCode + + self methodsAdded + self methodsModified + self methodsRemoved + + self numberOfSteps + self callStackBrowing ] { #category : 'private - history' } @@ -131,12 +215,54 @@ DSRecordHistory >> detectTimeDiscrepancies [ ] -{ #category : 'as yet unclassified' } + +{ #category : 'private - history' } +DSRecordHistory >> estimateSourceEventOf: aDSDebuggerOpeningRecord from: aRecordList [ + + | eventIndex previousRecord | + eventIndex := aRecordList indexOf: aDSDebuggerOpeningRecord. + + eventIndex = 1 ifTrue: [ ^ nil ]. + + + (self + findSourceEventLike: + aDSDebuggerOpeningRecord primarySourcesOfWindowOpenings + forRecord: aDSDebuggerOpeningRecord + in: aRecordList) ifNotNil: [ :sourceEvent | ^ sourceEvent ]. + + + previousRecord := aRecordList at: eventIndex - 1. + (previousRecord class == DSMouseEnterTableItemRecord and: [ + previousRecord isOverTestCase ]) ifTrue: [ + ^ DSRunTestRecord for: previousRecord ]. + + + (self + findSourceEventLike: + aDSDebuggerOpeningRecord secondarySourcesOfWindowOpenings + forRecord: aDSDebuggerOpeningRecord + in: aRecordList) ifNotNil: [ :sourceEvent | ^ sourceEvent ]. + + + aDSDebuggerOpeningRecord contextName = 'CompiledMethod>>#DoIt' + ifTrue: [ + ^DSDebugItRecord new + selectedString: aDSDebuggerOpeningRecord sourceNodeCode; + windowId: (aRecordList at: eventIndex - 1) windowId; + yourself ]. + + "self halt: 'If we get there we forgot a case...'." + ^ aRecordList at: eventIndex - 1 +] + +{ #category : 'API-history' } DSRecordHistory >> eventsAfter: aDateAndTime [ ^records select:[:e| e dateTime > aDateAndTime] ] -{ #category : 'as yet unclassified' } + +{ #category : 'API-history' } DSRecordHistory >> eventsBefore: aDateAndTime [ self shouldBeImplemented. ] @@ -147,6 +273,32 @@ DSRecordHistory >> executedCode [ ^ (self allRecordsOfKind: DSCodeActionRecord) size ] +{ #category : 'accessing' } +DSRecordHistory >> filteredWindowJumps [ + + ^ filteredWindowJumps +] + +{ #category : 'accessing' } +DSRecordHistory >> filteredWindows [ + + ^ filteredWindows +] + +{ #category : 'private - history' } +DSRecordHistory >> findSourceEventLike: possibleSourceEvents forRecord: aRecord in: aRecordList [ + + | eventIndex | + eventIndex := aRecordList indexOf: aRecord. + eventIndex - 1 to: 1 by: -1 do: [ :i | + | previousRecord | + previousRecord := aRecordList at: i. + previousRecord class = aRecord class ifTrue: [ ^ nil ]. + ((possibleSourceEvents includes: previousRecord class) and:[previousRecord canOpenDebuggers]) + ifTrue: [ ^ previousRecord ] ]. + ^ nil +] + { #category : 'private - history' } DSRecordHistory >> findWindowRecordKeyForID: id [ @@ -158,35 +310,50 @@ DSRecordHistory >> findWindowRecordKeyForID: id [ yourself ] ] + { #category : 'private - history' } DSRecordHistory >> fixMissingWindowIds [ - | openedWindowStack | - openedWindowStack := Stack new. - windowNames := Dictionary new. - records do: [ :r | - r windowId ifNotNil: [ - ({ - DSWindowClosedRecord. - DSMouseLeaveWindowRecord } includes: r class) ifTrue: [ - openedWindowStack removeAllSuchThat: [ :id | r windowId = id ] ]. - - ({ - DSWindowActivatedRecord. - DSMouseEnterWindowRecord. - DSWindowOpenedRecord } includes: r class) ifTrue: [ - openedWindowStack push: r windowId ]. - - ({ - DSWindowActivatedRecord. - DSWindowOpenedRecord } includes: r class) ifTrue: [ - (#( nil '' ) includes: r windowName) ifFalse: [ - windowNames at: r windowId put: r windowName ] ] ]. - r windowId ifNil: [ - openedWindowStack isEmpty - ifTrue: [ r windowId: -1 ] - ifFalse: [ r windowId: openedWindowStack top ] ] ] + windowNames := Dictionary new. + (records reject: [ :e | e windowId isNil ]) do: [ :r | + (r respondsTo: #windowName) ifTrue: [ + windowNames + at: (r windowId ifNil: [ self halt ]) + ifAbsentPut: [ r windowName ifNil: [ self halt ] ] ] ] +] + +{ #category : #'private - history' } +DSRecordHistory >> fixWindowIdsOf: aCollection [ + + | windowlessRecords validEvents enterAndLeaveSequences currentWindowId currentSequence | + + windowlessRecords := aCollection select: [ :e | e windowId isNil ]. + validEvents := aCollection select:[ :e | (#( nil 0 ) includes: e windowId) not ]. + + "First we sort all events in sequences happening in the same window" + enterAndLeaveSequences := OrderedCollection new. + currentWindowId := validEvents first windowId. + currentSequence := OrderedCollection new. + validEvents do: [:e | + + (e windowId ~= currentWindowId or: [(self class windowLeaveEventTypes includes: e class)]) + ifTrue: [ + (self class windowLeaveEventTypes includes: e class) ifTrue:[currentSequence add: e]. + enterAndLeaveSequences add: currentSequence. + currentSequence := OrderedCollection new. + currentSequence add: e. + currentWindowId := e windowId ] + ifFalse: [ currentSequence add: e ] ]. + + "Then for each sequence, we try to find events without window id happening between the start and the end of that sequence" + enterAndLeaveSequences do: [ :sequence | + | enter leave | + enter := sequence first. + leave := sequence last. + (windowlessRecords select: [ :e | + e dateTime > enter dateTime and: [ e dateTime < leave dateTime ] ]) + do: [ :e | e windowId: enter windowId ] ] ] { #category : 'private - history' } @@ -196,13 +363,56 @@ DSRecordHistory >> fixWindowRecordKeysNames [ (self findWindowRecordKeyForID: id) windowName: name ] ] + +{ #category : 'API-history' } +DSRecordHistory >> haltAnalysisMap [ + + | report | + report := Dictionary new. + (self allRecordsOfKind: DSAbstractHaltRecord) do: [ :bp | + (report at: bp method ifAbsentPut: [ + DSHaltReport new + method: bp method; + yourself ]) add: bp ]. + ^ report +] + { #category : 'initialization' } DSRecordHistory >> initialize [ super initialize. self flag: 'I am not tested! Please do it!' ] +{ #category : 'private - history' } +DSRecordHistory >> mergeFilteredWindowJumps [ + + | currentJump | + mergedWindowJumps := OrderedCollection new. + currentJump := filteredWindowJumps first. + + [ currentJump notNil ] whileTrue: [ + currentJump next ifNil: [ + mergedWindowJumps add: currentJump. + ^ self ]. + currentJump windowId = currentJump next windowId + ifTrue: [ currentJump merge: currentJump next ] + ifFalse: [ + mergedWindowJumps ifNotEmpty: [ + currentJump previous: mergedWindowJumps last ]. + mergedWindowJumps add: currentJump. + currentJump := currentJump next ] ]. + + self validateMergedJumps +] + +{ #category : 'accessing' } +DSRecordHistory >> mergedWindowJumps [ + + ^ mergedWindowJumps +] + { #category : 'API-history' } + DSRecordHistory >> methodsAdded [ ^ (self allRecordsOfKind: DSMethodAddedRecord) size @@ -232,7 +442,8 @@ DSRecordHistory >> name [ ^ self user, ': ', self taskName, '(', tag, ')' ] -{ #category : 'testing' } + +{ #category : 'API-history' } DSRecordHistory >> numberOfSeekerActions [ ^ (self records select: [ :r | @@ -254,9 +465,43 @@ DSRecordHistory >> openedDebuggers [ { #category : 'initialization' } DSRecordHistory >> processRecords: array [ - self records: array. - (self records first isKindOf: DSStartTaskRecord) ifTrue: [ - self taskName: self records first taskName ] + self fixWindowIdsOf: array. + "events with window id equals to 0 are automatic events triggered while opening a spec presenter while the window is not already open -> noise " + self records: + (array reject: [ :e | #( 0 ) includes: e windowId ]). + + "Transform raw events to model events" + (self allRecordsOfKind: DSStepActionRecord) do: #asStepRecord. + (self allRecordsOfKind: DSAbstractBreakpointEventRecord) do: #asBreakpointRecord. + + "Detect if we're in a specific task" + (self records first isKindOf: DSStartTaskRecord) ifTrue: [ + self taskName: self records first taskName ]. + + "Windows" + self buildWindowHistory. + self buildWindows. + self buildWindowJumps. + + "Check data consistency (raises a warning that can be proceeded)" + self validateWindows +] + +{ #category : #'private - history' } +DSRecordHistory >> reconstructSourcesOfDebuggerOpenings [ + + | sortedDebuggerWindows recordsCopy | + sortedDebuggerWindows := (windows select: [ :w | w isDebugger ]) + sort: [ :d1 :d2 | d1 events first dateTime < d2 events first dateTime ]. + + recordsCopy := records copy asOrderedCollection. + + sortedDebuggerWindows do: [ :w | + |sourceEvent| + sourceEvent := (self estimateSourceEventOf: w events first from: recordsCopy). + recordsCopy remove: w events first. + recordsCopy remove: sourceEvent realRecord ifAbsent:[]. + w sourceEvent: sourceEvent ] ] { #category : 'accessing' } @@ -271,6 +516,12 @@ DSRecordHistory >> records: anObject [ records := anObject ] + +{ #category : 'initialization' } +DSRecordHistory >> reprocessRecords [ + self processRecords: records asOrderedCollection +] + { #category : 'accessing' } DSRecordHistory >> tag [ @@ -318,9 +569,81 @@ DSRecordHistory >> user: anObject [ user := anObject ] + +{ #category : 'private - history' } +DSRecordHistory >> validateMergedJumps [ + + 1 to: mergedWindowJumps size do:[:i| + |current next| + current := mergedWindowJumps at: i. + current = mergedWindowJumps last ifFalse:[ + |w wId| + next := mergedWindowJumps at: i + 1. + self assert: next previous == current. + self assert: current next == next. + w := current window. + wId := current windowId. + + self assert: (current events allSatisfy: [:e| e windowId = w and:[e window == w]]). + self assert: (current events allSatisfy: [:e| e dateTime < next start dateTime]) + ] + ] +] + +{ #category : 'private - history' } +DSRecordHistory >> validateWindows [ + "Validates that each windows starts by a window entering or opening event, finishes by a window closing or leaving event, and that every event contained in the window happened between the opening event timestamp and the closing even timestamp" + + | erroneousWindows | + erroneousWindows := Dictionary new. + + windows do: [ :w | + | firstEvent lastEvent | + firstEvent := w events first. + lastEvent := w events last. + + ({ + DSWindowOpenedRecord. + DSWindowActivatedRecord. + DSMouseEnterWindowRecord. + DSDebuggerOpeningRecord. + DSBrowseContextRecord. + DSQueryBrowseRecord } includes: firstEvent class) ifFalse: [ + (erroneousWindows at: w ifAbsentPut: [ OrderedCollection new ]) + add: #opening -> firstEvent ]. + + ({ + DSWindowClosedRecord. + DSMouseLeaveWindowRecord } includes: lastEvent class) ifFalse: [ + (erroneousWindows at: w ifAbsentPut: [ OrderedCollection new ]) + add: #closing -> lastEvent ]. + + w events do: [ :e | + (e dateTime >= firstEvent dateTime and: [ + e dateTime <= lastEvent dateTime ]) ifFalse: [ + (erroneousWindows at: w ifAbsentPut: [ OrderedCollection new ]) + add: #timestamp -> e ] ] ]. + + "erroneousWindows ifNotEmpty: [ + Warning signal: (String streamContents: [ :str | + str << erroneousWindows size printString. + str space. + str + << + 'potential sequence problem found in windows. This is just an information, you can proceed.' ]) ]" +] + +{ #category : 'accessing' } +DSRecordHistory >> windows [ + ^ windows +] + { #category : 'accessing' } DSRecordHistory >> windowsHistory [ - ^windowsHistory ifNil:[windowsHistory := IdentityDictionary new] + + ^ windowsHistory + ifNil: [ windowsHistory := IdentityDictionary new ] + ifNotNil: [ windowsHistory ] ] { #category : 'accessing' } diff --git a/DebuggingSpy/DSRecordHistoryWindowKey.class.st b/DebuggingSpy/DSRecordHistoryWindowKey.class.st index 1abbc14..6571e19 100644 --- a/DebuggingSpy/DSRecordHistoryWindowKey.class.st +++ b/DebuggingSpy/DSRecordHistoryWindowKey.class.st @@ -8,7 +8,7 @@ Class { 'windowName', 'windowId' ], - #category : 'DebuggingSpy-Records', + #category : 'DebuggingSpy-Records-Extensions', #package : 'DebuggingSpy', #tag : 'Records' } diff --git a/DebuggingSpy/DSRecordRegistry.class.st b/DebuggingSpy/DSRecordRegistry.class.st index 0e33224..ca73d51 100644 --- a/DebuggingSpy/DSRecordRegistry.class.st +++ b/DebuggingSpy/DSRecordRegistry.class.st @@ -1,6 +1,3 @@ -" -For now I am a dumb registry to simply record all events in an ordered collection -" Class { #name : 'DSRecordRegistry', #superclass : 'Object', @@ -21,7 +18,9 @@ Class { { #category : 'accessing' } DSRecordRegistry class >> autoSerialize [ - ^ autoSerialize ifNil: [ autoSerialize := false ] + ^ autoSerialize + ifNil: [ autoSerialize := false ] + ifNotNil: [ autoSerialize ] ] { #category : 'accessing' } @@ -32,7 +31,8 @@ DSRecordRegistry class >> autoSerialize: anObject [ { #category : 'accessing' } DSRecordRegistry class >> current [ - ^Current ifNil:[Current := self new] + + ^ Current ifNil: [ Current := self new ] ifNotNil: [ Current ] ] { #category : 'private' } diff --git a/DebuggingSpy/DSRestartRecord.class.st b/DebuggingSpy/DSRestartRecord.class.st new file mode 100644 index 0000000..8224746 --- /dev/null +++ b/DebuggingSpy/DSRestartRecord.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSRestartRecord, + #superclass : #DSStepRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSRestartRecord >> eventSymbol [ + ^'R' +] diff --git a/DebuggingSpy/DSReturnRecord.class.st b/DebuggingSpy/DSReturnRecord.class.st new file mode 100644 index 0000000..3a5246c --- /dev/null +++ b/DebuggingSpy/DSReturnRecord.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSReturnRecord, + #superclass : #DSStepRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSReturnRecord >> eventSymbol [ + ^'r' +] diff --git a/DebuggingSpy/DSRunTestRecord.class.st b/DebuggingSpy/DSRunTestRecord.class.st new file mode 100644 index 0000000..2ba1166 --- /dev/null +++ b/DebuggingSpy/DSRunTestRecord.class.st @@ -0,0 +1,14 @@ +Class { + #name : #DSRunTestRecord, + #superclass : #DSAbstractExtendedRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #accessing } +DSRunTestRecord >> eventName [ + + ^ String streamContents: [ :str | + str << 'Running test:'. + str space. + str << sourceRecord itemElement ] +] diff --git a/DebuggingSpy/DSRunToRecord.class.st b/DebuggingSpy/DSRunToRecord.class.st new file mode 100644 index 0000000..4ab3978 --- /dev/null +++ b/DebuggingSpy/DSRunToRecord.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSRunToRecord, + #superclass : #DSStepRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSRunToRecord >> eventSymbol [ + ^'rT' +] diff --git a/DebuggingSpy/DSSTONFileLogger.class.st b/DebuggingSpy/DSSTONFileLogger.class.st index 8437d68..603ea38 100644 --- a/DebuggingSpy/DSSTONFileLogger.class.st +++ b/DebuggingSpy/DSSTONFileLogger.class.st @@ -1,6 +1,3 @@ -" -I log DSRecords as STON into files. -" Class { #name : 'DSSTONFileLogger', #superclass : 'Object', @@ -57,7 +54,12 @@ DSSTONFileLogger >> log: aDSEventRecord [ { #category : 'accessing' } DSSTONFileLogger >> loggingDirectory [ - ^loggingDirectory ifNil:[loggingDirectory := self defaultLoggingDirectoryName asFileReference] + + ^ loggingDirectory + ifNil: [ + loggingDirectory := self defaultLoggingDirectoryName + asFileReference ] + ifNotNil: [ loggingDirectory ] ] { #category : 'logging' } @@ -69,13 +71,19 @@ DSSTONFileLogger >> loggingDirectory: aStringOrFileReference [ { #category : 'accessing' } DSSTONFileLogger >> loggingFileName [ - ^loggingFilename ifNil:[loggingFilename := self defaultLoggingFileName] + + ^ loggingFilename + ifNil: [ loggingFilename := self defaultLoggingFileName ] + ifNotNil: [ loggingFilename ] ] { #category : 'accessing' } DSSTONFileLogger >> loggingFileReference [ - ^loggingFileReference ifNil:[loggingFileReference := self ensureCreateLoggingFileReference] + ^ loggingFileReference + ifNil: [ + loggingFileReference := self ensureCreateLoggingFileReference ] + ifNotNil: [ loggingFileReference ] ] { #category : 'initialization' } @@ -99,16 +107,16 @@ DSSTONFileLogger >> restoreCurrentConfiguration [ DSSTONFileLogger >> saveCurrentConfiguration [ self savedConfiguration - at: #currentLoggingFilename - put: loggingFilename. - self savedConfiguration - at: #currentLoggingFileReference - put: loggingFileReference + at: #currentLoggingFilename put: loggingFilename; + at: #currentLoggingFileReference put: loggingFileReference ] { #category : 'accessing' } DSSTONFileLogger >> savedConfiguration [ - ^savedConfiguration ifNil:[savedConfiguration := Dictionary new] + + ^ savedConfiguration + ifNil: [ savedConfiguration := Dictionary new ] + ifNotNil: [ savedConfiguration ] ] { #category : 'setup' } diff --git a/DebuggingSpy/DSSelectInspectorPageRecord.class.st b/DebuggingSpy/DSSelectInspectorPageRecord.class.st index 0d753a5..9b7c861 100644 --- a/DebuggingSpy/DSSelectInspectorPageRecord.class.st +++ b/DebuggingSpy/DSSelectInspectorPageRecord.class.st @@ -14,7 +14,7 @@ Class { { #category : 'accessing' } DSSelectInspectorPageRecord >> eventName [ - ^'Selecting inspector page' + ^'Selecting inspector tab' ] { #category : 'accessing' } diff --git a/DebuggingSpy/DSSindarinStepRecord.class.st b/DebuggingSpy/DSSindarinStepRecord.class.st new file mode 100644 index 0000000..29a8e10 --- /dev/null +++ b/DebuggingSpy/DSSindarinStepRecord.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSSindarinStepRecord, + #superclass : #DSStepRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSSindarinStepRecord >> eventSymbol [ + ^'sV' +] diff --git a/DebuggingSpy/DSSpy.class.st b/DebuggingSpy/DSSpy.class.st index 7ea873e..e73b8bd 100644 --- a/DebuggingSpy/DSSpy.class.st +++ b/DebuggingSpy/DSSpy.class.st @@ -1,6 +1,3 @@ -" -I collect spy informations -" Class { #name : 'DSSpy', #superclass : 'Object', @@ -96,7 +93,9 @@ DSSpy class >> log: elements key: key [ { #category : 'accessing' } DSSpy class >> logOnlyWhenTaskStarted [ - ^ logOnlyWhenTaskStarted ifNil:[logOnlyWhenTaskStarted := false] + ^ logOnlyWhenTaskStarted + ifNil: [ logOnlyWhenTaskStarted := false ] + ifNotNil: [ logOnlyWhenTaskStarted ] ] { #category : 'accessing' } @@ -137,7 +136,9 @@ DSSpy class >> logWindowOpened: anEvent [ { #category : 'accessing' } DSSpy class >> logger [ - ^ logger ifNil:[logger := self defaultLoggerClass new] + ^ logger + ifNil: [ logger := self defaultLoggerClass new ] + ifNotNil: [ logger ] ] { #category : 'accessing' } @@ -199,7 +200,8 @@ DSSpy class >> methodRemoved: evt [ { #category : 'accessing' } DSSpy class >> monitor [ - ^monitor ifNil:[monitor := Monitor new] + + ^ monitor ifNil: [ monitor := Monitor new ] ifNotNil: [ monitor ] ] { #category : 'events - methods' } @@ -210,8 +212,9 @@ DSSpy class >> monitorPackageForSourceCodeChanges: aString [ { #category : 'events - methods' } DSSpy class >> packagesMonitoredForSourceCodeChanges [ - ^ packagesMonitoredForSourceCodeChanges ifNil: [ - packagesMonitoredForSourceCodeChanges := Set new ] + ^ packagesMonitoredForSourceCodeChanges + ifNil: [ packagesMonitoredForSourceCodeChanges := Set new ] + ifNotNil: [ packagesMonitoredForSourceCodeChanges ] ] { #category : 'accessing' } @@ -228,7 +231,9 @@ DSSpy class >> recordBreakpointEvent: aBreakpointEvent [ { #category : 'accessing' } DSSpy class >> recordClipboardContent [ - ^ recordClipboardContent ifNil: [ recordClipboardContent := false ] + ^ recordClipboardContent + ifNil: [ recordClipboardContent := false ] + ifNotNil: [ recordClipboardContent ] ] { #category : 'accessing' } @@ -274,7 +279,9 @@ DSSpy class >> recordHaltInRemovedMethod: oldMethod [ { #category : 'accessing' } DSSpy class >> recordSourceCode [ - ^ recordSourceCode ifNil: [ recordSourceCode := false ] + ^ recordSourceCode + ifNil: [ recordSourceCode := false ] + ifNotNil: [ recordSourceCode ] ] { #category : 'accessing' } @@ -314,7 +321,9 @@ DSSpy class >> resetSpy [ { #category : 'accessing' } DSSpy class >> scopeSourceCodeChangesRecording [ - ^ scopeSourceCodeChangesRecording ifNil: [ scopeSourceCodeChangesRecording := false ] + ^ scopeSourceCodeChangesRecording + ifNil: [ scopeSourceCodeChangesRecording := false ] + ifNotNil: [ scopeSourceCodeChangesRecording ] ] { #category : 'accessing' } @@ -340,5 +349,7 @@ DSSpy class >> startTask: aTask [ { #category : 'accessing' } DSSpy class >> taskStarted [ - ^ taskStarted ifNil: [ taskStarted := false ] + ^ taskStarted + ifNil: [ taskStarted := false ] + ifNotNil: [ taskStarted ] ] diff --git a/DebuggingSpy/DSSpyInstrumenter.class.st b/DebuggingSpy/DSSpyInstrumenter.class.st index 5ad9a29..d2168b9 100644 --- a/DebuggingSpy/DSSpyInstrumenter.class.st +++ b/DebuggingSpy/DSSpyInstrumenter.class.st @@ -43,7 +43,7 @@ DSSpyInstrumenter >> instrumentClyQueryBrowser [ ifFalse: [title := ''Loading: '', title ]. self systemScope isCurrentImage ifFalse: [ title := title , '' in '', self systemScope description ]. - [DSQueryBrowseRecord for: self] on: Error do: [DSSpy log: #ERROR key: #BROWSE]. + [DSQueryBrowseRecord for: self] on: Error do: [DSSpy log: #ERROR key: #QUERY]. ^title' ] @@ -151,7 +151,19 @@ stackTable := self newList. stackHeader label: ''Stack''' ] + +{ #category : 'breakpoints' } +DSSpyInstrumenter >> instrumentExceptionSignalling [ + Exception compile: 'raiseUnhandledError + + self class = Halt ifFalse:[[ DSUnhandledExceptionRecord for: self] + on: Error + do:[:err| DSSpy log: #ERROR key: self class name asSymbol ]]. + ^ UnhandledError signalForException: self'. +] + { #category : 'inspector' } + DSSpyInstrumenter >> instrumentExpandAttribute [ FTBasicItem compile: 'expandAndRefresh diff --git a/DebuggingSpy/DSStepActionRecord.class.st b/DebuggingSpy/DSStepActionRecord.class.st index 187c5a3..e6e0083 100644 --- a/DebuggingSpy/DSStepActionRecord.class.st +++ b/DebuggingSpy/DSStepActionRecord.class.st @@ -1,8 +1,3 @@ -" -I record a debugging action from an opened debugger. -In addition to the debugger window id, I also record the signature of the context I am performing the action as well as the current node of that context. -In confidentiality mode, this signature and node should be replaced by the current pc instead. -" Class { #name : 'DSStepActionRecord', #superclass : 'DSAbstractEventRecord', @@ -18,6 +13,19 @@ Class { #tag : 'Records' } +{ #category : 'converting' } +DSStepActionRecord >> asStepRecord [ + + ((SindarinCommand allSubclasses collect: #defaultName) includes: + eventName) ifTrue: [ ^ DSStepRecord sindarinStep: self ]. + + ^ DSStepRecord + perform: + (eventName asLowercase copyReplaceAll: ' ' with: '') asSymbol + asMutator + with: self +] + { #category : 'accessing' } DSStepActionRecord >> context [ @@ -35,6 +43,23 @@ DSStepActionRecord >> node [ ^ node ] +{ #category : 'printing' } +DSStepActionRecord >> printContextAndNode [ + + ^ String streamContents: [ :s | + | nodeStream peek | + s << '['. + s << context. + s << ']'. + s space. + nodeStream := node readStream. + peek := nodeStream upTo: $(. + + s << (nodeStream atEnd + ifTrue: [ peek ] + ifFalse: [ nodeStream upTo: $) ]) ] +] + { #category : 'accessing' } DSStepActionRecord >> receiver [ diff --git a/DebuggingSpy/DSStepRecord.class.st b/DebuggingSpy/DSStepRecord.class.st new file mode 100644 index 0000000..13c0ef7 --- /dev/null +++ b/DebuggingSpy/DSStepRecord.class.st @@ -0,0 +1,98 @@ +Class { + #name : #DSStepRecord, + #superclass : #DSAbstractExtendedRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSStepRecord class >> for: anEvent [ + + | step | + step := self new. + step become: anEvent. + anEvent record: step. + ^ anEvent +] + +{ #category : #'as yet unclassified' } +DSStepRecord class >> into: aDSDebuggerActionRecord [ + + ^ DSIntoRecord for: aDSDebuggerActionRecord +] + +{ #category : #'as yet unclassified' } +DSStepRecord class >> over: aDSDebuggerActionRecord [ + + ^ DSOverRecord for: aDSDebuggerActionRecord +] + +{ #category : #'as yet unclassified' } +DSStepRecord class >> proceed: aDSDebuggerActionRecord [ + + ^ DSProceedRecord for: aDSDebuggerActionRecord +] + +{ #category : #'as yet unclassified' } +DSStepRecord class >> restart: aDSDebuggerActionRecord [ + + ^ DSRestartRecord for: aDSDebuggerActionRecord +] + +{ #category : #'as yet unclassified' } +DSStepRecord class >> return: aDSDebuggerActionRecord [ + + ^ DSReturnRecord for: aDSDebuggerActionRecord +] + +{ #category : #'as yet unclassified' } +DSStepRecord class >> runto: aDSDebuggerActionRecord [ + + ^ DSRunToRecord for: aDSDebuggerActionRecord +] + +{ #category : #'as yet unclassified' } +DSStepRecord class >> sindarinStep: aDSDebuggerActionRecord [ + + ^ DSSindarinStepRecord for: aDSDebuggerActionRecord +] + +{ #category : #'as yet unclassified' } +DSStepRecord class >> through: aDSDebuggerActionRecord [ + + ^ DSThroughRecord for: aDSDebuggerActionRecord +] + +{ #category : #accessing } +DSStepRecord >> context [ + ^sourceRecord context +] + +{ #category : #accessing } +DSStepRecord >> eventName [ + ^ sourceRecord eventName +] + +{ #category : #'as yet unclassified' } +DSStepRecord >> eventSymbol [ + ^'V' +] + +{ #category : #accessing } +DSStepRecord >> node [ + ^sourceRecord node +] + +{ #category : #printing } +DSStepRecord >> printContextAndNode [ + ^sourceRecord printContextAndNode +] + +{ #category : #accessing } +DSStepRecord >> receiver [ + ^sourceRecord receiver +] + +{ #category : #accessing } +DSStepRecord >> receiverClass [ + ^sourceRecord receiverClass +] diff --git a/DebuggingSpy/DSSurveyRecord.class.st b/DebuggingSpy/DSSurveyRecord.class.st index b89a1fb..a73929c 100644 --- a/DebuggingSpy/DSSurveyRecord.class.st +++ b/DebuggingSpy/DSSurveyRecord.class.st @@ -18,6 +18,13 @@ DSSurveyRecord >> answer [ ^survey answer ] + +{ #category : 'as yet unclassified' } +DSSurveyRecord >> collectAnswersFromQuestions [ + + ^ survey collectAnswersFromQuestions +] + { #category : 'accessing' } DSSurveyRecord >> collectAnswers [ ^survey collectAnswers @@ -58,3 +65,13 @@ DSSurveyRecord >> record: aSurvey [ DSSurveyRecord >> survey [ ^survey ] + +{ #category : #accessing } +DSSurveyRecord >> windowName [ + ^survey title +] + +{ #category : #'as yet unclassified' } +DSSurveyRecord >> windowType [ + ^'Survey' +] diff --git a/DebuggingSpy/DSTCommandForTests.trait.st b/DebuggingSpy/DSTCommandForTests.trait.st index c053316..ee22301 100644 --- a/DebuggingSpy/DSTCommandForTests.trait.st +++ b/DebuggingSpy/DSTCommandForTests.trait.st @@ -1,6 +1,3 @@ -" -I provide an accessor to tell that a debugging command is used within a test, in order to avoid executing too much debugging code (and for example to make the execution loop indefinitely when we proceed an infinite recursion). -" Trait { #name : 'DSTCommandForTests', #instVars : [ @@ -14,7 +11,7 @@ Trait { { #category : 'accessing' } DSTCommandForTests >> forTests [ - ^ forTests ifNil:[forTests := false] + ^ forTests ifNil: [ forTests := false ] ifNotNil: [ forTests ] ] { #category : 'accessing' } diff --git a/DebuggingSpy/DSTaskSuccessRecord.class.st b/DebuggingSpy/DSTaskSuccessRecord.class.st index 42ff988..1ce5d61 100644 --- a/DebuggingSpy/DSTaskSuccessRecord.class.st +++ b/DebuggingSpy/DSTaskSuccessRecord.class.st @@ -1,9 +1,3 @@ -" -I represent the result of an automatic evaluation of a task success. -true = success. -false = failure. -This boolean is stored into the success inst var. -" Class { #name : 'DSTaskSuccessRecord', #superclass : 'DSAbstractTaskRecord', @@ -28,5 +22,6 @@ DSTaskSuccessRecord >> record: anArray [ { #category : 'accessing' } DSTaskSuccessRecord >> success [ - ^success ifNil:[success := false] + + ^ success ifNil: [ success := false ] ifNotNil: [ success ] ] diff --git a/DebuggingSpy/DSThroughRecord.class.st b/DebuggingSpy/DSThroughRecord.class.st new file mode 100644 index 0000000..de3cbbb --- /dev/null +++ b/DebuggingSpy/DSThroughRecord.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSThroughRecord, + #superclass : #DSStepRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSThroughRecord >> eventSymbol [ + ^'T' +] diff --git a/DebuggingSpy/DSUnhandledExceptionRecord.class.st b/DebuggingSpy/DSUnhandledExceptionRecord.class.st new file mode 100644 index 0000000..5445eee --- /dev/null +++ b/DebuggingSpy/DSUnhandledExceptionRecord.class.st @@ -0,0 +1,62 @@ +" +I record unhandled exceptions with their context information +" +Class { + #name : #DSUnhandledExceptionRecord, + #superclass : #DSAbstractEventRecord, + #instVars : [ + 'exceptionClass', + 'errorString', + 'receiver', + 'node', + 'method' + ], + #category : #'DebuggingSpy-Records' +} + +{ #category : #accessing } +DSUnhandledExceptionRecord >> errorString [ + ^ errorString +] + +{ #category : #accessing } +DSUnhandledExceptionRecord >> eventName [ + ^exceptionClass +] + +{ #category : #accessing } +DSUnhandledExceptionRecord >> exceptionClass [ + ^ exceptionClass +] + +{ #category : #accessing } +DSUnhandledExceptionRecord >> method [ + ^ method +] + +{ #category : #accessing } +DSUnhandledExceptionRecord >> node [ + ^ node +] + +{ #category : #accessing } +DSUnhandledExceptionRecord >> receiver [ + ^ receiver +] + +{ #category : #'actions api' } +DSUnhandledExceptionRecord >> record: anException [ + + |signalerContext context| + signalerContext := anException signalerContext. + receiver := signalerContext receiver class name. + + context := signalerContext. + [ context method pragmas anySatisfy: [ :p| p selector = #debuggerCompleteToSender ] ] + whileTrue:[context := signalerContext sender.]. + node := (context method sourceNodeForPC: context pc) sourceCode. + method := context method selector. + + exceptionClass := anException class name. + errorString := anException description +] diff --git a/DebuggingSpy/DSVariableBreakpointAdd.class.st b/DebuggingSpy/DSVariableBreakpointAdd.class.st new file mode 100644 index 0000000..ab787f2 --- /dev/null +++ b/DebuggingSpy/DSVariableBreakpointAdd.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSVariableBreakpointAdd, + #superclass : #DSVariableBreakpointRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSVariableBreakpointAdd >> eventSymbol [ + ^'+vb' +] diff --git a/DebuggingSpy/DSVariableBreakpointEventRecord.class.st b/DebuggingSpy/DSVariableBreakpointEventRecord.class.st index 1b55316..ea39e52 100644 --- a/DebuggingSpy/DSVariableBreakpointEventRecord.class.st +++ b/DebuggingSpy/DSVariableBreakpointEventRecord.class.st @@ -20,6 +20,12 @@ DSVariableBreakpointEventRecord >> accessStrategy [ ^ accessStrategy ] +{ #category : 'converting' } +DSVariableBreakpointEventRecord >> modelClass [ + + ^ DSVariableBreakpointRecord +] + { #category : 'actions api' } DSVariableBreakpointEventRecord >> record: aBreakpointEvent [ super record: aBreakpointEvent. diff --git a/DebuggingSpy/DSVariableBreakpointHit.class.st b/DebuggingSpy/DSVariableBreakpointHit.class.st new file mode 100644 index 0000000..14b9548 --- /dev/null +++ b/DebuggingSpy/DSVariableBreakpointHit.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSVariableBreakpointHit, + #superclass : #DSVariableBreakpointRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSVariableBreakpointHit >> eventSymbol [ + ^'*vb' +] diff --git a/DebuggingSpy/DSVariableBreakpointRecord.class.st b/DebuggingSpy/DSVariableBreakpointRecord.class.st new file mode 100644 index 0000000..65bc1e2 --- /dev/null +++ b/DebuggingSpy/DSVariableBreakpointRecord.class.st @@ -0,0 +1,62 @@ +Class { + #name : #DSVariableBreakpointRecord, + #superclass : #DSBreakpointRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSVariableBreakpointRecord class >> breakpointadded: event [ + + ^DSVariableBreakpointAdd for: event +] + +{ #category : #'as yet unclassified' } +DSVariableBreakpointRecord class >> breakpointhit: event [ + + ^DSVariableBreakpointHit for: event +] + +{ #category : #'as yet unclassified' } +DSVariableBreakpointRecord class >> breakpointremoved: event [ + + ^DSVariableBreakpointRemoved for: event +] + +{ #category : #'instance creation' } +DSVariableBreakpointRecord class >> for: anEvent [ + + | breakpoint | + breakpoint := self new. + breakpoint become: anEvent. + anEvent record: breakpoint. + ^ anEvent +] + +{ #category : #accessing } +DSVariableBreakpointRecord >> accessStrategy [ + ^sourceRecord accessStrategy +] + +{ #category : #accessing } +DSVariableBreakpointRecord >> eventName [ + + ^ String streamContents: [ :s | + s << 'Variable'. + s << super eventName ] +] + +{ #category : #'accessing - analysis' } +DSVariableBreakpointRecord >> submethodTargets [ + + ^ self targetVariables +] + +{ #category : #accessing } +DSVariableBreakpointRecord >> targetClassOrMethod [ + ^sourceRecord targetClassOrMethod +] + +{ #category : #accessing } +DSVariableBreakpointRecord >> targetVariables [ + ^sourceRecord targetVariables +] diff --git a/DebuggingSpy/DSVariableBreakpointRemoved.class.st b/DebuggingSpy/DSVariableBreakpointRemoved.class.st new file mode 100644 index 0000000..bc47825 --- /dev/null +++ b/DebuggingSpy/DSVariableBreakpointRemoved.class.st @@ -0,0 +1,10 @@ +Class { + #name : #DSVariableBreakpointRemoved, + #superclass : #DSVariableBreakpointRecord, + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSVariableBreakpointRemoved >> eventSymbol [ + ^'-vb' +] diff --git a/DebuggingSpy/DSWindowActivityRecord.class.st b/DebuggingSpy/DSWindowActivityRecord.class.st new file mode 100644 index 0000000..ee54974 --- /dev/null +++ b/DebuggingSpy/DSWindowActivityRecord.class.st @@ -0,0 +1,160 @@ +Class { + #name : #DSWindowActivityRecord, + #superclass : #DSAbstractEventRecord, + #instVars : [ + 'start', + 'stop', + 'events', + 'window', + 'previous', + 'next', + 'annotation' + ], + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'as yet unclassified' } +DSWindowActivityRecord class >> start: aDSMouseEnterWindowRecord stop: aDSMouseLeaveWindowRecord events: aCollection [ + + ^ self new + start: aDSMouseEnterWindowRecord; + stop: aDSMouseLeaveWindowRecord; + events: aCollection; + yourself +] + +{ #category : #'as yet unclassified' } +DSWindowActivityRecord class >> start: aDSMouseEnterWindowRecord stop: aDSMouseLeaveWindowRecord events: aCollection window: aDSWindowRecord [ + + ^ (self + start: aDSMouseEnterWindowRecord + stop: aDSMouseLeaveWindowRecord + events: aCollection) + window: aDSWindowRecord; + yourself +] + +{ #category : #accessing } +DSWindowActivityRecord >> annotation [ + + ^ annotation ifNil:[annotation := DSWindowAnnotation new] +] + +{ #category : #accessing } +DSWindowActivityRecord >> annotation: anObject [ + + annotation := anObject +] + +{ #category : #accessing } +DSWindowActivityRecord >> duration [ + + ^ events last dateTime - events first dateTime +] + +{ #category : #accessing } +DSWindowActivityRecord >> eventName [ + + ^ String streamContents: [ :ws | + window printTypeOn: ws. + ws << ':'. + ws space. + ws << self duration humanReadablePrintString ] +] + +{ #category : #accessing } +DSWindowActivityRecord >> events [ + + ^ events +] + +{ #category : #accessing } +DSWindowActivityRecord >> events: anObject [ + + events := anObject +] + +{ #category : #inspections } +DSWindowActivityRecord >> inspectionAnnotation [ + + + ^ DSWindowElementAnnotationPresenter on: self +] + +{ #category : #merging } +DSWindowActivityRecord >> merge: aDSWindowActivityRecord [ + |merge become| + merge := DSMergedWindowActivityRecord new. + become := self. + merge become: self. + become mergeWith: merge. + become mergeWith: aDSWindowActivityRecord +] + +{ #category : #accessing } +DSWindowActivityRecord >> next [ + + ^ next +] + +{ #category : #accessing } +DSWindowActivityRecord >> next: anObject [ + + next := anObject +] + +{ #category : #accessing } +DSWindowActivityRecord >> previous [ + + ^ previous +] + +{ #category : #accessing } +DSWindowActivityRecord >> previous: anObject [ + + previous := anObject +] + +{ #category : #accessing } +DSWindowActivityRecord >> start [ + + ^ start +] + +{ #category : #accessing } +DSWindowActivityRecord >> start: anObject [ + + start := anObject +] + +{ #category : #accessing } +DSWindowActivityRecord >> stop [ + + ^ stop +] + +{ #category : #accessing } +DSWindowActivityRecord >> stop: anObject [ + + stop := anObject +] + +{ #category : #accessing } +DSWindowActivityRecord >> window [ + + ^ window +] + +{ #category : #accessing } +DSWindowActivityRecord >> window: anObject [ + + window := anObject +] + +{ #category : #accessing } +DSWindowActivityRecord >> windowId [ + + ^ windowId + ifNil: [ windowId := window windowId ] + ifNotNil: [ windowId ] +] diff --git a/DebuggingSpy/DSWindowAnnotation.class.st b/DebuggingSpy/DSWindowAnnotation.class.st new file mode 100644 index 0000000..e61c4aa --- /dev/null +++ b/DebuggingSpy/DSWindowAnnotation.class.st @@ -0,0 +1,39 @@ +Class { + #name : #DSWindowAnnotation, + #superclass : #Object, + #instVars : [ + 'index', + 'annotation' + ], + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #accessing } +DSWindowAnnotation >> annotation [ + + ^ annotation ifNil:[annotation := ''] +] + +{ #category : #accessing } +DSWindowAnnotation >> annotation: anObject [ + + annotation := anObject +] + +{ #category : #accessing } +DSWindowAnnotation >> index [ + + ^ index ifNil:[index := 0] +] + +{ #category : #accessing } +DSWindowAnnotation >> index: anObject [ + + index := anObject +] + +{ #category : #'as yet unclassified' } +DSWindowAnnotation >> intialize [ + annotation := String new. + index := 0 +] diff --git a/DebuggingSpy/DSWindowElementAnnotationPresenter.class.st b/DebuggingSpy/DSWindowElementAnnotationPresenter.class.st new file mode 100644 index 0000000..184eb5d --- /dev/null +++ b/DebuggingSpy/DSWindowElementAnnotationPresenter.class.st @@ -0,0 +1,46 @@ +Class { + #name : #DSWindowElementAnnotationPresenter, + #superclass : #StInspection, + #instVars : [ + 'windowElement', + 'indexField', + 'annotationText' + ], + #category : #'DebuggingSpy-Presenters' +} + +{ #category : #layout } +DSWindowElementAnnotationPresenter >> defaultLayout [ + + ^ SpBoxLayout newTopToBottom + add: (SpPanedLayout newLeftToRight + positionOfSlider: 35 percent; + add: (self newLabel label: 'Index'; yourself); + add: indexField; + yourself) expand: false fill: false padding: 0; + add: (self newLabel label:'Annotation'; yourself) expand: false fill: false padding: 0; + add: annotationText; + yourself +] + +{ #category : #initialization } +DSWindowElementAnnotationPresenter >> initializePresenters [ + super initializePresenters. + + indexField := self newNumberInput. + indexField number: windowElement annotation index. + + annotationText := self newText. + annotationText text: windowElement annotation annotation. + + indexField whenTextChangedDo: [ windowElement annotation index: indexField number ]. + annotationText whenTextChangedDo: [ windowElement annotation annotation: annotationText text ] + + +] + +{ #category : #'accessing - model' } +DSWindowElementAnnotationPresenter >> setModelBeforeInitialization: aDSWindowOrWindowActivity [ + + windowElement := aDSWindowOrWindowActivity +] diff --git a/DebuggingSpy/DSWindowEventRecord.class.st b/DebuggingSpy/DSWindowEventRecord.class.st index 627a0ca..8ec0dbf 100644 --- a/DebuggingSpy/DSWindowEventRecord.class.st +++ b/DebuggingSpy/DSWindowEventRecord.class.st @@ -1,9 +1,3 @@ -" -I represent an abstract window event record, typically an opening, closing, resizing, or activation of a window. -I hold a unique window ID that corresponds to the original window object's identity hash. This ID should be used to group together all events related to that particular window. - -I should be used from my class-side interface, called on my subclasses to match particular window events. -" Class { #name : 'DSWindowEventRecord', #superclass : 'DSAbstractEventRecord', @@ -52,3 +46,20 @@ DSWindowEventRecord >> windowName: anObject [ windowName := anObject ] + +{ #category : #'as yet unclassified' } +DSWindowEventRecord >> windowType [ + + | rs type | + ((windowName splitOn: Character space) includes: 'senders') ifTrue:[^'Senders']. + ((windowName splitOn: Character space) includes: 'Senders') ifTrue:[^'Senders']. + ((windowName splitOn: Character space) includes: 'implementors') ifTrue:[^'Implementors']. + ((windowName splitOn: Character space) includes: 'Implementors') ifTrue:[^'Implementors']. + + rs := windowName readStream. + type := rs upTo: Character space. + type size = 1 ifTrue: [ type := rs upTo: $( ]. + (#('Spotter' 'implementors' 'Inspector' 'Debugger' 'Implementors' 'Breakpoint' 'Transcript' 'Browser' 'ClyQueryBrowserMorph' 'ClyFullBrowserMorph' 'CORMAS - ECECModel') includes: type) ifTrue:[^type]. + type isNumber ifTrue:[^'X']. + ^ 'Application' +] diff --git a/DebuggingSpy/DSWindowRecord.class.st b/DebuggingSpy/DSWindowRecord.class.st new file mode 100644 index 0000000..889a805 --- /dev/null +++ b/DebuggingSpy/DSWindowRecord.class.st @@ -0,0 +1,228 @@ +Class { + #name : #DSWindowRecord, + #superclass : #Object, + #instVars : [ + 'type', + 'name', + 'events', + 'activePeriods', + 'sourceEvent', + 'idleTime', + 'trueIdleTime' + ], + #category : #'DebuggingSpy-Records-Extensions' +} + +{ #category : #'instance creation' } +DSWindowRecord class >> for: events [ + ^self new buildEvents: events +] + +{ #category : #accessing } +DSWindowRecord >> activePeriods [ + + ^ activePeriods +] + +{ #category : #accessing } +DSWindowRecord >> activePeriods: anObject [ + + activePeriods := anObject +] + +{ #category : #adding } +DSWindowRecord >> addIdleTime: aDuration [ + idleTime ifNil: [ + idleTime := aDuration. + idleTime asSeconds = 40562 ifTrue: [ self halt ]. + idleTime asSeconds = 3800 ifTrue: [ self halt ]. + ^ self ]. + idleTime := idleTime + aDuration. + idleTime asSeconds = 40562 ifTrue: [ self halt ]. + idleTime asSeconds = 3800 ifTrue: [ self halt ]. +] + +{ #category : #'as yet unclassified' } +DSWindowRecord >> buildEvents: aCollectionOfEvents [ + + events := aCollectionOfEvents. + self computeActivePeriods. + + type := self windowTypeFor: events first. + type = 'ClyQueryBrowserMorph' ifTrue: [ + (events + detect: [ :e | e class == DSQueryBrowseRecord ] + ifNone: [ nil ]) ifNotNil: [ :e | + type := (e queryName readStream upTo: Character space) capitalized. + name := (e queryName splitOn: Character space) last ] ]. + + + type = 'ClyFullBrowserMorph' ifTrue: [ + type := 'Browser'. + (events + detect: [ :e | e class == DSFullBrowseRecord ] + ifNone: [ nil ]) ifNotNil: [ :e | + name := String streamContents: [ :ws | + (#( nil '' ) includes: e classBrowsed) ifFalse: [ + ws << e classBrowsed ]. + (#( nil '' ) includes: e methodBrowsed) ifFalse: [ + ws << '>>'. + ws << e methodBrowsed ] ] ] ]. + + name ifNotNil: [ ^ self ]. + name := self windowNameFor: events first +] + +{ #category : #'as yet unclassified' } +DSWindowRecord >> computeActivePeriods [ + + | activityStartStopEvents start stop previous | + activePeriods := OrderedCollection new. + activityStartStopEvents := events select: [ :e | + { + DSMouseEnterWindowRecord. + DSMouseLeaveWindowRecord } includes: + e class ]. + (activityStartStopEvents notEmpty and: [ + activityStartStopEvents first class == DSMouseLeaveWindowRecord ]) + ifTrue: [ activityStartStopEvents removeFirst ]. + + [ activityStartStopEvents isEmpty ] whileFalse: [ + | next | + next := activityStartStopEvents removeFirst. + next class = DSMouseEnterWindowRecord ifTrue: [ + previous class = next class ifFalse: [ start := next ] ]. + + next class = DSMouseLeaveWindowRecord ifTrue: [ + | startIndex stopIndex | + stop := next. + startIndex := events indexOf: start. + stopIndex := events indexOf: stop. + startIndex > 0 ifTrue: [ + activePeriods add: (DSWindowActivityRecord + start: start + stop: stop + events: (events copyFrom: startIndex to: stopIndex) + window: self) ] ]. + previous := next ] +] + +{ #category : #accessing } +DSWindowRecord >> events [ + + ^ events +] + +{ #category : #accessing } +DSWindowRecord >> events: anObject [ + + events := anObject +] + +{ #category : #accessing } +DSWindowRecord >> idleTime [ + + ^ idleTime ifNil: [ idleTime := 0 seconds ] ifNotNil: [ idleTime ] +] + +{ #category : #testing } +DSWindowRecord >> isDebugger [ + + events ifEmpty: [ ^ false ]. + ^ events first class == DSDebuggerOpeningRecord +] + +{ #category : #accessing } +DSWindowRecord >> name [ + + ^ name +] + +{ #category : #accessing } +DSWindowRecord >> name: anObject [ + + name := anObject +] + +{ #category : #printing } +DSWindowRecord >> printOn: ws [ + ws << '['. + self printTypeOn: ws. + ws << ']'. + ws space. + ws << (name isString ifTrue:[name] ifFalse:[name printString]) +] + +{ #category : #printing } +DSWindowRecord >> printTypeOn: aStream [ + + type isString ifTrue: [ + aStream << type. + ^ self ]. + aStream << 'External Window' +] + +{ #category : #accessing } +DSWindowRecord >> sourceEvent [ + + ^ sourceEvent +] + +{ #category : #accessing } +DSWindowRecord >> sourceEvent: anObject [ + + sourceEvent := anObject +] + +{ #category : #accessing } +DSWindowRecord >> totalTime [ + + ^ (activePeriods + inject: 0 + into: [ :sum :next | sum + next duration asSeconds ]) seconds +] + +{ #category : #accessing } +DSWindowRecord >> trueIdleTime [ + + ^ trueIdleTime + ifNil: [ trueIdleTime := 0 asSeconds ] + ifNotNil: [ trueIdleTime ] +] + +{ #category : #accessing } +DSWindowRecord >> trueIdleTime: anObject [ + + trueIdleTime := anObject +] + +{ #category : #accessing } +DSWindowRecord >> type [ + + ^ type +] + +{ #category : #accessing } +DSWindowRecord >> type: anObject [ + + type := anObject +] + +{ #category : #accessing } +DSWindowRecord >> windowId [ + ^events first windowId +] + +{ #category : #'as yet unclassified' } +DSWindowRecord >> windowNameFor: aDSDebuggerOpeningRecord [ + + ^ [ aDSDebuggerOpeningRecord windowName ] + on: Error + do: [ aDSDebuggerOpeningRecord windowId ] +] + +{ #category : #'as yet unclassified' } +DSWindowRecord >> windowTypeFor: aDSDebuggerOpeningRecord [ + + ^aDSDebuggerOpeningRecord windowType +]