>From ebefacc617873eb5383ab4254e3c54d2523d61a4 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
Date: Tue, 29 Oct 2013 10:01:03 +0100
Subject: [PATCH] DebugTools, MiniDebugger and GtkDebugger can eval expression
while debugging. Arguments and temporaries names can be used thanks to the
debug informations.
---
packages/debug/ChangeLog | 8 ++
packages/debug/DebugTools.st | 119 +++++++++++++++++++++++++++++
packages/debug/debugger/ChangeLog | 4 +
packages/debug/debugger/MiniDebugger.st | 5 ++
packages/debug/debugtests.st | 29 ++++++-
packages/debug/maybe/Just.st | 45 +++++++++++
packages/debug/maybe/Maybe.st | 83 ++++++++++++++++++++
packages/debug/maybe/Nothing.st | 45 +++++++++++
packages/debug/package.xml | 3 +
packages/visualgst/ChangeLog | 4 +
packages/visualgst/Debugger/GtkDebugger.st | 16 +++-
11 files changed, 356 insertions(+), 5 deletions(-)
create mode 100644 packages/debug/maybe/Just.st
create mode 100644 packages/debug/maybe/Maybe.st
create mode 100644 packages/debug/maybe/Nothing.st
diff --git a/packages/debug/ChangeLog b/packages/debug/ChangeLog
index b660c9a..55bd1a1 100644
--- a/packages/debug/ChangeLog
+++ b/packages/debug/ChangeLog
@@ -1,3 +1,11 @@
+2013-10-21 Gwenael Casaccio
+
+ * DebugTools.st: Add >>#eval: allowing evaluation of code with the current context temps and args names.
+ * maybe/Maybe.st: Maybe monad pattern.
+ * maybe/Just.st: Maybe monad pattern.
+ * maybe/Nothing.st: Maybe monad pattern.
+ * debugtests.st: Add test for >>#eval:.
+
2013-10-15 Gwenael Casaccio
* debugtests.st: Add test for currentLineInFile.
diff --git a/packages/debug/DebugTools.st b/packages/debug/DebugTools.st
index b2c7b65..727e214 100644
--- a/packages/debug/DebugTools.st
+++ b/packages/debug/DebugTools.st
@@ -280,6 +280,125 @@ pointer bytecodes to line numbers.'>
theDebugProcess primTerminate
]
+ eval: aString [
+
+
+ | context selectorAndArguments stream method result |
+ context := self suspendedContext.
+
+ selectorAndArguments := Dictionary new.
+ stream := WriteStream on: String new.
+
+ (context isBlock and: [ context outerContext isNil not ]) ifTrue: [ self extractSelectorAndArgumentsFrom: context outerContext to: selectorAndArguments ].
+ self extractSelectorAndArgumentsFrom: context to: selectorAndArguments.
+ self buildSelectorAndArgs: selectorAndArguments to: stream.
+ self buildCode: aString withArgs: selectorAndArguments keys to: stream.
+ ^ (self compile: stream contents to: self receiver)
+ ifError: [ :fname :lineNo :errorString | stream contents printNl. (' error : ', errorString) displayNl ]
+ ifSucceed: [ :method | self perform: method selector to: self receiver with: (self extractArgsFrom: selectorAndArguments) ].
+ ]
+
+ extractArgsFrom: aDictionary [
+
+
+ | array i |
+ i := 1.
+ array := Array new: aDictionary size.
+
+ aDictionary keys do: [ :each |
+ array at: i put: (aDictionary at: each).
+ i := i + 1 ].
+
+ ^ array
+ ]
+
+ extractSelectorAndArgumentsFrom: aContext to: aDictionary [
+
+
+ | i |
+ i := 1.
+
+ aContext method arguments do: [ :each |
+ aDictionary at: each put: (aContext at: i).
+ i := i + 1 ].
+ aContext method temporaries do: [ :each |
+ aDictionary at: each put: (aContext at: i).
+ i := i + 1 ]
+ ]
+
+ buildSelectorAndArgs: aDictionary to: aStream [
+
+
+ | i |
+ i := 1.
+ aDictionary isEmpty ifTrue: [ ^ aStream nextPutAll: 'DoIt'; space ].
+ aDictionary keys do: [ :each |
+ aStream
+ nextPutAll: 'arg_';
+ nextPutAll: i asString;
+ nextPutAll: ': ';
+ nextPutAll: #xxx_;
+ nextPutAll: each;
+ space.
+ i := i + 1 ].
+ ]
+
+ buildCode: aString withArgs: anArray to: aStream [
+
+
+ aStream
+ nextPutAll: '[';
+ nl;
+ nextPutAll: '| '.
+ anArray do: [ :each |
+ aStream
+ nextPutAll: each;
+ space ].
+ aStream
+ nextPutAll: '|';
+ nl.
+ anArray do: [ :each |
+ aStream
+ nextPutAll: each;
+ nextPutAll: ' := ';
+ nextPutAll: #xxx_;
+ nextPutAll: each;
+ nextPutAll: '.';
+ nl ].
+ aStream
+ nextPutAll: ' ^ [ ';
+ nl;
+ nextPutAll: aString;
+ nl;
+ nextPutAll: ' ] value';
+ nl;
+ nextPutAll: ']'.
+ ]
+
+ compile: aString to: anObject [
+
+
+ ^ Just value:
+ (anObject class
+ compile: aString
+ ifError: [ :fname :lineNo :errorString | ^ Nothing value: fname value: lineNo value: errorString ])
+ ]
+
+ perform: aSelector to: anObject with: anArray [
+
+
+ | sem result |
+ sem := Semaphore new.
+ [ [ result := anObject perform: aSelector withArguments: anArray ]
+ receiver: nil;
+ ensure: [ sem signal ] ]
+ receiver: nil;
+ fork.
+ sem wait.
+ anObject class removeSelector: aSelector ifAbsent: [].
+ ^ result
+ ]
+
disableBreakpointContext [
"Remove the context inserted set by #finish:."
diff --git a/packages/debug/debugger/ChangeLog b/packages/debug/debugger/ChangeLog
index 9fa2cb5..443fc82 100644
--- a/packages/debug/debugger/ChangeLog
+++ b/packages/debug/debugger/ChangeLog
@@ -1,3 +1,7 @@
+2013-10-01 Gwenael Casaccio
+
+ * MiniDebugger.st: Use the debugger #eval: message.
+
2013-08-20 Gwenael Casaccio
* MiniDebugger.st: Add new command for printing context state.
diff --git a/packages/debug/debugger/MiniDebugger.st b/packages/debug/debugger/MiniDebugger.st
index 078e746..3bfae61 100644
--- a/packages/debug/debugger/MiniDebugger.st
+++ b/packages/debug/debugger/MiniDebugger.st
@@ -374,5 +374,10 @@ Other commands:
' ' display.
each printNl ] ]
]
+
+ eval: line to: anObject [
+
+ (debugger eval: line) displayNl
+ ]
]
diff --git a/packages/debug/debugtests.st b/packages/debug/debugtests.st
index c306047..5f2112f 100644
--- a/packages/debug/debugtests.st
+++ b/packages/debug/debugtests.st
@@ -60,7 +60,7 @@ SmallInteger extend [
]
]
-^L
+
TestCase subclass: DebuggerTest [
@@ -309,6 +309,33 @@ TestCase subclass: DebuggerTest [
]
]
+ testEvaluation [
+ " Test that #eval gives the good states "
+
+
+
+ | debugger i j k |
+ i := 312.
+ j := 412.
+ k := 512.
+
+ debugger := self debuggerOn: [ | x y z |
+ x := 1.
+ y := x * 2.
+ z := y * 2.
+ i yourself ].
+
+ debugger step; step; step.
+
+ self assert: (debugger eval: '^ i') = 312.
+ self assert: (debugger eval: '^ j') = 412.
+ self assert: (debugger eval: '^ k') = 512.
+
+ self assert: (debugger eval: '^ x') = 1.
+ self assert: (debugger eval: '^ y') = 2.
+ self assert: (debugger eval: '^ z') = 4.
+ ]
+
w [
self x: [:foo | ^foo]
diff --git a/packages/debug/maybe/Just.st b/packages/debug/maybe/Just.st
new file mode 100644
index 0000000..f35ac4a
--- /dev/null
+++ b/packages/debug/maybe/Just.st
@@ -0,0 +1,45 @@
+"======================================================================
+|
+| Just class declaration
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2013 Free Software Foundation, Inc.
+| Written by Gwenael Casaccio.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+Maybe subclass: Just [
+
+ ifSucceed: aBlock [
+
+ ^ aBlock valueWithArguments: values
+ ]
+
+ ifError: aBlock [
+ ]
+
+ ifError: unusedBlock ifSucceed: aBlock [
+
+ ^ aBlock valueWithArguments: values
+ ]
+]
+
diff --git a/packages/debug/maybe/Maybe.st b/packages/debug/maybe/Maybe.st
new file mode 100644
index 0000000..72946fc
--- /dev/null
+++ b/packages/debug/maybe/Maybe.st
@@ -0,0 +1,83 @@
+"======================================================================
+|
+| Maybe class declaration
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2013 Free Software Foundation, Inc.
+| Written by Gwenael Casaccio.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+Object subclass: Maybe [
+
+ Maybe class >> value: anObject [
+
+ ^ self new
+ value: anObject;
+ yourself
+ ]
+
+ Maybe class >> value: anObject1 value: anObject2 [
+
+ ^ self new
+ value: anObject1 value: anObject2;
+ yourself
+ ]
+
+ Maybe class >> value: anObject1 value: anObject2 value: anObject3 [
+
+ ^ self new
+ value: anObject1 value: anObject2 value: anObject3;
+ yourself
+ ]
+
+ | values |
+
+
+ value: anObject [
+
+
+ values := Array with: anObject.
+ ]
+
+ value: anObject1 value: anObject2 [
+
+
+ values := Array with: anObject1 with: anObject2.
+ ]
+
+ value: anObject1 value: anObject2 value: anObject3 [
+
+
+ values := Array with: anObject1 with: anObject2 with: anObject3.
+ ]
+
+ ifSucceed: aBlock [
+ ]
+
+ ifError: aBlock [
+ ]
+
+ ifError: unusedBlock ifSucceed: aBlock [
+ ]
+]
+
diff --git a/packages/debug/maybe/Nothing.st b/packages/debug/maybe/Nothing.st
new file mode 100644
index 0000000..43ce3e3
--- /dev/null
+++ b/packages/debug/maybe/Nothing.st
@@ -0,0 +1,45 @@
+"======================================================================
+|
+| Nothing class declaration
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2013 Free Software Foundation, Inc.
+| Written by Gwenael Casaccio.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+Maybe subclass: Nothing [
+
+ ifSucceed: aBlock [
+ ]
+
+ ifError: aBlock [
+
+ ^ aBlock valueWithArguments: values
+ ]
+
+ ifError: aBlock ifSucceed: unusedBlock [
+
+ ^ aBlock valueWithArguments: values
+ ]
+]
+
diff --git a/packages/debug/package.xml b/packages/debug/package.xml
index 6f38685..dea8515 100644
--- a/packages/debug/package.xml
+++ b/packages/debug/package.xml
@@ -7,6 +7,9 @@
Extensions.st
+ maybe/Maybe.st
+ maybe/Nothing.st
+ maybe/Just.st
DebuggerReentered.st
DebugTools.st
ChangeLog
diff --git a/packages/visualgst/ChangeLog b/packages/visualgst/ChangeLog
index e092284..3b43a5f 100644
--- a/packages/visualgst/ChangeLog
+++ b/packages/visualgst/ChangeLog
@@ -1,3 +1,7 @@
+2013-10-21 Gwenael Casaccio
+
+ * Debugger/GtkDebugger.st: Eval code in the debugger.
+
2013-10-18 Gwenael Casaccio
* Commands/DebugMenus/ContinueDebugCommand.st : Update command title and target.
diff --git a/packages/visualgst/Debugger/GtkDebugger.st b/packages/visualgst/Debugger/GtkDebugger.st
index 3d8169c..f0fb969 100644
--- a/packages/visualgst/Debugger/GtkDebugger.st
+++ b/packages/visualgst/Debugger/GtkDebugger.st
@@ -373,25 +373,33 @@ GtkBrowsingTool subclass: GtkDebugger [
doIt: object [
- self focusedWidget doIt: object
+ codeWidget hasFocus ifFalse: [ ^ self focusedWidget doIt: object ].
+ codeWidget hasSelection ifFalse: [ ^ self ].
+ debugger eval: codeWidget selectedText.
]
debugIt: object [
- self focusedWidget debugIt: object
+ codeWidget hasFocus ifFalse: [ ^ self focusedWidget debugIt: object ].
+ codeWidget hasSelection ifFalse: [ ^ self ].
+ debugger eval: 'VisualGST.GtkDebugger open doItProcess: [ ', codeWidget selectedText, ' ] newProcess'
]
inspectIt: object [
- self focusedWidget inspectIt: object
+ codeWidget hasFocus ifFalse: [ ^ self focusedWidget inspectIt: object ].
+ codeWidget hasSelection ifFalse: [ ^ self ].
+ (debugger eval: codeWidget selectedText) gtkInspect.
]
printIt: object [
- self focusedWidget printIt: object
+ codeWidget hasFocus ifFalse: [ ^ self focusedWidget printIt: object ].
+ codeWidget hasSelection ifFalse: [ ^ self ].
+ codeWidget printString: (debugger eval: codeWidget selectedText).
]
state [
--
1.8.3.2