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