modified

# options is on the wiki, [log] is trivial
package provide modified 0.1
package require options


namespace eval modified {
    proc array_eq {array1 array2} {
        upvar 1 $array1 foo $array2 bar
        if {![array exists foo]} {
            return -code error "$array1 is not an array"
        }
        if {![array exists bar]} {
            return -code error "$array2 is not an array"
        }
        if {[array size foo] != [array size bar]} {
            return 0
        }
        if {[array size foo] == 0} {
            return 1
        }
        
        set keys [lsort -unique [concat [array names foo] [array names bar]]]
        if {[llength $keys] != [array size foo]} {
           return 0
        }
        
        foreach key $keys {
            if {$foo($key) ne $bar($key)} {
                return 0
            }
        }
        return 1
    }
    proc init args {
        options {-backingvar {}} ;# doesn't really work
        arguments {_var}

        if {$backingvar eq ""} {
            set backingvar back__${_var}
        }
        set ns [uplevel 1 namespace current]
        if {$ns eq "::"} {set ns ""}

        upvar 1 $_var var
        log debug "using backing var: ${ns}::${backingvar}"
        upvar #0 ${ns}::${backingvar} var_back

        if {[array exists var]} {
            array set var_back [array get var]
        } else {
            set var_back $var
        }
    }
    proc test args {
        options {-backingvar {}} ;# doesn't really work
        arguments {_var}

        if {$backingvar eq ""} {
            set backingvar back__${_var}
        }
        set ns [uplevel 1 namespace current]
        if {$ns eq "::"} {set ns ""}

        upvar 1 $_var var
        upvar #0 ${ns}::${backingvar} var_back

        if {[array exists var]} {
            return [expr {![array_eq var var_back]}]
        } else {                                                  
            return [expr {$var ne $var_back}]
        }
    }
    namespace export init test
    namespace ensemble create
}

# array set foo {a 1 b 2}
# modified init foo
# incr foo(b)
# modified test foo
# modified test foo(a) ;# bonus