[AMW] 2011-11-27

I used the technique described in [Steppin' out] and [A basic debugger] for yet another approach to debugging.

Sourcing the following script into a session of [TkCon] will add a feature to intercept every call to given proc
to TkCon's already powerful '''idebug''' command.

First, call '''bpadd procname''' to add a breakpoint for the desired proc. 
This is a bit different from the '''idebug break''' that already exists, because it will intercept ''every'' call to the proc,
rather than just the call at some dedicated place within the code.

However, this approach allows for the definition of a breakpoint ''without'' any ''modification'' of the existing code.

As soon as you run your code and the proc is called, the interactive debugger is started.

Type '''?''' to get idebug's menu, '''c''' to proceed until the next call you set a breakpoint for, or use any
other existing command or feature of idebug.

Moreover, you may call '''s''' to 'step into' the intercepted proc, or '''r''' to return from it
and see the results it produced.

----
======
#===============================================================================
#  This is an extension to the 'idebug' command in tkcon.tcl
#===============================================================================

#-------------------------------------------------------------------------------
#  bpadd
#  add a breakpoint for calls to 'procname'
#-------------------------------------------------------------------------------
proc bpadd { procname } {
    global BP
    set BP($procname,step) 0
    trace add execution $procname enter     "BREAKPOINT $procname"
    trace add execution $procname enterstep "BREAKPOINT $procname"
    trace add execution $procname leave "BREAKPOINT $procname"
    idebug on
}

#-------------------------------------------------------------------------------
#  bplist
#  return a list of active breakpoints
#-------------------------------------------------------------------------------
proc bplist { } {
    global BP
    set procs ""
    foreach item [array names BP "*,step"] {
        regsub {,step$} $item "" procname
        lappend procs $procname
    }
    return [lsort $procs]
}

#-------------------------------------------------------------------------------
#  bpdel
#  delete breakpoint from calls to 'procname'
#  if procname is not given, it defaults to the 'current' breakpoint
#-------------------------------------------------------------------------------
proc bpdel { { procname "" } } {
    global BP
    if { $procname == "" } { set procname $BP(procname) }
    trace remove execution $procname enter     "BREAKPOINT $procname"
    trace remove execution $procname enterstep "BREAKPOINT $procname"
    trace remove execution $procname leave "BREAKPOINT $procname"
    catch { unset BP($procname,step) }
}

#-------------------------------------------------------------------------------
#  dbgStep
#  step into procname, i.e. call idebug at trace 'enterstep'
#-------------------------------------------------------------------------------
proc dbgStep { { procname "" } } {
    global BP IDEBUG
    if { $procname == "" } { set procname $BP(procname) }
    set BP($procname,step) 2
    # The following statement causes idebug to continue, but this requires
    # a small modification in tkcon.tcl (line 4287 in Tkcon 2.5):
    # in proc 'idebug' in the switch handling $opt="break", replace
    # 'while 1' for the input loop with 'while { $IDEBUG(debugging) }'
    set IDEBUG(debugging) 0
    return ""
}

#-------------------------------------------------------------------------------
#  dbgReturn
#  return from procname
#-------------------------------------------------------------------------------
proc dbgReturn { { procname "" } } {
    global BP IDEBUG
    if { $procname == "" } { set procname $BP(procname) }
    set BP($procname,step) 1
    set IDEBUG(debugging) 0
    return ""
}

#-------------------------------------------------------------------------------
#  shortcuts for use within 'idebug':
#  s - step into proc
#  r - return from proc
#-------------------------------------------------------------------------------
proc s { args } { dbgStep {*}$args }
proc r { args } { dbgReturn {*}$args }

#-------------------------------------------------------------------------------
#  dumpstr - dump str in the most readable way,
#  replacing non-printable characters with their hex-code written as "\xXX"
#-------------------------------------------------------------------------------
proc dumpstr { str } {
    set result ""
    while { $str != "" } {
        if { [regexp -indices {^[-+*/%<=>.,:;|~^°`´!$&@(){}\[\]#'"A-Z_a-z0-9]+} $str igood] } {
            # " readable characters, excluding backslash
            append result [string range $str 0 [lindex $igood 1]]
            set str [string range $str [lindex $igood 1]+1 end]
        }
        if { $str != "" } {
            set char [string index $str 0]
            set str  [string range $str 1 end]
            if { $char == "\\" } {
                append result {\\}
            } else {
                binary scan $char c hex
                append result [format "\\x%02X" [expr $hex & 0xff]]
            }
        }
    }
    append result $str
    return $result
}

#-------------------------------------------------------------------------------
#  BREAKPOINT handler
#-------------------------------------------------------------------------------
proc BREAKPOINT { procname cmd args } {
    global BP
    set BP(procname) $procname

    set op [lindex $args end]

    set dbg 1
    if { $op == "enter" } {
        puts stderr "# $cmd\nBREAKPOINT @ $procname $op"

    } elseif { $op == "enterstep"  && $BP($procname,step) >= 2 } {
        puts stderr "# $cmd\nBREAKPOINT @ $procname step"

    } elseif { $op == "leave"      && $BP($procname,step) >= 1 } {
        set code   [lindex $args 0]
        set result [lindex $args 1]
        puts stderr "# $cmd\nBREAKPOINT @ $procname leave (code $code, result \"[dumpstr $result]\")"

    } else {
        set dbg 0
    }

    if { $dbg } {
        set BP($procname,step) 0
        uplevel idebug break
    }
}

#===============================================================================
#  end of file
#===============================================================================
======

<<categories>>Debugging