Fixing unitary skip command in Pharo 11

Sindarin-Tests/SindarinDebuggerTest.class.st

@@ -230,6 +230,15 @@ SindarinDebuggerTest >> helperMethodReturnWithHalt [
 	^ a + 1
 ]
 
+{ #category : #helpers }
+SindarinDebuggerTest >> helperMethodWithBlockWithNoReturn [
+
+	| block a |
+	block := [ a := 1 ].
+	block value.
+	^ 43
+]
+
 { #category : #running }
 SindarinDebuggerTest >> runCaseManaged [
 	^ self runCase
@@ -565,7 +574,146 @@ SindarinDebuggerTest >> testSkip [
 	self assert: a equals: 1.
 	scdbg skip.
 	scdbg step.
-	self assert: p equals: nil
+	self assert: p equals: Point
+]
+
+{ #category : #'tests - skipping' }
+SindarinDebuggerTest >> testSkipAssignmentWithStoreIntoBytecodePushesReplacementValueButNotWithPopIntoBytecode [
+
+	| a b dbg aFormerValue bFormerValue |
+	dbg := SindarinDebugger debug: [ 
+		       b := 1.
+		       [ 
+		       a := 2.
+		       a := b := 3 + 4 ] value.
+		       ^ 42 ].
+	dbg step.
+	dbg step.
+	dbg stepThrough. "we enter the block"
+
+	dbg skip. "we skip the assignment a:= 2"
+	self assert: dbg topStack equals: 4.
+	self assert: a equals: nil.
+
+	bFormerValue := b.
+	dbg step. dbg skip. "we skip the assignment b := 3 + 4"
+	self assert: dbg topStack equals: bFormerValue.
+	self assert: b equals: bFormerValue.
+
+	aFormerValue := a.
+	dbg skip. "we skip the assignment a:= (b := 3 + 4)"
+	self assert: dbg topStack equals: aFormerValue.
+	self assert: a equals: aFormerValue
+]
+
+{ #category : #tests }
+SindarinDebuggerTest >> testSkipSkipsMessagesByPuttingReceiverOnStack [
+
+	| a scdbg |
+ 	a := 1.
+ 	scdbg := SindarinDebugger
+ 		debug: [ a := a + 2 ].
+ 	self assert: a equals: 1.
+
+ 	scdbg skip.
+ 	scdbg step.
+
+ 	self assert: a equals: 1
+]
+
+{ #category : #tests }
+SindarinDebuggerTest >> testSkipSkipsSuperSendBytecodesCorrectly [
+
+	| a scdbg oldValueOfA negatedContext |
+	a := ScaledDecimal newFromNumber: 3 scale: 2.
+	scdbg := SindarinDebugger debug: [ a := a negated ].
+	oldValueOfA := a.
+
+	scdbg
+		step;
+		stepOver;
+		skip.
+	negatedContext := scdbg context.
+	scdbg stepUntil: [ scdbg context == negatedContext ].
+	scdbg stepOver.
+
+	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 [
+
+	| scdbg realExecNode realExecPc realTopStack |
+	scdbg := SindarinDebugger debug: [ 
+		         self helperMethodWithBlockWithNoReturn ].
+
+	scdbg step.
+	scdbg stepOver.
+
+	realExecNode := scdbg node.
+	realExecPc := scdbg pc.
+	realTopStack := scdbg topStack.
+
+	scdbg := SindarinDebugger debug: [ 
+		         self helperMethodWithBlockWithNoReturn ].
+
+	scdbg
+		step;
+		skip.
+
+	self assert: scdbg node identicalTo: realExecNode.
+	self assert: scdbg pc identicalTo: realExecPc.
+	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' }
@@ -592,7 +740,7 @@ SindarinDebuggerTest >> testSkipThroughNode [
 	self assert: realValueOfA equals: 5.
 	self assert: (dbg temporaryNamed: #a) equals: 1.
 	self assert: realExecTopStack equals: 3.
-	self assert: dbg topStack equals: nil
+	self assert: dbg topStack equals: '3'
 ]
 
 { #category : #'tests - skipping' }
@@ -641,6 +789,75 @@ SindarinDebuggerTest >> testSkipUpToNode [
 	self assert: dbg topStack equals: realExecTopStack
 ]
 
+{ #category : #helpers }
+SindarinDebuggerTest >> testSkipUpToNodeStopsOnImplicitReturn [
+
+	| scdbg implicitReturnPc implicitReturnNode realExecPc realExecNode |
+	scdbg := SindarinDebugger debug: [ 
+		         self helperMethodWithBlockWithNoReturn ].
+
+	scdbg
+		step;
+		stepOver;
+		stepOver;
+		stepOver;
+		stepThrough;
+		stepOver.
+
+	implicitReturnPc := scdbg pc.
+	implicitReturnNode := scdbg node.
+	scdbg stepOver.
+
+	realExecPc := scdbg pc.
+	realExecNode := scdbg node.
+
+	self assert: realExecPc ~= implicitReturnPc.
+
+	scdbg := SindarinDebugger debug: [ 
+		         self helperMethodWithBlockWithNoReturn ].
+
+	scdbg
+		step;
+		stepOver;
+		stepOver;
+		stepOver;
+		stepThrough;
+		skipUpToNode: realExecNode.
+
+	self assert: scdbg pc equals: implicitReturnPc.
+	self assert: scdbg node identicalTo: implicitReturnNode
+]
+
+{ #category : #helpers }
+SindarinDebuggerTest >> testSkipUpToNodeStopsOnReturnNodes [
+
+	| scdbg returnInBlock realExecNode |
+	scdbg := SindarinDebugger debug: [ self helperMethodNonLocalReturn ].
+
+
+	scdbg
+		step;
+		stepOver;
+		stepOver;
+		stepThrough.
+	returnInBlock := scdbg node.
+	realExecNode := scdbg node methodNode body statements last.
+
+	self assert: returnInBlock isReturn.
+	self assert: realExecNode isReturn.
+
+
+	scdbg := SindarinDebugger debug: [ self helperMethodNonLocalReturn ].
+	scdbg
+		step;
+		stepOver;
+		stepOver;
+		stepThrough;
+		skipUpToNode: realExecNode.
+
+	self assert: scdbg node identicalTo: returnInBlock
+]
+
 { #category : #'tests - skipping' }
 SindarinDebuggerTest >> testSkipWith [
 	| a p scdbg |
@@ -890,5 +1107,5 @@ SindarinDebuggerTest >> testskipUpToNodeSkipTargetNode [
 	returnNode := (self class >> #helperMethod1) ast statements last.
 	dbg step; skipThroughNode: returnNode.
 	self assert: dbg node equals: returnNode.
-	self assert: dbg topStack equals: nil
+	self assert: dbg topStack equals: Point
 ]

Sindarin/SindarinDebugger.class.st

@@ -360,6 +360,13 @@ SindarinDebugger >> method [
 	^ self context method
 ]
 
+{ #category : #'accessing - bytes' }
+SindarinDebugger >> nextBytecode [
+
+	^ self currentBytecode detect: [ :each | 
+		  each offset = self context pc ]
+]
+
 { #category : #astAndAstMapping }
 SindarinDebugger >> node [
 	"Returns the AST node about to be executed by the top context of the execution"
@@ -524,19 +531,40 @@ SindarinDebugger >> sindarinSession: aSindarinDebugSession [
 
 { #category : #'stepping -  skip' }
 SindarinDebugger >> skip [
+
+	| nextBytecode |
 	"If it is a message send or assignment, skips the execution of the current instruction, and puts nil on the execution stack."
-	self node isAssignment
-		ifTrue: [ ^ self skipAssignmentNodeCompletely ].
+	self node isAssignment ifTrue: [ ^ self skipAssignmentNodeCompletely ].
+  self node isMessage ifTrue: [ ^ self skipMessageNode ].
+  self node isMethod ifTrue: [ ^ self step ].
+  self node isBlock ifTrue: [ self skipBlockNode ].
+	nextBytecode := self currentBytecode detect: [ :each | 
+		                each offset = self pc ].
+	(self node isReturn or: [ 
+		 nextBytecode bytes first between: 88 and: 94 ]) ifTrue: [ 
+		^ self skipReturnNode ].
+	self node isSequence ifTrue: [ ^ self step ].
+
 	self skipWith: nil
 ]
 
 { #category : #'stepping -  skip' }
 SindarinDebugger >> skipAssignmentNodeCompletely [
 
+	| currentBytecode |
+	currentBytecode := self currentBytecode detect: [ :each | 
+		                   each offset = self context pc ].
+
+	"Pop the value that will be assigned"
 	self context pop.
-	"Pop the value to be assigned"
+
+	"If the assignment is a store bytecode and not a pop bytecode, we push the current value of the variable that was going to be assigned."
+	(#( 243 244 245 252 ) includes: currentBytecode bytes first) ifTrue: [ 
+		self context push:
+			(self node variable variableValueInContext: self context) ].
+
 	"Increase the pc to go over the assignment"
-	self context pc: (self context pc) + (self currentBytecode detect: [:each | each offset = self context pc ]) bytes size.
+	self context pc: self context pc + currentBytecode bytes size.
 	"Execute bytecodes the debugger usually executes without stopping the execution (for example popping the return value of the just executed message send if it is not used afterwards)"
 	self debugSession stepToFirstInterestingBytecodeIn:
 		self debugSession interruptedProcess
@@ -554,18 +582,48 @@ SindarinDebugger >> skipAssignmentNodeWith: replacementValue [
 		stepToFirstInterestingBytecodeIn: self debugSession interruptedProcess
 ]
 
+{ #category : #'stepping -  skip' }
+SindarinDebugger >> skipBlockNode [
+
+	| nextBytecode |
+	nextBytecode := self currentBytecode detect: [ :bytecode | bytecode offset = self pc ].
+
+	self context pc: self pc + nextBytecode bytes size.
+
+	self context push: nil
+]
+
+{ #category : #'stepping - skip' }
+SindarinDebugger >> skipMessageNode [
+
+	self node arguments do: [ :arg | self context pop ]. "Pop the arguments of the message send from the context's value stack"
+
+	"Increase the pc to go over the message send"
+	self context pc: self context pc + self nextBytecode bytes size.
+	"Execute bytecodes the debugger usually executes without stopping the execution (for example popping the return value of the just executed message send if it is not used afterwards)"
+	self debugSession stepToFirstInterestingBytecodeIn:
+		self debugSession interruptedProcess
+]
+
 { #category : #'stepping -  skip' }
 SindarinDebugger >> skipMessageNodeWith: replacementValue [
-	self node arguments do: [ :arg | self context pop ].	"Pop the arguments of the message send from the context's value stack"
+
+	self node arguments do: [ :arg | self context pop ]. "Pop the arguments of the message send from the context's value stack"
 	"Pop the receiver from the context's value stack"
 	self context pop.
 	"Push the replacement value on the context's value stack, to simulate that the message send happened and returned nil"
 	self context push: replacementValue.
 	"Increase the pc to go over the message send"
-	self context pc: self context pc + 1.
+	self context pc: self context pc + self nextBytecode bytes size.
 	"Execute bytecodes the debugger usually executes without stopping the execution (for example popping the return value of the just executed message send if it is not used afterwards)"
-	self debugSession
-		stepToFirstInterestingBytecodeIn: self debugSession interruptedProcess
+	self debugSession stepToFirstInterestingBytecodeIn:
+		self debugSession interruptedProcess
+]
+
+{ #category : #'stepping - skip' }
+SindarinDebugger >> skipReturnNode [
+
+	^ SindarinSkippingReturnWarning signal: 'Cannot skip a return node'
 ]
 
 { #category : #'stepping -  skip' }
@@ -594,7 +652,9 @@ SindarinDebugger >> skipUpToNode: aProgramNode [
 SindarinDebugger >> skipUpToNode: aProgramNode skipTargetNode: skipTargetNode [
 	"Skips execution until program counter reaches aProgramNode."
 
-	[ self node == aProgramNode ] whileFalse: [ self skip ].
+	[ [ self node == aProgramNode ] whileFalse: [ self skip ] ]
+		on: SindarinSkippingReturnWarning 
+		do: [ ^ self ].
 	aProgramNode isReturn	ifTrue: [ ^ self ].
 	skipTargetNode ifTrue: [ self skip ]
 ]

Sindarin/SindarinSkippingReturnWarning.class.st

@@ -0,0 +1,5 @@
+Class {
+	#name : #SindarinSkippingReturnWarning,
+	#superclass : #Warning,
+	#category : #Sindarin
+}