ASTDebuggerTest

src/Compiler-Interpreter.js

@@ -1076,7 +1076,7 @@ globals.ASTContextVar);
 
 
 
-smalltalk.addClass('ASTDebugger', globals.Object, ['interpreter', 'context'], 'Compiler-Interpreter');
+smalltalk.addClass('ASTDebugger', globals.Object, ['interpreter', 'context', 'result'], 'Compiler-Interpreter');
 globals.ASTDebugger.comment="I am a stepping debugger interface for Amber code.\x0aI internally use an instance of `ASTInterpreter` to actually step through node and interpret them.\x0a\x0aMy instances are created from an `AIContext` with `ASTDebugger class >> context:`.\x0aThey hold an `AIContext` instance internally, recursive copy of the `MethodContext`.\x0a\x0a## API\x0a\x0aUse the methods of the `'stepping'` protocol to do stepping.";
 smalltalk.addMethod(
 smalltalk.method({
@@ -1254,30 +1254,35 @@ protocol: 'private',
 fn: function (){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
-var $2,$1,$3,$4,$receiver;
-$2=self._interpreter();
+var $1,$3,$2,$4,$6,$5,$receiver;
+$1=self._interpreter();
 $ctx1.sendIdx["interpreter"]=1;
-$1=_st($2)._atEnd();
+self["@result"]=_st($1)._result();
+$3=self._interpreter();
+$ctx1.sendIdx["interpreter"]=2;
+$2=_st($3)._atEnd();
 $ctx1.sendIdx["atEnd"]=1;
-if(smalltalk.assert($1)){
-$3=_st(self._context())._outerContext();
-if(($receiver = $3) == nil || $receiver == null){
-$3;
+if(smalltalk.assert($2)){
+$4=_st(self._context())._outerContext();
+if(($receiver = $4) == nil || $receiver == null){
+$4;
 } else {
 var outerContext;
 outerContext=$receiver;
 self._context_(outerContext);
 };
-$4=self._atEnd();
-if(! smalltalk.assert($4)){
+$6=self._interpreter();
+$ctx1.sendIdx["interpreter"]=3;
+$5=_st($6)._atEnd();
+if(! smalltalk.assert($5)){
 _st(self._interpreter())._skip();
 };
 };
 self._flushInnerContexts();
 return self}, function($ctx1) {$ctx1.fill(self,"onStep",{},globals.ASTDebugger)})},
 args: [],
-source: "onStep\x0a\x09\x22After each step, check if the interpreter is at the end,\x0a\x09and if it is move to its outer context if any, skipping its \x0a\x09current node (which was just evaluated by the current \x0a\x09interpreter).\x0a\x09\x0a\x09After each step we also flush inner contexts.\x22\x0a\x09\x0a\x09self interpreter atEnd ifTrue: [\x0a\x09\x09self context outerContext ifNotNil: [ :outerContext | \x0a\x09\x09\x09self context: outerContext ].\x0a\x09\x09self atEnd ifFalse: [ self interpreter skip ] ].\x0a\x09\x09\x0a\x09self flushInnerContexts",
-messageSends: ["ifTrue:", "atEnd", "interpreter", "ifNotNil:", "outerContext", "context", "context:", "ifFalse:", "skip", "flushInnerContexts"],
+source: "onStep\x0a\x09\x22After each step, check if the interpreter is at the end,\x0a\x09and if it is move to its outer context if any, skipping its \x0a\x09current node (which was just evaluated by the current \x0a\x09interpreter).\x0a\x09\x0a\x09After each step we also flush inner contexts.\x22\x0a\x09\x0a\x09result := self interpreter result.\x0a\x09\x0a\x09self interpreter atEnd ifTrue: [\x0a\x09\x09self context outerContext ifNotNil: [ :outerContext | \x0a\x09\x09\x09self context: outerContext ].\x0a\x09\x09self interpreter atEnd ifFalse: [ self interpreter skip ] ].\x0a\x09\x09\x0a\x09self flushInnerContexts",
+messageSends: ["result", "interpreter", "ifTrue:", "atEnd", "ifNotNil:", "outerContext", "context", "context:", "ifFalse:", "skip", "flushInnerContexts"],
 referencedClasses: []
 }),
 globals.ASTDebugger);
@@ -1321,6 +1326,23 @@ referencedClasses: []
 }),
 globals.ASTDebugger);
 
