** Faking it in Tcl **

When unit testing, it's common to have fake or mock versions of function which can be programed behave in specific ways useful for the test.  Using Tcl, it is very easy to override or redefine any proc, but I couldn't find a package which provided a convient API for this common task, so I wrote one.  Please shoot at it :)

I hope that posting this will do two things:

   1. Get some feedback/improvements from the community for this specific code
   2. Start a discussion about the proper way to do unit testing, mocking, faking, etc with Tcl.

As a programmer in complete isolation, it would be useful to start to gain from the wisdom and experience of the community!

------
======
# replace.tcl
package provide replace 1.0

namespace eval replace {

    namespace export replace restore restoreAll

    variable repl

    set repl {}; # a dict of the form: {originalName replacedName}

    ##
    # replace
    # Replaces one command or proc with another
    # The original command is renamed to _cmdName in its original namespace
    # Procs can be replaced multiple times, but only the original proc is saved.
    proc replace {cmdName replProc} {
        variable repl

        set origName [uplevel 1 namespace which $cmdName]
        if {$origName eq {}} {
            error "can't find a command or proc named '$cmdName'"
        }
        set replProcFull [uplevel 1 namespace which $replProc]
        if {$replProcFull eq {}} {
            error "can't find a proc named '$replProc'"
        }

        # Only save the original cmdName, but always substitute the new body
        set newName [namespace qualifiers $origName]::_[namespace tail $origName]
        if {[info commands $newName] eq {}} {
            rename $origName $newName
            dict set repl $origName $newName
        }
        proc $origName [info args $replProcFull] [info body $replProcFull]
    }

    ##
    # restore
    # Restores a command which was renamed by replace
    # Always restores the original version of a replaced command
    # It is not considered an error to restore a command which is not currently replaced
    proc restore {origName} {
        variable repl
        set origName [uplevel 1 namespace which $origName]
        if {[dict exists $repl $origName]} {
            catch {rename $origName {}}
            rename [dict get $repl $origName] $origName
            set repl [dict remove $repl $origName]
        }
    }

    proc restoreAll {} {
        variable repl
        dict for {origName newName} $repl {
            catch {rename $origName {}}
            rename $newName $origName
        }
        set repl {}
    }
}
======
------
======
# replace.test
package require tcltest
eval ::tcltest::configure $argv

package require log
::log::lvSuppressLE warning 0

source [file join [file dirname [info script]] replace.tcl]

namespace eval replace::test {
    namespace import ::tcltest::*
    namespace import ::replace::*

    test test-0.0 {Replace and Restore a namespaced proc} -setup {
        proc ::cmd1 {} {return ::cmd1}
        proc ::fakecmd1 {} {return ::fakecmd1}
    } -body {
        set res [::cmd1]
        replace ::cmd1 ::fakecmd1
        lappend res [::cmd1]
        restore ::cmd1
        lappend res [::cmd1]
    } -result {::cmd1 ::fakecmd1 ::cmd1} -cleanup {
        rename ::cmd1 {}
        rename ::fakecmd1 {}
    }

    test test-0.1 {Replace and restore a tcl namespaced cmd} -setup {
        proc ::fakeopen {args} {return fakeopen}
    } -body {
        replace ::open ::fakeopen
        set res [open fakevar]
        restore ::open
        set f [open tmp.txt w]
        lappend res $f
        close $f
        set res
    } -result {fakeopen file*} -match glob -cleanup {
        removeFile tmp.txt
        rename ::fakeopen {}
    }

    test test-0.2 {works without explicit namespaces} -setup {
        proc cmd1 {} {return cmd1}
        proc fakecmd1 {} {return fakecmd1}
    } -body {
        set res [cmd1]
        replace cmd1 fakecmd1
        lappend res [cmd1]
        restore cmd1
        lappend res [cmd1]
    } -result {cmd1 fakecmd1 cmd1} -cleanup {
        rename cmd1 {}
        rename fakecmd1 {}
    }

    test test-0.3 {works across different namespaces} -setup {
        proc ::cmd1 {} {return ::cmd1}
        proc fakecmd1 {} {return fakecmd1}
    } -body {
        set res [cmd1]
        replace cmd1 [namespace current]::fakecmd1
        lappend res [cmd1]
        restore ::cmd1
        lappend res [cmd1]
    } -result {::cmd1 fakecmd1 ::cmd1} -cleanup {
        rename ::cmd1 {}
        rename fakecmd1 {}
    }

    test test-0.4 {Restore original cmd after multiple replacements} -setup {
        proc cmd1 {} {return cmd1}
        proc fakecmd1 {} {return fakecmd1}
        proc fakecmd2 {} {return fakecmd2}
        proc fakecmd3 {} {return fakecmd3}
    } -body {
        set res [cmd1]
        replace cmd1 fakecmd1
        lappend res [cmd1]
        replace cmd1 fakecmd2
        lappend res [cmd1]
        replace cmd1 fakecmd3
        lappend res [cmd1]
        restore cmd1
        lappend res [cmd1]
    } -result {cmd1 fakecmd1 fakecmd2 fakecmd3 cmd1} -cleanup {
        rename cmd1 {}
        rename fakecmd1 {}
        rename fakecmd2 {}
        rename fakecmd3 {}
    }

    test test-1.0 {error when replacing a cmd which doesn't exist} -setup {
        proc fakecmd1 {} {return fakecmd1}
    } -body {
        replace cmd1 fakecmd1
    } -returnCodes 1 -result {can't find a command or proc named 'cmd1'} -cleanup {
        rename fakecmd1 {}
    }

    test test-1.1 {error when replacment proc doesn't exist} -setup {
        proc cmd1 {} {return cmd1}
    } -body {
        replace cmd1 fakecmd1
    } -returnCodes 1 -result {can't find a proc named 'fakecmd1'} -cleanup {
        rename cmd1 {}
    }
    
    test test-2.0 {Restore all replaced commands} -setup {
        proc cmd1 {} {return cmd1}
        proc cmd2 {} {return cmd2}
        proc cmd3 {} {return cmd3}
        proc fakecmd1 {} {return fakecmd1}
        proc fakecmd2 {} {return fakecmd2}
        proc fakecmd3 {} {return fakecmd3}
    } -body {
        set res {}
        lappend res [cmd1] [cmd2] [cmd3]
        replace cmd1 fakecmd1
        replace cmd2 fakecmd2
        replace cmd3 fakecmd3
        lappend res [cmd1] [cmd2] [cmd3]
        restoreAll
        lappend res [cmd1] [cmd2] [cmd3]
    } -result {cmd1 cmd2 cmd3 fakecmd1 fakecmd2 fakecmd3 cmd1 cmd2 cmd3} -cleanup {
        foreach cmd {cmd1 cmd2 cmd3} {
            rename $cmd {}
            rename fake$cmd {}
        }
    }

    cleanupTests
}
namespace delete replace::test
======
------

Comments?

<<categories>>Testing