Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

tcl: wrap a proc of the same name

I want to replace the definition of "proc N" with a proc of the same name and calling conventions, but with a little extra error detection code.

In python I could do what I want like below, but I don't have any grasp of how namespaces and function handles work in tcl.

__orig_N = N
def N(arg1, arg2):
    if arg1 != 'GOOD VALUE':
        exit('arg1 is bad')
    return __orig_N(arg1, arg2)
like image 916
bukzor Avatar asked Dec 10 '22 08:12

bukzor


2 Answers

You can use the rename command to rename an existing proc:

rename N __orig_N
proc N {arg1 arg2} {
    if { $arg1 != "GOOD_VALUE" } {
        puts stderr "arg1 is bad"
        exit 1
    }
    return [uplevel 1 __orig_N $arg1 $arg2]
}

This is actually a little bit more sophisticated than the python original, in that the use of uplevel effectively elides the wrapper from the call stack entirely -- which may not be necessary in your case, admittedly, but it's nice to be able to do it.

like image 118
Eric Melski Avatar answered Dec 18 '22 06:12

Eric Melski


Tcl's got quite good introspection on procedures. This lets you rewrite a procedure to add in some more code:

# Assume there are no defaults; defaults make this more complicated...
proc N [info args N] [concat {
    # Use 'ne' for string comparison, '!=' for numeric comparison
    if {$arg1 ne "GOOD VALUE"} {
        error "arg1 is bad"
        # The semicolon is _important_ because of the odd semantics of [concat]
    };
} [info body N]]

OK, that's not the only way to do it – Eric's answer is closer to how I'd normally wrap a command, and it has the advantage of working with non-procedure commands as well – but this solution has the advantage of binding the code in nice and tight so that there's very little to go wrong later. It also doesn't introduce extra stack frames into any error traces, which helps keep debugging simple.

like image 44
Donal Fellows Avatar answered Dec 18 '22 07:12

Donal Fellows