Hi, The patch allows code evaluation while debugging and allows to use the temps and the args name in the evaluated code.
Cheers, Gwen
>From 8e88190f7ed967277090250623a81cc6d0326d55 Mon Sep 17 00:00:00 2001 From: Gwenael Casaccio <[email protected]> Date: Mon, 21 Oct 2013 10:12:57 +0200 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 | 113 +++++++++++++++++++++++++++++ packages/debug/debugger/ChangeLog | 4 + packages/debug/debugger/MiniDebugger.st | 5 ++ packages/debug/debugtests.st | 27 +++++++ 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, 349 insertions(+), 4 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 <[email protected]> + + * 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 <[email protected]> * debugtests.st: Add test for currentLineInFile. diff --git a/packages/debug/DebugTools.st b/packages/debug/DebugTools.st index b2c7b65..1801c5c 100644 --- a/packages/debug/DebugTools.st +++ b/packages/debug/DebugTools.st @@ -280,6 +280,119 @@ 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'> + + | result | + [ result := anObject perform: aSelector withArguments: anArray ] valueWithUnwind. + 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 <[email protected]> + + * MiniDebugger.st: Use the debugger #eval: message. + 2013-08-20 Gwenael Casaccio <[email protected]> * 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..4ba1ada 100644 --- a/packages/debug/debugtests.st +++ b/packages/debug/debugtests.st @@ -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 <[email protected]> + + * Debugger/GtkDebugger.st: Eval code in the debugger. + 2013-10-18 Gwenael Casaccio <[email protected]> * 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 [email protected] https://lists.gnu.org/mailman/listinfo/help-smalltalk
