# Commands covered:  trace
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: trace.test,v 1.44 2005/11/05 02:10:55 msofer Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

testConstraint testcmdtrace [llength [info commands testcmdtrace]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]

proc getbytes {} {
    set lines [split [memory info] "\n"]
    lindex [lindex $lines 3] 3
}

proc traceScalar {name1 name2 op} {
    global info
    set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
}
proc traceScalarAppend {name1 name2 op} {
    global info

    set x junk
    trace add variable ::x write [list foo $x]
    for {set y 0} {$y<100} {incr y} {
	catch {set x junk}
    }
    unset x
} {}
test trace-8.9 {leaks in error returns from traces} \
    -constraints memory -body {
	set end [getbytes]
	for {set i 0} {$i < 5} {incr i} {
	    set apa {a 1 b 2}
	    set bepa [lrange $apa 0 end]
	    trace add variable bepa write {error hej}
	    catch {set bepa a}
	    unset bepa
	    set tmp $end
	    set end [getbytes]
	}
	expr {$end - $tmp}
    } -cleanup {
	unset -nocomplain end i tmp
    } -result 0

# Check to see that variables are expunged before trace
# procedures are invoked, so trace procedure can even manipulate
# a new copy of the variables.

test trace-9.1 {be sure variable is unset before trace is called} {
    catch {unset x}