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