--- /dev/null
+//==========================================================================
+//
+// cdl3.cxx
+//
+// Basic testing of the CdlInterpreter class
+//
+//==========================================================================
+//####COPYRIGHTBEGIN####
+//
+// ----------------------------------------------------------------------------
+// Copyright (C) 1999, 2000 Red Hat, Inc.
+//
+// This file is part of the eCos host tools.
+//
+// This program is free software; you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by the Free
+// Software Foundation; either version 2 of the License, or (at your option)
+// any later version.
+//
+// This program is distributed in the hope that it will be useful, but WITHOUT
+// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+// FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+// more details.
+//
+// You should have received a copy of the GNU General Public License along with
+// this program; if not, write to the Free Software Foundation, Inc.,
+// 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+//
+// ----------------------------------------------------------------------------
+//
+//####COPYRIGHTEND####
+//==========================================================================
+//#####DESCRIPTIONBEGIN####
+//
+// Author(s): bartv
+// Contributors: bartv
+// Date: 1999-01-21
+// Description: This test case deals with simple uses of the
+// CdlInterpreter class, independent from any
+// configuration data.
+//
+//####DESCRIPTIONEND####
+//==========================================================================
+
+#include <cstdio>
+#include <cdlconfig.h>
+#include <cdl.hxx>
+#include <cyg/infra/cyg_ass.h>
+#include <cyg/infra/cyg_trac.h>
+#include <cyg/infra/testcase.h>
+#include <cstdlib>
+
+static CdlInterpreter interp = 0;
+
+static int
+extra_command1(ClientData data, Tcl_Interp* tcl_interp, int argc, char** argv)
+{
+ if (static_cast<CdlInterpreter>(data) != interp) {
+ char* msg = "ClientData does not correspond to interpreter";
+ Tcl_SetResult(tcl_interp, msg, TCL_STATIC);
+ CYG_TEST_FAIL(msg);
+ return TCL_ERROR;
+ }
+ if ((3 != argc) ||
+ (0 != strcmp("extra_command1", argv[0])) ||
+ (0 != strcmp("first_arg", argv[1])) ||
+ (0 != strcmp("second_arg", argv[2]))) {
+ char* msg = "Wrong arguments passed to extra_command1";
+ interp->set_result(msg);
+ CYG_TEST_FAIL(msg);
+ return TCL_ERROR;
+ }
+ interp->set_result("To be or not to be");
+ return TCL_OK;
+}
+
+static int
+extra_command2(ClientData data, Tcl_Interp* tcl_interp, int argc, char** argv)
+{
+ if (0 != data) {
+ char*msg = "ClientData should be zero here";
+ Tcl_SetResult(tcl_interp, msg, TCL_STATIC);
+ CYG_TEST_FAIL(msg);
+ return TCL_ERROR;
+ }
+ if ((2 != argc) ||
+ (0 != strcmp("extra_command2", argv[0])) ||
+ (0 != strcmp("third_arg", argv[1]))) {
+ char* msg = "Wrong arguments passed to extra_command2";
+ Tcl_SetResult(tcl_interp, msg, TCL_STATIC);
+ CYG_TEST_FAIL(msg);
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(tcl_interp, "That is the question", TCL_STATIC);
+ return TCL_OK;
+}
+
+int
+main(int argc, char** argv)
+{
+ // Start by creating a simple interpreter using default settings
+ bool ok = true;
+ interp = CdlInterpreterBody::make();
+ if (0 == interp) {
+ CYG_TEST_FAIL_FINISH("Unable to create a new interpreter with default settings");
+ }
+ if ((!interp->check_this(cyg_quick)) ||
+ (!interp->check_this(cyg_extreme))) {
+ CYG_TEST_FAIL("check_this() failed");
+ ok = false;
+ }
+ if ((0 != interp->get_configuration()) ||
+ (0 != interp->get_package())) {
+ CYG_TEST_FAIL("a new interpreter should not be associated with any package or configuration");
+ ok = false;
+ }
+
+ // Now try evaluating a very simple script
+ std::string str_result;
+ if ((TCL_OK != interp->eval("expr 2 * 2 * 2\n", str_result)) ||
+ ("8" != str_result)) {
+ CYG_TEST_FAIL("simple command execution failed");
+ ok = false;
+ }
+ // And something a bit more interesting
+ std::string fibonaci = " \n\
+proc fibonaci { arg } { \n\
+ if { $arg < 3 } { \n\
+ return 1 \n\
+ } else { \n\
+ set result [expr [fibonaci [expr $arg - 1]] + [fibonaci [expr $arg - 2]]] \n\
+ return $result \n\
+ } \n\
+} \n\
+return [fibonaci 10] \n\
+";
+ if ((TCL_OK != interp->eval(fibonaci, str_result)) ||
+ ("55" != str_result)) {
+ CYG_TEST_FAIL("full script execution failed");
+ ok = false;
+ }
+
+ // A new interpreter should not know about "extra_command1"
+ if ((TCL_OK != interp->eval("info command extra_command1", str_result)) ||
+ ("" != str_result)) {
+ CYG_TEST_FAIL("new interpreter should not have an extra_command1 command");
+ ok = false;
+ }
+ try {
+ interp->add_command("extra_command1", &extra_command1, 0);
+ if ((TCL_OK != interp->eval("info command extra_command1", str_result)) ||
+ ("extra_command1" != str_result)) {
+ CYG_TEST_FAIL("interpreter does not know the new extra_command1 command");
+ ok = false;
+ }
+ if ((TCL_OK != interp->eval("extra_command1 first_arg second_arg", str_result)) ||
+ ("To be or not to be" != str_result)) {
+ CYG_TEST_FAIL("execution of a new command failed");
+ ok = false;
+ }
+ interp->remove_command("extra_command1");
+ }
+ catch(std::bad_alloc e) {
+ CYG_TEST_FAIL("unable to add a new command to the interpreter");
+ ok = false;
+ }
+
+ // Check the variables support
+ try {
+ interp->set_variable("some_variable", "random_value");
+ }
+ catch(std::bad_alloc e) {
+ CYG_TEST_FAIL("unable to set a global variable inside the interpreter");
+ ok = false;
+ }
+ if ("random_value" != interp->get_variable("some_variable")) {
+ CYG_TEST_FAIL("unable to retrieve global variable setting");
+ ok = false;
+ }
+ // Make absolutely sure the variable exists
+ if ((TCL_OK != interp->eval("info exists ::some_variable", str_result)) ||
+ ("1" != str_result)) {
+ CYG_TEST_FAIL("Tcl code does not know about new global variable");
+ }
+ interp->unset_variable("some_variable");
+ if ("" != interp->get_variable("some_variable")) {
+ CYG_TEST_FAIL("variable still exists after it has been removed");
+ ok = false;
+ }
+
+ // Check the AssocData support
+ if (0 != interp->get_assoc_data("some_key")) {
+ CYG_TEST_FAIL("unexpected assoc data already present");
+ ok = false;
+ }
+ interp->set_assoc_data("some_key", static_cast<ClientData>(&ok), 0);
+ if (&ok != static_cast<bool*>(interp->get_assoc_data("some_key"))) {
+ CYG_TEST_FAIL("unable to retrieve assoc data");
+ ok = false;
+ }
+ interp->delete_assoc_data("some_key");
+ if (0 != interp->get_assoc_data("some_key")) {
+ CYG_TEST_FAIL("assoc data still present after retrieval");
+ ok = false;
+ }
+
+ // Make the interpreter safe. This should remove the file command.
+ if ((TCL_OK != interp->eval("info command file", str_result)) ||
+ ("file" != str_result)) {
+ CYG_TEST_FAIL("interpreter should still have the file command");
+ ok = false;
+ }
+ interp->make_safe();
+ if ((TCL_OK != interp->eval("info command file", str_result)) ||
+ ("" != str_result)) {
+ CYG_TEST_FAIL("interpreter should no longer have the file command");
+ ok = false;
+ }
+
+ // This is just a compilation check to make sure that interpreters can
+ // be deleted.
+#ifdef CYGBLD_LIBCDL_USE_SMART_POINTERS
+ interp.destroy();
+#else
+ delete interp;
+ interp = 0;
+#endif
+
+ if (ok) {
+ CYG_TEST_PASS("interpreter with default settings is functional");
+ }
+ ok = true;
+
+ // Now try to create a new Tcl interpreter, register the extra command
+ // at the Tcl level, and turn it into a CdlInterpreter
+ Tcl_Interp* tcl_interp = Tcl_CreateInterp();
+ if (0 == tcl_interp) {
+ CYG_TEST_FAIL_FINISH("unable to create new Tcl interpreter");
+ }
+ if (0 == Tcl_CreateCommand(tcl_interp, "extra_command2", &extra_command2, 0, 0)) {
+ CYG_TEST_FAIL_FINISH("unable to add new command to Tcl interpreter");
+ }
+
+ // And turn the Tcl interpreter into a Cdl one.
+ interp = CdlInterpreterBody::make(tcl_interp);
+ if (0 == interp) {
+ CYG_TEST_FAIL_FINISH("unable to create new CDL interpreter using existing Tcl one");
+ ok = false;
+ }
+ if (!interp->check_this(cyg_quick)) {
+ CYG_TEST_FAIL_FINISH("new CDL interpreter fails checks");
+ ok = false;
+ }
+
+ // The new interpreter should not have an extra_command1 command.
+ if ((TCL_OK != interp->eval("info command extra_command1", str_result)) ||
+ ("" != str_result)) {
+ CYG_TEST_FAIL("new interpreter should not have an extra_command1 command");
+ ok = false;
+ }
+ // But it should still have an extra_command2 command
+ if ((TCL_OK != interp->eval("info command extra_command2", str_result)) ||
+ ("extra_command2" != str_result)) {
+ CYG_TEST_FAIL("new interpreter should have an extra_command2 command");
+ ok = false;
+ }
+ // And that command should work
+ if ((TCL_OK != interp->eval("extra_command2 third_arg", str_result)) ||
+ ("That is the question" != str_result)) {
+ CYG_TEST_FAIL("extra_command2 command not functional");
+ ok = false;
+ }
+ // Get rid of the CdlInterpreter object. The Tcl interpreter should still
+ // be valid.
+#ifdef CYGBLD_LIBCDL_USE_SMART_POINTERS
+ interp.destroy();
+#else
+ delete interp;
+ interp = 0;
+#endif
+ if (Tcl_InterpDeleted(tcl_interp)) {
+ CYG_TEST_FAIL("Tcl interpreter deleted when it should still be around");
+ ok = false;
+ }
+
+ if (ok) {
+ CYG_TEST_PASS("custom interpreter is functional");
+ }
+
+ return EXIT_SUCCESS;
+}
projects / karo-tx-redboot.git / blobdiff