1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/cmdInfo.test	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,106 @@
     1.4 +# Commands covered:  none
     1.5 +#
     1.6 +# This file contains a collection of tests for Tcl_GetCommandInfo,
     1.7 +# Tcl_SetCommandInfo, Tcl_CreateCommand, Tcl_DeleteCommand, and
     1.8 +# Tcl_NameOfCommand.  Sourcing this file into Tcl runs the tests
     1.9 +# and generates output for errors.  No output means no errors were
    1.10 +# found.
    1.11 +#
    1.12 +# Copyright (c) 1993 The Regents of the University of California.
    1.13 +# Copyright (c) 1994-1996 Sun Microsystems, Inc.
    1.14 +# Copyright (c) 1998-1999 by Scriptics Corporation.
    1.15 +#
    1.16 +# See the file "license.terms" for information on usage and redistribution
    1.17 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.18 +#
    1.19 +# RCS: @(#) $Id: cmdInfo.test,v 1.7 2002/06/22 04:19:47 dgp Exp $
    1.20 +
    1.21 +if {[lsearch [namespace children] ::tcltest] == -1} {
    1.22 +    package require tcltest 2
    1.23 +    namespace import -force ::tcltest::*
    1.24 +}
    1.25 +
    1.26 +::tcltest::testConstraint testcmdinfo \
    1.27 +	[llength [info commands testcmdinfo]]
    1.28 +::tcltest::testConstraint testcmdtoken \
    1.29 +	[llength [info commands testcmdtoken]]
    1.30 +
    1.31 +test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
    1.32 +    testcmdinfo create x1
    1.33 +    testcmdinfo get x1
    1.34 +} {CmdProc1 original CmdDelProc1 original :: stringProc}
    1.35 +test cmdinfo-1.2 {command procedure and clientData} {testcmdinfo} {
    1.36 +    testcmdinfo create x1
    1.37 +    x1
    1.38 +} {CmdProc1 original}
    1.39 +test cmdinfo-1.3 {command procedure and clientData} {testcmdinfo} {
    1.40 +    testcmdinfo create x1
    1.41 +    testcmdinfo modify x1
    1.42 +    testcmdinfo get x1
    1.43 +} {CmdProc2 new_command_data CmdDelProc2 new_delete_data :: stringProc}
    1.44 +test cmdinfo-1.4 {command procedure and clientData} {testcmdinfo} {
    1.45 +    testcmdinfo create x1
    1.46 +    testcmdinfo modify x1
    1.47 +    x1
    1.48 +} {CmdProc2 new_command_data}
    1.49 +
    1.50 +test cmdinfo-2.1 {command deletion callbacks} {testcmdinfo} {
    1.51 +    testcmdinfo create x1
    1.52 +    testcmdinfo delete x1
    1.53 +} {CmdDelProc1 original}
    1.54 +test cmdinfo-2.2 {command deletion callbacks} {testcmdinfo} {
    1.55 +    testcmdinfo create x1
    1.56 +    testcmdinfo modify x1
    1.57 +    testcmdinfo delete x1
    1.58 +} {CmdDelProc2 new_delete_data}
    1.59 +
    1.60 +test cmdinfo-3.1 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
    1.61 +    testcmdinfo get non_existent
    1.62 +} {??}
    1.63 +test cmdinfo-3.2 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
    1.64 +    testcmdinfo create x1
    1.65 +    testcmdinfo modify x1
    1.66 +} 1
    1.67 +test cmdinfo-3.3 {Tcl_Get/SetCommandInfo return values} {testcmdinfo} {
    1.68 +    testcmdinfo modify non_existent
    1.69 +} 0
    1.70 +
    1.71 +test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
    1.72 +	{testcmdtoken} {
    1.73 +    set x [testcmdtoken create x1]
    1.74 +    rename x1 newName
    1.75 +    set y [testcmdtoken name $x]
    1.76 +    rename newName x1
    1.77 +    eval lappend y [testcmdtoken name $x]
    1.78 +} {newName ::newName x1 ::x1}
    1.79 +
    1.80 +catch {rename newTestCmd {}}
    1.81 +catch {rename newTestCmd2 {}}
    1.82 +
    1.83 +test cmdinfo-5.1 {Names for commands created when inside namespaces} \
    1.84 +	{testcmdtoken} {
    1.85 +    # create namespace cmdInfoNs1
    1.86 +    namespace eval cmdInfoNs1 {}   ;# creates namespace cmdInfoNs1
    1.87 +    # create namespace cmdInfoNs1::cmdInfoNs2 and execute a script in it
    1.88 +    set x [namespace eval cmdInfoNs1::cmdInfoNs2 {
    1.89 +        # the following creates a cmd in the global namespace
    1.90 +        testcmdtoken create testCmd
    1.91 +    }]
    1.92 +    set y [testcmdtoken name $x]
    1.93 +    rename ::testCmd newTestCmd
    1.94 +    eval lappend y [testcmdtoken name $x]
    1.95 +} {testCmd ::testCmd newTestCmd ::newTestCmd}
    1.96 +
    1.97 +test cmdinfo-6.1 {Names for commands created when outside namespaces} \
    1.98 +	{testcmdtoken} {
    1.99 +    set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
   1.100 +    set y [testcmdtoken name $x]
   1.101 +    rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
   1.102 +    eval lappend y [testcmdtoken name $x]
   1.103 +} {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
   1.104 +
   1.105 +# cleanup
   1.106 +catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
   1.107 +catch {rename x1 ""}
   1.108 +::tcltest::cleanupTests
   1.109 +return