# Provision of a simple coverage map in Tcl
# Shows how you can find the number of calls made to each proc in your code

# Globals needed during coverage analysis
# (Have to use globals as we cannot change arguments)

# Namespace resolution needs adding if you use namepaces

set call_order ""
set procnames ""

# Define here any procs that we do NOT want analysed, such as our own ones relating to coverage

proc report {} {
        global call_order
        foreach call $call_order {
                incr callcounter($call)
        }
        puts [format "\n%20s %5s" "proc name" count]
        puts [format "%20s %5s" --------- -----]
        # change to loop through procnames if you want to include procs not called
        foreach fn [array names callcounter] {
                puts [format "%20s %5d" $fn $callcounter($fn)]
        }
}

# Hide the original proc command and write a new one
# which wraps (decorates) the original with our coverage code

rename proc my_proc
my_proc proc {name arglist body} {

        # stuff to log as we apply the wrapping
        # (making note of all the names of the things we wrap
        global procnames
        lappend procnames $name

        # Within the body, add in extra code to note each call made
        # This is a bit crude - simply a long list of calls
        # Use of quotes rather than braces to ensure dollar expansion at the right time
        # semicolon to end statements, as backslash-return become a space not a return
        my_proc $name $arglist " \
                global call_order; \
                lappend call_order $name; \
                $body \
                "
        }

# ------------------------------------------------------------------------

# The application

proc area {a b} {
        # area of rectangular table
        return [expr $a * $b]
        }
proc circum {a b} {
        # circumference of rectangular table
        return [expr 2 * ($a + $b)]
        }
proc doggydistance {a b} {
        # Shortest distance from edge to middle of table
        set closest [expr (($a > $b) ? $b : $a) / 2.0]
        return $closest
        }

set a [area 100 200]
set b [circum 100 200]
set b [circum 100 200]
set b [circum 100 200]
set b [circum 100 200]

puts $a
puts $b

# ---------------------------------------------------------

# Reporting on coverage after it's run

puts "-------------------------------"
puts "\n** List of calls made in order"
puts $call_order

puts "\n** Counts of calls to each wrapped proc"
report

puts "\n** List of procs wrapped"
puts $procnames

# ------------------------------------------------------

# Sample Output

# WomanWithCat:demo grahamellis$ tclsh times
# 20000
# 600
# -------------------------------
#
# ** List of calls made in order
# area circum circum circum circum
#
# ** Counts of calls to each wrapped proc
#
# proc name count
# --------- -----
# area 1
# circum 4
#
# ** List of procs wrapped
# area circum doggydistance
# WomanWithCat:demo grahamellis$