Tcl Source Code

Artifact a3a58c57683053e992d44edb2a1da1388b00efb7:

Attachment "memleak-bovine.tcl" to ticket [a3309d01db] added by aspect 2015-07-15 23:59:10. (unpublished)

---

#!/usr/local/bin/tclsh
source meminfo.tcl


proc doit {newkey} {
	global myarray

	# store a new value into the array
	set myarray($newkey) {}

	# clean out the array of older records.
	foreach {key} [array names myarray] {
		if {$key <= $newkey - 10} {
			unset myarray($key)
			#array unset myarray $key
		}
	}

}

while 1 {
	doit [incr i]

	if {$i % 5 == 0} {
		puts "myarray has currently [array size myarray] elements"
		meminfo
	}
}