sl@0: # Commands covered:  none
sl@0: #
sl@0: # This file contains a collection of tests for Tcl_GetCommandInfo,
sl@0: # Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and
sl@0: # Tcl_NameOfCommand.  Sourcing this file into Tcl runs the tests
sl@0: # and generates output for errors.  No output means no errors were
sl@0: # found.
sl@0: #
sl@0: # Copyright (c) 1993 The Regents of the University of California.
sl@0: # Copyright (c) 1994-1996 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: cmdInfo.test,v 1.7 2002/06/22 04:19:47 dgp Exp $
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest 2
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: ::tcltest::testConstraint testcmdinfo \
sl@0: 	[llength [info commands testcmdinfo]]
sl@0: ::tcltest::testConstraint testcmdtoken \
sl@0: 	[llength [info commands testcmdtoken]]
sl@0: 
sl@0: test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
sl@0:     testcmdinfo create x1
sl@0:     testcmdinfo get x1
sl@0: } {CmdProc1 original CmdDelProc1 original :: stringProc}
sl@0: test cmdinfo-1.2 {command procedure and clientData} {testcmdinfo} {
sl@0:     testcmdinfo create x1
sl@0:     x1
sl@0: } {CmdProc1 original}
sl@0: test cmdinfo-1.3 {command procedure and clientData} {testcmdinfo} {
sl@0:     testcmdinfo create x1
sl@0:     testcmdinfo modify x1
sl@0:     testcmdinfo get x1
sl@0: } {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc}
sl@0: test cmdinfo-1.4 {command procedure and clientData} {testcmdinfo} {
sl@0:     testcmdinfo create x1
sl@0:     testcmdinfo modify x1
sl@0:     x1
sl@0: } {CmdProc2 new_command_data}
sl@0: 
sl@0: test cmdinfo-2.1 {command deletion callbacks} {testcmdinfo} {
sl@0:     testcmdinfo create x1
sl@0:     testcmdinfo delete x1
sl@0: } {CmdDelProc1 original}
sl@0: test cmdinfo-2.2 {command deletion callbacks} {testcmdinfo} {
sl@0:     testcmdinfo create x1
sl@0:     testcmdinfo modify x1
sl@0:     testcmdinfo delete x1
sl@0: } {CmdDelProc2 new_delete_data}
sl@0: 
sl@0: test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
sl@0:     testcmdinfo get non_existent
sl@0: } {??}
sl@0: test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
sl@0:     testcmdinfo create x1
sl@0:     testcmdinfo modify x1
sl@0: } 1
sl@0: test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
sl@0:     testcmdinfo modify non_existent
sl@0: } 0
sl@0: 
sl@0: test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
sl@0: 	{testcmdtoken} {
sl@0:     set x [testcmdtoken create x1]
sl@0:     rename x1 newName
sl@0:     set y [testcmdtoken name $x]
sl@0:     rename newName x1
sl@0:     eval lappend y [testcmdtoken name $x]
sl@0: } {newName ::newName x1 ::x1}
sl@0: 
sl@0: catch {rename newTestCmd {}}
sl@0: catch {rename newTestCmd2 {}}
sl@0: 
sl@0: test cmdinfo-5.1 {Names for commands created when inside namespaces} \
sl@0: 	{testcmdtoken} {
sl@0:     # create namespace cmdInfoNs1
sl@0:     namespace eval cmdInfoNs1 {}   ;# creates namespace cmdInfoNs1
sl@0:     # create namespace cmdInfoNs1::cmdInfoNs2 and execute a script in it
sl@0:     set x [namespace eval cmdInfoNs1::cmdInfoNs2 {
sl@0:         # the following creates a cmd in the global namespace
sl@0:         testcmdtoken create testCmd
sl@0:     }]
sl@0:     set y [testcmdtoken name $x]
sl@0:     rename ::testCmd newTestCmd
sl@0:     eval lappend y [testcmdtoken name $x]
sl@0: } {testCmd ::testCmd newTestCmd ::newTestCmd}
sl@0: 
sl@0: test cmdinfo-6.1 {Names for commands created when outside namespaces} \
sl@0: 	{testcmdtoken} {
sl@0:     set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
sl@0:     set y [testcmdtoken name $x]
sl@0:     rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
sl@0:     eval lappend y [testcmdtoken name $x]
sl@0: } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
sl@0: 
sl@0: # cleanup
sl@0: catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
sl@0: catch {rename x1 ""}
sl@0: ::tcltest::cleanupTests
sl@0: return