diff options
| -rw-r--r-- | tests/basic.test | 51 | ||||
| -rw-r--r-- | tests/cmdInfo.test | 51 |
2 files changed, 36 insertions, 66 deletions
diff --git a/tests/basic.test b/tests/basic.test index cb97c24..62248a5 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: basic.test,v 1.11 2000/10/19 18:01:00 jenn Exp $ +# RCS: @(#) $Id: basic.test,v 1.12 2001/09/20 01:02:20 hobbs Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -23,6 +23,13 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +set ::tcltest::testConstraints(testcmdtoken) \ + [llength [info commands testcmdtoken]] +set ::tcltest::testConstraints(testcmdtrace) \ + [llength [info commands testcmdtrace]] +set ::tcltest::testConstraints(testcreatecommand) \ + [llength [info commands testcreatecommand]] + # This variable needs to be changed when the major or minor version number for # Tcl changes. set tclvers 8.4 @@ -202,24 +209,19 @@ test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being expo [p] } {42 {} {} Hello {} {} 42} -if {[info commands testcreatecommand] == ""} { - puts "This application hasn't been compiled with the testcreatecommand" - puts "command. Skipping affected tests." -} else { -test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} { +test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {testcreatecommand} { catch {eval namespace delete [namespace children :: test_ns_*]} list [testcreatecommand create] \ [test_ns_basic::createdcommand] \ [testcreatecommand delete] } {{} {CreatedCommandProc in ::test_ns_basic} {}} -test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} { +test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {testcreatecommand} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename value:at: ""} list [testcreatecommand create2] \ [value:at:] \ [testcreatecommand delete2] } {{} {CreatedCommandProc2 in ::} {}} -} test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} { catch {eval namespace delete [namespace children :: test_ns_*]} @@ -304,11 +306,7 @@ test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} { } {} -if {[info commands testcmdtoken] == {}} { - puts "This application hasn't been compiled with the \"testcmdtoken\"" - puts "command, so I can't test Tcl_GetCommandInfo." -} else { -test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} { +test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {testcmdtoken} { catch {eval namespace delete [namespace children :: test_ns_*]} catch {rename p ""} catch {rename q ""} @@ -321,14 +319,13 @@ test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespace [rename ::p q] \ [testcmdtoken name $x] } {{p ::p} {} {q ::q}} -test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} { +test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {testcmdtoken} { catch {rename q ""} set x [testcmdtoken create test_ns_basic::test_ns_basic2::p] list [testcmdtoken name $x] \ [rename test_ns_basic::test_ns_basic2::p q] \ [testcmdtoken name $x] } {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}} -} test basic-21.1 {Tcl_GetCommandName} {emptyTest} { } {} @@ -489,20 +486,16 @@ test basic-37.1 {Tcl_ExprString: see expr.test} {emptyTest} { test basic-38.1 {Tcl_ExprObj} {emptyTest} { } {} -if {[info commands testcmdtrace] == {}} { - puts "This application hasn't been compiled with the \"testcmdtrace\"" - puts "command, so I can't test Tcl_CreateTrace." -} else { -test basic-39.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} { +test basic-39.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace tracetest {set stuff [expr 14 + 16]} } {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}} -test basic-39.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} { +test basic-39.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace tracetest {set stuff [info tclversion]} } [list {info tclversion} {info tclversion} {set stuff [info tclversion]} "set stuff $tclvers"] -test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} { +test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} { testcmdtrace deletetest {set stuff [info tclversion]} } $tclvers -} + test basic-40.1 {Tcl_DeleteTrace} {emptyTest} { } {} @@ -536,15 +529,3 @@ catch {rename value:at: ""} catch {unset x} ::tcltest::cleanupTests return - - - - - - - - - - - - diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test index 1e70bd2..a29c7ca 100644 --- a/tests/cmdInfo.test +++ b/tests/cmdInfo.test @@ -13,61 +13,60 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdInfo.test,v 1.5 2000/04/10 17:18:57 ericm Exp $ +# RCS: @(#) $Id: cmdInfo.test,v 1.6 2001/09/20 01:02:20 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } -if {[info commands testcmdinfo] == {}} { - puts "This application hasn't been compiled with the \"testcmdinfo\"" - puts "command, so I can't test Tcl_GetCommandInfo etc." - ::tcltest::cleanupTests - return -} +set ::tcltest::testConstraints(testcmdinfo) \ + [llength [info commands testcmdinfo]] +set ::tcltest::testConstraints(testcmdtoken) \ + [llength [info commands testcmdtoken]] -test cmdinfo-1.1 {command procedure and clientData} { +test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 testcmdinfo get x1 } {CmdProc1 original CmdDelProc1 original :: stringProc} -test cmdinfo-1.2 {command procedure and clientData} { +test cmdinfo-1.2 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 x1 } {CmdProc1 original} -test cmdinfo-1.3 {command procedure and clientData} { +test cmdinfo-1.3 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 testcmdinfo modify x1 testcmdinfo get x1 } {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc} -test cmdinfo-1.4 {command procedure and clientData} { +test cmdinfo-1.4 {command procedure and clientData} {testcmdinfo} { testcmdinfo create x1 testcmdinfo modify x1 x1 } {CmdProc2 new_command_data} -test cmdinfo-2.1 {command deletion callbacks} { +test cmdinfo-2.1 {command deletion callbacks} {testcmdinfo} { testcmdinfo create x1 testcmdinfo delete x1 } {CmdDelProc1 original} -test cmdinfo-2.2 {command deletion callbacks} { +test cmdinfo-2.2 {command deletion callbacks} {testcmdinfo} { testcmdinfo create x1 testcmdinfo modify x1 testcmdinfo delete x1 } {CmdDelProc2 new_delete_data} -test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} { +test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} { testcmdinfo get non_existent } {??} -test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} { +test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} { testcmdinfo create x1 testcmdinfo modify x1 } 1 -test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} { +test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} { testcmdinfo modify non_existent } 0 -test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} { +test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \ + {testcmdtoken} { set x [testcmdtoken create x1] rename x1 newName set y [testcmdtoken name $x] @@ -78,7 +77,8 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} { catch {rename newTestCmd {}} catch {rename newTestCmd2 {}} -test cmdinfo-5.1 {Names for commands created when inside namespaces} { +test cmdinfo-5.1 {Names for commands created when inside namespaces} \ + {testcmdtoken} { # create namespace cmdInfoNs1 namespace eval cmdInfoNs1 {} ;# creates namespace cmdInfoNs1 # create namespace cmdInfoNs1::cmdInfoNs2 and execute a script in it @@ -91,7 +91,8 @@ test cmdinfo-5.1 {Names for commands created when inside namespaces} { eval lappend y [testcmdtoken name $x] } {testCmd ::testCmd newTestCmd ::newTestCmd} -test cmdinfo-6.1 {Names for commands created when outside namespaces} { +test cmdinfo-6.1 {Names for commands created when outside namespaces} \ + {testcmdtoken} { set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd] set y [testcmdtoken name $x] rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 @@ -103,15 +104,3 @@ catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1} catch {rename x1 ""} ::tcltest::cleanupTests return - - - - - - - - - - - - |