On 24/10/2013 07:47, Holger Hans Peter Freyther wrote:
On Mon, Oct 21, 2013 at 10:17:33AM +0200, Gwenaël Casaccio wrote:
Hi,
The patch allows code evaluation while debugging and
allows to use the temps and the args name in the evaluated
code.
lovely! the debugger is getting more and more usable and showing
the power of Smalltalk/GST.
inspectIt: object [
<category: 'smalltalk event'>
- self focusedWidget inspectIt: object
+ codeWidget hasFocus ifFalse: [ ^ self focusedWidget inspectIt: object
].
+ codeWidget hasSelection ifFalse: [ ^ self ].
+ (debugger eval: codeWidget selectedText) gtkInspect.
something is not right. E.g. when I don't have anything selected
in the code widget and no blinking cursor but the variable in
"variables" is selected and I press CTRL+I I would want the inspector
to popup on the variable but somehow I get an inspector with
Behavior.
Can you reproduce this? My example is the '1234' do: [:each | ]
again.
holger
Hi,
here is a new version of the patch the difference is that evaluated code is
done in an other process and without any references to the debugger
(the receiver of the closures is set to nil) otherwhise the exception
handler
while doing a debuger class lookup will be nil.
Cheers,
Gwen
>From ebefacc617873eb5383ab4254e3c54d2523d61a4 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio <mrg...@gmail.com>
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 <gwenael.casac...@gmail.com>
+
+ * 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 <gwenael.casac...@gmail.com>
* 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 [
+ <category: 'evaluation'>
+
+ | 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 [
+ <category: 'private'>
+
+ | 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 [
+ <category: 'private'>
+
+ | 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 [
+ <category: 'private'>
+
+ | 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 [
+ <category: 'private'>
+
+ 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 [
+ <category: 'private'>
+
+ ^ Just value:
+ (anObject class
+ compile: aString
+ ifError: [ :fname :lineNo :errorString | ^ Nothing value: fname value: lineNo value: errorString ])
+ ]
+
+ perform: aSelector to: anObject with: anArray [
+ <category: 'private'>
+
+ | 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 <gwenael.casac...@gmail.com>
+
+ * MiniDebugger.st: Use the debugger #eval: message.
+
2013-08-20 Gwenael Casaccio <gwenael.casac...@gmail.com>
* 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 [
<comment: nil>
@@ -309,6 +309,33 @@ TestCase subclass: DebuggerTest [
]
]
+ testEvaluation [
+ " Test that #eval gives the good states "
+
+ <category: 'test'>
+
+ | 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 [
<category: 'support'>
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 [
+ <category: 'initialization'>
+
+ values := Array with: anObject.
+ ]
+
+ value: anObject1 value: anObject2 [
+ <category: 'initialization'>
+
+ values := Array with: anObject1 with: anObject2.
+ ]
+
+ value: anObject1 value: anObject2 value: anObject3 [
+ <category: 'initialization'>
+
+ 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 @@
</test>
<filein>Extensions.st</filein>
+ <filein>maybe/Maybe.st</filein>
+ <filein>maybe/Nothing.st</filein>
+ <filein>maybe/Just.st</filein>
<filein>DebuggerReentered.st</filein>
<filein>DebugTools.st</filein>
<file>ChangeLog</file>
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 <gwenael.casac...@gmail.com>
+
+ * Debugger/GtkDebugger.st: Eval code in the debugger.
+
2013-10-18 Gwenael Casaccio <gwenael.casac...@gmail.com>
* 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 [
<category: 'smalltalk event'>
- self focusedWidget doIt: object
+ codeWidget hasFocus ifFalse: [ ^ self focusedWidget doIt: object ].
+ codeWidget hasSelection ifFalse: [ ^ self ].
+ debugger eval: codeWidget selectedText.
]
debugIt: object [
<category: 'smalltalk event'>
- 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 [
<category: 'smalltalk event'>
- self focusedWidget inspectIt: object
+ codeWidget hasFocus ifFalse: [ ^ self focusedWidget inspectIt: object ].
+ codeWidget hasSelection ifFalse: [ ^ self ].
+ (debugger eval: codeWidget selectedText) gtkInspect.
]
printIt: object [
<category: 'smalltalk event'>
- 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
_______________________________________________
help-smalltalk mailing list
help-smalltalk@gnu.org
https://lists.gnu.org/mailman/listinfo/help-smalltalk
