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:
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::testComments?