# 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.26 2003/02/03 20:16:54 kennykb Exp $

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

proc traceScalar {name1 name2 op} {

    list [catch {trace variable x y z w} msg] $msg
} [list 1 "wrong # args: should be \"trace variable name ops command\""]
test trace-14.11 {trace command, "trace variable" errors} {
    list [catch {trace variable x y z} msg] $msg
} [list 1 "bad operations \"y\": should be one or more of rwua"]


test trace-14.9 {trace command ("remove variable" option)} {
    catch {unset x}
    set info {}
    trace add variable x write traceProc
    trace remove variable x write traceProc
} {}
test trace-14.10 {trace command ("remove variable" option)} {
    catch {unset x}
    set info {}
    trace add variable x write traceProc
    trace remove variable x write traceProc
    set x 12345
    set info
} {}
test trace-14.11 {trace command ("remove variable" option)} {
    catch {unset x}
    set info {}
    trace add variable x write {traceTag 1}
    trace add variable x write traceProc
    trace add variable x write {traceTag 2}
    set x yy
    trace remove variable x write traceProc
    set x 12345
    trace remove variable x write {traceTag 1}
    set x foo
    trace remove variable x write {traceTag 2}
    set x gorp
    set info
} {2 x {} write 1 2 1 2}
test trace-14.12 {trace command ("remove variable" option)} {
    catch {unset x}
    set info {}
    trace add variable x write {traceTag 1}
    trace remove variable x write non_existent
    set x 12345
    set info
} {1}
test trace-14.15 {trace command ("info variable" option)} {
    catch {unset x}
    trace add variable x write {traceTag 1}
    trace add variable x write traceProc
    trace add variable x write {traceTag 2}
    trace info variable x
} {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
test trace-14.16 {trace command ("info variable" option)} {
    catch {unset x}
    trace info variable x
} {}
test trace-14.17 {trace command ("info variable" option)} {
    catch {unset x}
    trace info variable x(0)
} {}
test trace-14.18 {trace command ("info variable" option)} {
    catch {unset x}
    set x 44
    trace info variable x(0)
} {}
test trace-14.19 {trace command ("info variable" option)} {
    catch {unset x}
    set x 44
    trace add variable x write {traceTag 1}
    proc check {} {global x; trace info variable x}
    check
} {{write {traceTag 1}}}

# Delete arrays when done, so they can be re-used as scalars
# elsewhere.

catch {unset x}
catch {unset y}

test trace-18.2 {trace add command (command existence)} {
    # Just in case!
    catch {rename nosuchname ""}
    list [catch {trace add command nosuchname rename traceCommand} msg] $msg
} {1 {unknown command "nosuchname"}}
test trace-18.3 {trace add command (command existence in ns)} {
    list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg
} {1 {unknown command "nosuchns::nosuchname"}}


test trace-19.1 {trace add command (rename option)} {
    proc foo {} {}
    catch {rename bar {}}

# Unset the varaible when done
catch {unset info}

# cleanup
::tcltest::cleanupTests
return