| 1 |
578 |
markom |
# Commands covered: none
|
| 2 |
|
|
#
|
| 3 |
|
|
# This file contains a collection of tests for Tcl_GetCommandInfo,
|
| 4 |
|
|
# Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and
|
| 5 |
|
|
# Tcl_NameOfCommand. Sourcing this file into Tcl runs the tests
|
| 6 |
|
|
# and generates output for errors. No output means no errors were
|
| 7 |
|
|
# found.
|
| 8 |
|
|
#
|
| 9 |
|
|
# Copyright (c) 1993 The Regents of the University of California.
|
| 10 |
|
|
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
| 11 |
|
|
#
|
| 12 |
|
|
# See the file "license.terms" for information on usage and redistribution
|
| 13 |
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
| 14 |
|
|
#
|
| 15 |
|
|
# RCS: @(#) $Id: cmdInfo.test,v 1.1.1.1 2002-01-16 10:25:35 markom Exp $
|
| 16 |
|
|
|
| 17 |
|
|
if {[info commands testcmdinfo] == {}} {
|
| 18 |
|
|
puts "This application hasn't been compiled with the \"testcmdinfo\""
|
| 19 |
|
|
puts "command, so I can't test Tcl_GetCommandInfo etc."
|
| 20 |
|
|
return
|
| 21 |
|
|
}
|
| 22 |
|
|
|
| 23 |
|
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
| 24 |
|
|
|
| 25 |
|
|
test cmdinfo-1.1 {command procedure and clientData} {
|
| 26 |
|
|
testcmdinfo create x1
|
| 27 |
|
|
testcmdinfo get x1
|
| 28 |
|
|
} {CmdProc1 original CmdDelProc1 original :: stringProc}
|
| 29 |
|
|
test cmdinfo-1.2 {command procedure and clientData} {
|
| 30 |
|
|
testcmdinfo create x1
|
| 31 |
|
|
x1
|
| 32 |
|
|
} {CmdProc1 original}
|
| 33 |
|
|
test cmdinfo-1.3 {command procedure and clientData} {
|
| 34 |
|
|
testcmdinfo create x1
|
| 35 |
|
|
testcmdinfo modify x1
|
| 36 |
|
|
testcmdinfo get x1
|
| 37 |
|
|
} {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc}
|
| 38 |
|
|
test cmdinfo-1.4 {command procedure and clientData} {
|
| 39 |
|
|
testcmdinfo create x1
|
| 40 |
|
|
testcmdinfo modify x1
|
| 41 |
|
|
x1
|
| 42 |
|
|
} {CmdProc2 new_command_data}
|
| 43 |
|
|
|
| 44 |
|
|
test cmdinfo-2.1 {command deletion callbacks} {
|
| 45 |
|
|
testcmdinfo create x1
|
| 46 |
|
|
testcmdinfo delete x1
|
| 47 |
|
|
} {CmdDelProc1 original}
|
| 48 |
|
|
test cmdinfo-2.2 {command deletion callbacks} {
|
| 49 |
|
|
testcmdinfo create x1
|
| 50 |
|
|
testcmdinfo modify x1
|
| 51 |
|
|
testcmdinfo delete x1
|
| 52 |
|
|
} {CmdDelProc2 new_delete_data}
|
| 53 |
|
|
|
| 54 |
|
|
test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {
|
| 55 |
|
|
testcmdinfo get non_existent
|
| 56 |
|
|
} {??}
|
| 57 |
|
|
test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {
|
| 58 |
|
|
testcmdinfo create x1
|
| 59 |
|
|
testcmdinfo modify x1
|
| 60 |
|
|
} 1
|
| 61 |
|
|
test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {
|
| 62 |
|
|
testcmdinfo modify non_existent
|
| 63 |
|
|
} 0
|
| 64 |
|
|
|
| 65 |
|
|
test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} {
|
| 66 |
|
|
set x [testcmdtoken create x1]
|
| 67 |
|
|
rename x1 newName
|
| 68 |
|
|
set y [testcmdtoken name $x]
|
| 69 |
|
|
rename newName x1
|
| 70 |
|
|
eval lappend y [testcmdtoken name $x]
|
| 71 |
|
|
} {newName ::newName x1 ::x1}
|
| 72 |
|
|
|
| 73 |
|
|
catch {rename newTestCmd {}}
|
| 74 |
|
|
catch {rename newTestCmd2 {}}
|
| 75 |
|
|
|
| 76 |
|
|
test cmdinfo-5.1 {Names for commands created when inside namespaces} {
|
| 77 |
|
|
# create namespace cmdInfoNs1
|
| 78 |
|
|
namespace eval cmdInfoNs1 {} ;# creates namespace cmdInfoNs1
|
| 79 |
|
|
# create namespace cmdInfoNs1::cmdInfoNs2 and execute a script in it
|
| 80 |
|
|
set x [namespace eval cmdInfoNs1::cmdInfoNs2 {
|
| 81 |
|
|
# the following creates a cmd in the global namespace
|
| 82 |
|
|
testcmdtoken create testCmd
|
| 83 |
|
|
}]
|
| 84 |
|
|
set y [testcmdtoken name $x]
|
| 85 |
|
|
rename ::testCmd newTestCmd
|
| 86 |
|
|
eval lappend y [testcmdtoken name $x]
|
| 87 |
|
|
} {testCmd ::testCmd newTestCmd ::newTestCmd}
|
| 88 |
|
|
|
| 89 |
|
|
test cmdinfo-6.1 {Names for commands created when outside namespaces} {
|
| 90 |
|
|
set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
|
| 91 |
|
|
set y [testcmdtoken name $x]
|
| 92 |
|
|
rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
|
| 93 |
|
|
eval lappend y [testcmdtoken name $x]
|
| 94 |
|
|
} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
|
| 95 |
|
|
|
| 96 |
|
|
catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
|
| 97 |
|
|
catch {rename x1 ""}
|
| 98 |
|
|
concat {}
|
