home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / cmdInfo.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  3.3 KB  |  99 lines  |  [TEXT/ALFA]
  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. #
  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. # SCCS: @(#) cmdInfo.test 1.10 97/06/20 14:51:12
  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 {}
  99.