+smalltalk.addMethod(
+smalltalk.method({
+selector: "result",
+protocol: 'accessing',
+fn: function (){
+var self=this;
+var $1;
+$1=self["@result"];
+return $1;
+},
+args: [],
+source: "result\x0a\x09^ result",
+messageSends: [],
+referencedClasses: []
+}),
+globals.ASTDebugger);
+
 smalltalk.addMethod(
 smalltalk.method({
 selector: "stepInto",

src/Compiler-Interpreter.st

@@ -361,7 +361,7 @@ context: anObject
 ! !
 
 Object subclass: #ASTDebugger
-	instanceVariableNames: 'interpreter context'
+	instanceVariableNames: 'interpreter context result'
 	package: 'Compiler-Interpreter'!
 !ASTDebugger commentStamp!
 I am a stepping debugger interface for Amber code.
@@ -400,6 +400,10 @@ nextNode
 node
 	^ self interpreter ifNotNil: [
 		self interpreter node ]
+!
+
+result
+	^ result
 ! !
 
 !ASTDebugger methodsFor: 'private'!
@@ -420,10 +424,12 @@ onStep
 	
 	After each step we also flush inner contexts."
 	
+	result := self interpreter result.
+	
 	self interpreter atEnd ifTrue: [
 		self context outerContext ifNotNil: [ :outerContext | 
 			self context: outerContext ].
-		self atEnd ifFalse: [ self interpreter skip ] ].
+		self interpreter atEnd ifFalse: [ self interpreter skip ] ].
 		
 	self flushInnerContexts
 ! !

src/Compiler-Tests.js

@@ -1263,6 +1263,50 @@ globals.InterpreterTest);
 
 
 
+smalltalk.addClass('ASTDebuggerTest', globals.InterpreterTest, [], 'Compiler-Tests');
+smalltalk.addMethod(
+smalltalk.method({
+selector: "interpret:receiver:withArguments:",
+protocol: 'private',
+fn: function (aString,anObject,aDictionary){
+var self=this;
+var ctx,debugger_;
+function $AIContext(){return globals.AIContext||(typeof AIContext=="undefined"?nil:AIContext)}
+function $ASTInterpreter(){return globals.ASTInterpreter||(typeof ASTInterpreter=="undefined"?nil:ASTInterpreter)}
+function $ASTDebugger(){return globals.ASTDebugger||(typeof ASTDebugger=="undefined"?nil:ASTDebugger)}
+return smalltalk.withContext(function($ctx1) { 
+var $1,$2,$3,$5,$6,$4;
+$1=_st($AIContext())._new();
+$ctx1.sendIdx["new"]=1;
+_st($1)._receiver_(anObject);
+_st($1)._interpreter_(_st($ASTInterpreter())._new());
+$2=_st($1)._yourself();
+ctx=$2;
+_st(aDictionary)._keysAndValuesDo_((function(key,value){
+return smalltalk.withContext(function($ctx2) {
+return _st(ctx)._localAt_put_(key,value);
+}, function($ctx2) {$ctx2.fillBlock({key:key,value:value},$ctx1,1)})}));
+$3=_st(ctx)._interpreter();
+$ctx1.sendIdx["interpreter"]=1;
+_st($3)._context_(ctx);
+$ctx1.sendIdx["context:"]=1;
+_st(_st(ctx)._interpreter())._node_(_st(self._parse_forClass_(aString,_st(anObject)._class()))._nextChild());
+debugger_=_st($ASTDebugger())._context_(ctx);
+$5=debugger_;
+_st($5)._proceed();
+$6=_st($5)._result();
+$4=$6;
+return $4;
+}, function($ctx1) {$ctx1.fill(self,"interpret:receiver:withArguments:",{aString:aString,anObject:anObject,aDictionary:aDictionary,ctx:ctx,debugger_:debugger_},globals.ASTDebuggerTest)})},
+args: ["aString", "anObject", "aDictionary"],
+source: "interpret: aString receiver: anObject withArguments: aDictionary\x0a\x09| ctx debugger |\x0a\x09\x0a\x09ctx := AIContext new\x0a\x09\x09receiver: anObject;\x0a\x09\x09interpreter: ASTInterpreter new;\x0a\x09\x09yourself.\x0a\x09aDictionary keysAndValuesDo: [ :key :value |\x0a\x09\x09ctx localAt: key put: value ].\x0a\x09ctx interpreter context: ctx.\x0a\x09\x0a\x09ctx interpreter node: (self parse: aString forClass: anObject class) nextChild.\x0a\x09\x0a\x09debugger := ASTDebugger context: ctx.\x0a\x09\x0a\x09^ debugger \x0a\x09\x09proceed; \x0a\x09\x09result",
+messageSends: ["receiver:", "new", "interpreter:", "yourself", "keysAndValuesDo:", "localAt:put:", "context:", "interpreter", "node:", "nextChild", "parse:forClass:", "class", "proceed", "result"],
+referencedClasses: ["AIContext", "ASTInterpreter", "ASTDebugger"]
+}),
+globals.ASTDebuggerTest);
+
+
+
 smalltalk.addClass('ScopeVarTest', globals.TestCase, [], 'Compiler-Tests');
 smalltalk.addMethod(
 smalltalk.method({

src/Compiler-Tests.st

@@ -513,6 +513,32 @@ should: aString return: anObject
 		return: anObject
 ! !
 
+InterpreterTest subclass: #ASTDebuggerTest
+	instanceVariableNames: ''
+	package: 'Compiler-Tests'!
+
+!ASTDebuggerTest methodsFor: 'private'!
+
+interpret: aString receiver: anObject withArguments: aDictionary
+	| ctx debugger |
+	
+	ctx := AIContext new
+		receiver: anObject;
+		interpreter: ASTInterpreter new;
+		yourself.
+	aDictionary keysAndValuesDo: [ :key :value |
+		ctx localAt: key put: value ].
+	ctx interpreter context: ctx.
+	
+	ctx interpreter node: (self parse: aString forClass: anObject class) nextChild.
+	
+	debugger := ASTDebugger context: ctx.
+	
+	^ debugger 
+		proceed; 
+		result
+! !
+
 TestCase subclass: #ScopeVarTest
 	instanceVariableNames: ''
 	package: 'Compiler-Tests'!