These facilities allow placing a break/trace on any method - even
primitives or methods of which no source code is available, can be
traced and/or breakpointed.
Also, the usual self halt
needs a recompilation of the inspected
method, while the facilities described below do not modify or recompile
any existing method. (thus leaving machine-code methods untouched -
instead of converting them into slower interpreted bytecode).
Finally, in contrast to placing a halt
into your methods,
breakpoints will not be reported in the "changes"
file.
Tracing is possible from both an instance or method viewpoint.
Currently, only trace and breakpoints on methods are supported by the user interface; other facilities have to be enabled "manually", by evaluating corresponding expressions in a workspace.
MessageTracer trap:anObject selector:aSelector
which arranges that the debugger is entered, whenever aSelector
is sent to anObject.
MessageTracer untrap:anObject selector:aSelector
or:
MessageTracer untrap:anObject
to remove all traps on anObject (if you have traps on other
selectors that you want to get rid of).
Example:
|p1 p2|
'creating points' printNL.
p1 := Point x:1 y:1. p2 := Point x:2 y:2.
'setting breakpoints' printNL.
MessageTracer trap:p1 selector:#size.
MessageTracer trap:p1 selector:#x:.
MessageTracer trap:p1 selector:#foo.
"p2 has no breakpoints set: - nothing happens"
'p2 size' printNL. p2 size printNL.
'p2 x:' printNL. p2 x:22.
"now let it trap ..."
'p1 size' printNL. p1 size printNL.
'p1 x:' printNL. p1 x:5.
'p1 foo' printNL. p1 foo.
'remove size-breakpoints' printNL.
MessageTracer untrap:p1 selector:#size.
"nothing happens now ..."
'p1 size' printNL. p1 size printNL.
"but here we trap again ..."
'p1 x:' printNL. p1 x:5.
'remove other breakpoints' printNL.
MessageTracer untrap:p1.
'p1 size' printNL. p1 size printNL.
'p1 x:' printNL. p1 x:5.
MessageTracer trace:anObject selector:aSelector
this arranges that a trace message is printed to the standard error output
(Stderr
),
both upon entry and exit to/from the method.
MessageTracer untrace:anObject selector:aSelector
or:
MessageTracer untrace:anObject
to remove all traces of anObject.
Example:
|p1 p2|
p1 := Point x:1 y:1.
p2 := Point x:2 y:2.
"set the tracepoints"
MessageTracer trace:p1 selector:#size.
MessageTracer trace:p1 selector:#x:.
'p2 size / p2 x:' errorPrintNL.
p2 size. p2 x:22.
'p1 size / p1 x:' errorPrintNL.
p1 size. p1 x:5.
'remove tracing of p1 size' errorPrintNL.
MessageTracer untrace:p1 selector:#size.
'p1 size / p1 x:' errorPrintNL.
p1 size. p1 x:5.
'remove tracing of p1' errorPrintNL.
MessageTracer untrace:p1.
'p1 size / p1 x:' errorPrintNL.
p1 size. p1 x:5.
MessageTracer traceSender:anObject selector:aSelector
arranges that the sender is output the standard error, whenever some message is sent.
Use untrace:selector:
or untrace
(as described above), to remove the trace.
|arr|
arr := #(1 2 3 4 5).
MessageTracer traceSender:arr selector:#at:.
arr collect:[:e | ]
in contrast to:
|arr|
arr := #(1 2 3 4 5).
MessageTracer trace:arr selector:#at:.
arr collect:[:e | ]
MessageTracer
wrap:anObject
selector:aSelector
onEntry:entryBlock
onExit:exitBlock
where anObject and aSelector are as above,
entryBlock is a one-argument block to be evaluated on entry into the method.
It will get the current context passed as argument.
This allows conditional breakpoints or conditional tracing.
It can also be used
to implement pre- and post conditions a la Eiffel while debugging.
For example, you want to trace any sent to an object with a specific argument,
use something like:
(in the above example, the first argument is checked for being greater than 5;
if so, the debugger is entered)
|p|
p := Point new.
MessageTracer wrap:p selector:#x:
onEntry:[:con |
(con args at:1) > 5 ifTrue:[
Debugger
enter:con
withMessage:'hit breakPoint; arg > 5'
]
]
onExit:nil.
p x:4. "nothing happens"
p x:-1. "nothing happens."
p x:10. "bummm"
Postcondition checking can be implemented with this mechanism.
For example if you want to
check the range of some instance variable after every send of some selector,
use:
(in the above, replace getInstVar by an appropriate access selector
for the instance variable to be checked)
MessageTracer
wrap:someObject
selector:someSelector
onEntry:nil
onExit:[:con :retVal |
(con receiver getInstVar between:min and:max) ifFalse:[
Debugger
enter:con
withMessage:'postcondition violated'
]
]
MessageTracer trapMethod:aMethod
this arranges that the debugger is entered, whenever aMethod
is about to be executed
(no matter, if for instances of the implementing class, or of any subclass).
The browser has a convenient menu function to set this kind of breakpoint, see below or the SystemBrowser documentation.
Example:
|p1 p2|
'creating points' printNL.
p1 := Point x:1 y:1.
p2 := Point x:2 y:2.
'setting breakpoints' printNL.
MessageTracer trapMethod:(Point compiledMethodAt:#printOn:).
MessageTracer trapMethod:(Point compiledMethodAt:#x:).
"all Points will trap"
'p2' printNL. p2 printNL.
'p2 x:' printNL. p2 x:22.
'p1' printNL. p1 printNL.
'p1 x:' printNL. p1 x:5.
'remove size-breakpoints' printNL.
MessageTracer untrapMethod:(Point compiledMethodAt:#printOn:).
"nothing happens now ..."
'p1' printNL. p1 printNL.
"but now ..."
'p1 x:' printNL. p1 x:5.
'remove other breakpoints' printNL.
MessageTracer untrapMethod:(Point compiledMethodAt:#x:).
'p1' printNL. p1 printNL.
'p1 x:' printNL. p1 x:5.
MessageTracer traceMethod:aMethod
Example:
MessageTracer traceMethod:(Integer compiledMethodAt:#factorial).
5 factorial.
MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
MessageTracer traceMethodSender:aMethod
Example:
MessageTracer traceMethodSender:(Integer compiledMethodAt:#factorial).
5 factorial.
MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)
MessageTracer
wrapMethod:aMethod
onEntry:entryBlock
onExit:exitBlock
Example 1: catching a specific factorial invocation:
cleanup with:
MessageTracer wrapMethod:(Integer compiledMethodAt:#factorial)
onEntry:[:con |
con receiver == 3 ifTrue:[
Debugger
enter:con
withMessage:'3 factorial encountered'
]
]
onExit:[:con :val |
'leaving ' errorPrint.
con errorPrint. ' -> ' errorPrint.
val errorPrintNL.
].
5 factorial.
Example 2: tracing file-open of specific files:
MessageTracer unwrapMethod:(Integer compiledMethodAt:#factorial)
cleanup with:
MessageTracer wrapMethod:(FileStream compiledMethodAt:#openWithMode:)
onEntry:[:con |
(con receiver pathName endsWith:'.st') ifTrue:[
'opening ' errorPrint.
con receiver pathName errorPrintNL
]
]
onExit:nil.
"now, play around with systembrowser (look at methods source-code)
or look at files with the filebrowser ...
And watch the output in the xterm window."
Example 3: traping access to a specific file:
MessageTracer unwrapMethod:(FileStream compiledMethodAt:#openWithMode:)
cleanup with:
MessageTracer wrapMethod:(FileStream compiledMethodAt:#openWithMode:)
onEntry:[:con |
(con receiver name = 'test') ifTrue:[
Debugger
enter:con
withMessage:'opening file named ''test'''
]
]
onExit:nil.
"now, create a file named 'test' with the filebrowser ..."
MessageTracer unwrapMethod:(FileStream compiledMethodAt:#openWithMode:)
For example, placing a trace on Context>>sender
will lead to this situation,
because that method is indirectly called by the trace-code.
Thus the process will run into recursion overflow problems, and start up
a debugger; this debugger itself will run into the same problem, since during
its startup, it reads the context chain using Context>>sender
.
Finally, ST/X's runtime system will kill the (lightweight) process.
If you are lucky, the system is in a condition to enter the
MiniDebugger.
In this case, try to repair things with:
MiniDebugger> I <- I-command; gets you into a
line-by-line expression evaluator
MessageTracer unwrapAllMethods <- remove all breakpoints
<- empty line to leave the
expression evaluator
MiniDebugger> a <- abort
Example:
ATTENTION: save your work before evaluating this
MessageTracer traceMethodSender:(Context compiledMethodAt:#sender).
thisContext sender.
MessageTracer untraceMethod:(Context compiledMethodAt:#sender).
after the above, you should repair things, by opening a workspace,
and evaluating:
MessageTracer unwrapAllmethods
(this will remove the tracers, and allow normal use of the debugger again).
Critical methods are all context methods, string concatenation and printing
methods.
To trace these critical methods, use the instance debugging facilities
described above, instead of method debugging - if possible
(it is not possible for context-related methods though).
It is difficult to offer a satisfying solution to this problem - the obvious fix (to simply check for recursion in the wrapper method) would prevent the tracing or breakpointing of recursive methods, such as the factorial-example above.
Future versions may provide better solutions - for now, be warned.
Copyright © Claus Gittinger Development & Consulting, all rights reserved
(cg@ssw.de)