Watching Global Variables Creation for Memory Leak Detection

I was recently faced with the problem of a process that used a foreign library which implementation seemed to behave badly and leak memory [L1 ]. I am not blaming them, I have probably done this kind of mistake thousands of time. The problem for me was to actually detect what was wrong, which library actually leaked memory and why it was leaking it. To my rescue, I wrote a tiny piece of code that provides a single procedure called wg_checkpoint (wg stands for watch_globals which is the name of the file containing the implementation). This is not at all refined, but actually helped me along the way. I am posting it here for the sake of documentation and probably because somebody else will be faced with the problem soon or later and could then make use of this.

Emmanuel Frecon

 ##################
 ## Module Name     --  watch_globals.tcl
 ## Original Author --  Emmanuel Frecon - [email protected]
 ## Description:
 ##
 ##    This module watches for the creation of new global variables at the
 ##    namespace and global level and prints out a warning each time a new
 ##    variable is created, if called regularly.  It can be useful while
 ##    trying to detect memory leaks in foreign imported libraries.
 ##    The current implementation pollutes the global namespace, but
 ##    "pollution" is not printed out!
 ##
 ## Commands Exported:
 ##     wg_checkpoint
 ##################
 
 
 array set WG {
     namespaces "___global"
 }
 
 array set __WG____global {
     name "___global"
     vars ""
 }
 
 
 
 # Command Name     --  __ns_linearize
 # Original Author  --  Emmanuel Frecon - [email protected]
 #
 # Linearize an namespace name and returned a cleaned-up string where
 # all strange characters have been suppressed.  This is necessary to
 # be able to have one TCL table for each namespace that we have
 # previously seen.
 #
 # Arguments:
 #    ns       - name to clean up
 proc __ns_linearize { ns } {
     set lns ""
     set len [string length $ns]
     for { set i 0 } { $i < $len } { incr i } {
        set ch [string index $ns $i]
        if { !($ch>="a" && $ch<="z") && !($ch>="A" && $ch<="Z") \
             && !($ch>="0" && $ch<="9") } {
            append lns "_"
        } else {
            append lns $ch
        }
     }
 
     return $lns
 }
 
 
 
 # Command Name     --  wg_checkpoint
 # Original Author  --  Emmanuel Frecon - [email protected]
 #
 # If called regularly, this procedure will print out a message each time
 # a new global variable in the global namespace or any other namespace has
 # been created.
 proc wg_checkpoint { } {
     global WG
 
     # First detect any possible new namespaces and initialise information
     # for these.
     set namespaces [namespace children ::]
     foreach ns $namespaces {
        set idx [lsearch $WG(namespaces) $ns]
        if { $idx < 0 } {
            lappend WG(namespaces) $ns
            set varname __WG_[__ns_linearize $ns]
            upvar \#0 $varname NS
            
            set NS(name) $ns
            set NS(vars) ""
        }
     }
 
     # Then for each existing namespace, look for global variables
     # within the namespace and compare the list of current variables
     # against the previous list.  Scream and update the list when a
     # new variable has been discovered.
     foreach ns $namespaces {
        set varname __WG_[__ns_linearize $ns]
        upvar \#0 $varname NS
 
        set vars [info vars ${ns}::*]
        foreach v $vars {
            set idx [lsearch $NS(vars) $v]
            if { $idx < 0 } {
                lappend NS(vars) $v
                ::llog::log "New global variable created: $v" 1
            }
        }
     }
     
     # Finally, do the same for the global namespace, call it ___global
     # for simplicity (which might be a bug if we had a namespace
     # called ::_global)
     set ns ___global
     set varname __WG_$ns
     upvar \#0 $varname NS
     set vars [info globals]
     foreach v $vars {
        set idx [lsearch $NS(vars) $v]
        if { $idx < 0 && ! [string match __WG_* $v] } {
            lappend NS(vars) $v
            ::llog::log "New global variable created: $v" 1
        }
     }
 }

Category Debugging