diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 8e95cf0..c2dbaa6 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -239,6 +239,30 @@ SindarinDebuggerTest >> helperMethodWithBlockWithNoReturn [ ^ 43 ] +{ #category : #helpers } +SindarinDebuggerTest >> helperMethodWithEvaluatedBlock [ + + | a b block | + a := 1. + block := [ a := 2. b := 3 + 2 ]. + block value. + ^ 42 + +] + +{ #category : #helpers } +SindarinDebuggerTest >> helperMethodWithSeveralInstructionsInBlock [ + + | a b block | + a := 3. + block := [ + a := 1. + b := 2. + 1 + 2 ]. + b := block value. + ^ 42 +] + { #category : #running } SindarinDebuggerTest >> runCaseManaged [ ^ self runCase @@ -306,6 +330,62 @@ SindarinDebuggerTest >> testAssignmentVariableName [ self assert: scdbg assignmentVariableName equals: #a ] +{ #category : #tests } +SindarinDebuggerTest >> testCanStillExecuteWhenAimedNodePcIsAfterInAnyContext [ + + | sdbg aimedNodeInContext aimedNodeOutsideContext | + sdbg := SindarinDebugger debug: [ + self helperMethodWithSeveralInstructionsInBlock ]. + sdbg + step; + stepOver; + stepOver; + stepOver; + stepThrough; + stepOver. + + aimedNodeInContext := sdbg methodNode body statements last. + + self assert: sdbg pc + < (sdbg methodNode lastPcForNode: aimedNodeInContext). + self assert: (sdbg canStillExecute: aimedNodeInContext). + + aimedNodeOutsideContext := sdbg node methodNode body statements last. + + self assert: (sdbg outerMostContextOf: sdbg context) pc + < (sdbg node methodNode lastPcForNode: + aimedNodeOutsideContext). + self assert: (sdbg canStillExecute: aimedNodeOutsideContext) +] + +{ #category : #tests } +SindarinDebuggerTest >> testCanStillExecuteWhenAimedNodePcIsBeforeInAnyContext [ + + | sdbg aimedNodeInContext aimedNodeOutsideContext | + sdbg := SindarinDebugger debug: [ + self helperMethodWithSeveralInstructionsInBlock ]. + sdbg + step; + stepOver; + stepOver; + stepOver; + stepThrough; + stepOver. + + aimedNodeInContext := sdbg methodNode body statements first. + + self deny: sdbg pc + < (sdbg methodNode lastPcForNode: aimedNodeInContext). + self deny: (sdbg canStillExecute: aimedNodeInContext). + + aimedNodeOutsideContext := sdbg node methodNode body statements second. + + self deny: (sdbg outerMostContextOf: sdbg context) pc + < (sdbg node methodNode lastPcForNode: + aimedNodeOutsideContext). + self deny: (sdbg canStillExecute: aimedNodeOutsideContext) +] + { #category : #tests } SindarinDebuggerTest >> testContext [ | scdbg | @@ -606,6 +686,56 @@ SindarinDebuggerTest >> testSkipAssignmentWithStoreIntoBytecodePushesReplacement self assert: a equals: aFormerValue ] +{ #category : #tests } +SindarinDebuggerTest >> testSkipBlockNode [ + + | scdbg targetContext | + scdbg := SindarinDebugger debug: [ self helperMethodNonLocalReturn ]. + + scdbg + step; + step. + + self assert: scdbg topStack isBlock. + + scdbg stepUntil: [ + scdbg node isMessage and: [ scdbg messageSelector = #value ] ]. + + targetContext := scdbg context sender. + scdbg stepOver. + + self assert: scdbg context identicalTo: targetContext. + self assert: scdbg topStack equals: 42. + + scdbg := SindarinDebugger debug: [ self helperMethodNonLocalReturn ]. + + scdbg + step; + skip. + + self assert: scdbg topStack isNil. + + scdbg stepUntil: [ + scdbg node isMessage and: [ scdbg messageSelector = #value ] ]. + + targetContext := scdbg context. + + scdbg stepOver. + + self assert: scdbg context identicalTo: targetContext. + self assert: scdbg topStack equals: 43 +] + +{ #category : #tests } +SindarinDebuggerTest >> testSkipDoesNotSkipReturn [ + + | a scdbg | + scdbg := SindarinDebugger debug: [ a := 1. ^ 42 ]. + + self shouldnt: [ scdbg skip ] raise: SindarinSkippingReturnWarning. + self should: [ scdbg skip ] raise: SindarinSkippingReturnWarning +] + { #category : #tests } SindarinDebuggerTest >> testSkipSkipsMessagesByPuttingReceiverOnStack [ @@ -640,16 +770,6 @@ SindarinDebuggerTest >> testSkipSkipsSuperSendBytecodesCorrectly [ self assert: a equals: oldValueOfA ] -{ #category : #tests } -SindarinDebuggerTest >> testSkipDoesNotSkipReturn [ - - | a scdbg | - scdbg := SindarinDebugger debug: [ a := 1. ^ 42 ]. - - self shouldnt: [ scdbg skip ] raise: SindarinSkippingReturnWarning. - self should: [ scdbg skip ] raise: SindarinSkippingReturnWarning -] - { #category : #tests } SindarinDebuggerTest >> testSkipStepsMethodNodes [ @@ -676,46 +796,6 @@ SindarinDebuggerTest >> testSkipStepsMethodNodes [ self assert: scdbg topStack equals: realTopStack ] -{ #category : #tests } -SindarinDebuggerTest >> testSkipBlockNode [ - - | scdbg targetContext | - scdbg := SindarinDebugger debug: [ self helperMethodNonLocalReturn ]. - - scdbg - step; - step. - - self assert: scdbg topStack isBlock. - - scdbg stepUntil: [ - scdbg node isMessage and: [ scdbg messageSelector = #value ] ]. - - targetContext := scdbg context sender. - scdbg stepOver. - - self assert: scdbg context identicalTo: targetContext. - self assert: scdbg topStack equals: 42. - - scdbg := SindarinDebugger debug: [ self helperMethodNonLocalReturn ]. - - scdbg - step; - skip. - - self assert: scdbg topStack isNil. - - scdbg stepUntil: [ - scdbg node isMessage and: [ scdbg messageSelector = #value ] ]. - - targetContext := scdbg context. - - scdbg stepOver. - - self assert: scdbg context identicalTo: targetContext. - self assert: scdbg topStack equals: 43 -] - { #category : #'tests - skipping' } SindarinDebuggerTest >> testSkipThroughNode [ | dbg realExecPC realValueOfA targetExecNode realExecTopStack nodeAfterSkipThrough | @@ -766,6 +846,45 @@ SindarinDebuggerTest >> testSkipToPC [ self assert: dbg topStack equals: realExecTopStack ] +{ #category : #tests } +SindarinDebuggerTest >> testSkipToPcDoesNotLoopWhenAimedPcIsAfterEndPc [ + + | sdbg aimedPc pcBeforeSkip | + sdbg := SindarinDebugger debug: [ + self helperMethodWithSeveralInstructionsInBlock ]. + sdbg + step; + stepOver. + + sdbg stepOver. + pcBeforeSkip := sdbg pc. + aimedPc := sdbg context endPC + 1. + + sdbg skipToPC: aimedPc. + + self assert: sdbg pc equals: sdbg context endPC. +] + +{ #category : #tests } +SindarinDebuggerTest >> testSkipToPcDoesNotLoopWhenAimedPcIsBeforeCurrentPc [ + + | sdbg aimedPc pcBeforeSkip | + sdbg := SindarinDebugger debug: [ + self helperMethodWithSeveralInstructionsInBlock ]. + sdbg + step; + stepOver. + + aimedPc := sdbg pc. + + sdbg stepOver. + pcBeforeSkip := sdbg pc. + + sdbg skipToPC: aimedPc. + + self assert: sdbg pc equals: pcBeforeSkip. +] + { #category : #'tests - skipping' } SindarinDebuggerTest >> testSkipUpToNode [ | dbg realExecPC realValueOfA realExecNode realExecTopStack | @@ -789,8 +908,74 @@ SindarinDebuggerTest >> testSkipUpToNode [ self assert: dbg topStack equals: realExecTopStack ] +{ #category : #tests } +SindarinDebuggerTest >> testSkipUpToNodeDoesNotLoopWhenAimedNodeIsBeforeCurrentNode [ + + | sdbg aimedNode nodeBeforeSkip | + sdbg := SindarinDebugger debug: [ + self helperMethodWithSeveralInstructionsInBlock ]. + sdbg + step; + stepOver. + + aimedNode := sdbg node. + sdbg stepOver. + nodeBeforeSkip := sdbg node. + + sdbg skipUpToNode: aimedNode. + + self assert: sdbg node identicalTo: nodeBeforeSkip +] + +{ #category : #'tests - skipping' } +SindarinDebuggerTest >> testSkipUpToNodeInEvaluatedBlock [ + + | dbg realExecPC realExecNode realExecTopStack oldValueOfA valueOfBAfterSkipAndStep | + self skipOnPharoCITestingEnvironment. + dbg := SindarinDebugger debug: [ self helperMethodWithEvaluatedBlock ]. + "after stepping, we stop at the beginning of the block" + dbg + step; + step; + stepOver; + stepOver; + stepOver; + stepThrough. + oldValueOfA := dbg temporaryNamed: #a. + "after stepping, we stop on b: = 3 + 2 assignment node" + dbg stepOver. + + self assert: dbg node isMessage. + valueOfBAfterSkipAndStep := dbg node receiver value. + + dbg stepOver. + + realExecPC := dbg pc. + realExecNode := dbg node. + realExecTopStack := dbg topStack. + + dbg := SindarinDebugger debug: [ self helperMethodWithEvaluatedBlock ]. + + dbg + step; + step; + stepOver; + stepOver; + stepOver; + stepThrough; + skipUpToNode: realExecNode. + self assert: dbg pc equals: realExecPC. + self assert: dbg node identicalTo: realExecNode. + self assert: (dbg temporaryNamed: #a) equals: oldValueOfA. + self assert: dbg topStack equals: valueOfBAfterSkipAndStep. + + dbg stepOver. + "3 is on the stack so stepping over the assignment should put 3 into b" + self assert: (dbg temporaryNamed: #b) equals: valueOfBAfterSkipAndStep +] + { #category : #helpers } -SindarinDebuggerTest >> testSkipUpToNodeStopsOnImplicitReturn [ +SindarinDebuggerTest >> testSkipUpToNodeStopsOnImplicitReturnIfAimedNodeCanStillBeExecuted [ | scdbg implicitReturnPc implicitReturnNode realExecPc realExecNode | scdbg := SindarinDebugger debug: [ @@ -821,8 +1006,11 @@ SindarinDebuggerTest >> testSkipUpToNodeStopsOnImplicitReturn [ stepOver; stepOver; stepOver; - stepThrough; - skipUpToNode: realExecNode. + stepThrough. + + self assert: (scdbg canStillExecute: realExecNode). + + scdbg skipUpToNode: realExecNode. self assert: scdbg pc equals: implicitReturnPc. self assert: scdbg node identicalTo: implicitReturnNode diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index f578215..3ccec11 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -121,6 +121,25 @@ SindarinDebugger >> bestNodeFor: anInterval [ ^self node methodNode bestNodeFor: anInterval ] +{ #category : #'ast manipulation' } +SindarinDebugger >> canStillExecute: aProgramNode [ + + "returns true if the last pc mapped to aProgramNode is greater than `self pc` in the right context " + + | lastPcForNode rightContext | + rightContext := self context. + + [ + rightContext == rightContext outerMostContext or: [ + rightContext method ast allChildren identityIncludes: aProgramNode ] ] + whileFalse: [ rightContext := rightContext sender ]. + + lastPcForNode := (rightContext method ast lastPcForNode: aProgramNode) + ifNil: [ 0 ]. + + ^ rightContext pc < lastPcForNode +] + { #category : #stackAccess } SindarinDebugger >> context [ "Returns a reification of the current stack-frame." @@ -360,6 +379,12 @@ SindarinDebugger >> method [ ^ self context method ] +{ #category : #accessing } +SindarinDebugger >> methodNode [ + + ^ self method ast +] + { #category : #'accessing - bytes' } SindarinDebugger >> nextBytecode [ @@ -636,8 +661,12 @@ SindarinDebugger >> skipThroughNode: aProgramNode [ { #category : #'stepping - skip' } SindarinDebugger >> skipToPC: aPC [ + "Skips execution until program counter reaches aPC." - [ self pc >= aPC ] whileFalse: [ self skip ] + + [ [ self pc >= aPC ] whileFalse: [ self skip ] ] + on: SindarinSkippingReturnWarning + do: [ ^ self ] ] { #category : #'stepping - skip' } @@ -650,12 +679,16 @@ SindarinDebugger >> skipUpToNode: aProgramNode [ { #category : #'stepping - skip' } SindarinDebugger >> skipUpToNode: aProgramNode skipTargetNode: skipTargetNode [ - "Skips execution until program counter reaches aProgramNode." - [ [ self node == aProgramNode ] whileFalse: [ self skip ] ] - on: SindarinSkippingReturnWarning + "Skips execution until program counter reaches aProgramNode." + [ + [ + self node ~~ aProgramNode and: [ + self canStillExecute: aProgramNode ] ] whileTrue: [ + self skip ] ] + on: SindarinSkippingReturnWarning do: [ ^ self ]. - aProgramNode isReturn ifTrue: [ ^ self ]. + aProgramNode isReturn ifTrue: [ ^ self ]. skipTargetNode ifTrue: [ self skip ] ]