1# 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 © 1993 The Regents of the University of California.
10# Copyright © 1994-1996 Sun Microsystems, Inc.
11# Copyright © 1998-1999 Scriptics Corporation.
12#
13# See the file "license.terms" for information on usage and redistribution
14# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15
16if {"::tcltest" ni [namespace children]} {
17    package require tcltest 2.5
18    namespace import -force ::tcltest::*
19}
20
21::tcltest::loadTestedCommands
22catch [list package require -exact tcl::test [info patchlevel]]
23
24testConstraint testcmdinfo  [llength [info commands testcmdinfo]]
25testConstraint testcmdtoken [llength [info commands testcmdtoken]]
26
27test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
28    testcmdinfo create x1
29    testcmdinfo get x1
30} {CmdProc1 original CmdDelProc1 original :: stringProc}
31test cmdinfo-1.2 {command procedure and clientData} {testcmdinfo} {
32    testcmdinfo create x1
33    x1
34} {CmdProc1 original}
35test cmdinfo-1.3 {command procedure and clientData} {testcmdinfo} {
36    testcmdinfo create x1
37    testcmdinfo modify x1
38    testcmdinfo get x1
39} {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc}
40test cmdinfo-1.4 {command procedure and clientData} {testcmdinfo} {
41    testcmdinfo create x1
42    testcmdinfo modify x1
43    x1
44} {CmdProc2 new_command_data}
45
46test cmdinfo-2.1 {command deletion callbacks} {testcmdinfo} {
47    testcmdinfo create x1
48    testcmdinfo delete x1
49} {CmdDelProc1 original}
50test cmdinfo-2.2 {command deletion callbacks} {testcmdinfo} {
51    testcmdinfo create x1
52    testcmdinfo modify x1
53    testcmdinfo delete x1
54} {CmdDelProc2 new_delete_data}
55
56test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
57    testcmdinfo get non_existent
58} {??}
59test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
60    testcmdinfo create x1
61    testcmdinfo modify x1
62} 1
63test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
64    testcmdinfo modify non_existent
65} 0
66
67test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
68	{testcmdtoken} {
69    set x [testcmdtoken create x1]
70    rename x1 newName
71    set y [testcmdtoken name $x]
72    rename newName x1
73    lappend y {*}[testcmdtoken name $x]
74} {newName ::newName x1 ::x1}
75
76catch {rename newTestCmd {}}
77catch {rename newTestCmd2 {}}
78
79test cmdinfo-5.1 {Names for commands created when inside namespaces} \
80	{testcmdtoken} {
81    # create namespace cmdInfoNs1
82    namespace eval cmdInfoNs1 {}   ;# creates namespace cmdInfoNs1
83    # create namespace cmdInfoNs1::cmdInfoNs2 and execute a script in it
84    set x [namespace eval cmdInfoNs1::cmdInfoNs2 {
85        # the following creates a cmd in the global namespace
86        testcmdtoken create testCmd
87    }]
88    set y [testcmdtoken name $x]
89    rename ::testCmd newTestCmd
90    lappend y {*}[testcmdtoken name $x]
91} {testCmd ::testCmd newTestCmd ::newTestCmd}
92
93test cmdinfo-6.1 {Names for commands created when outside namespaces} \
94	{testcmdtoken} {
95    set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
96    set y [testcmdtoken name $x]
97    rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
98    lappend y {*}[testcmdtoken name $x]
99} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
100
101# cleanup
102catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
103catch {rename x1 ""}
104cleanupTests
105return
106
107# Local Variables:
108# mode: tcl
109# End:
110