OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [rtos/] [ecos-2.0/] [tools/] [src/] [libcdl/] [testsuite/] [libcdl/] [cdl3.cxx] - Blame information for rev 404

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 26 unneback
//==========================================================================
2
//
3
//      cdl3.cxx
4
//
5
//      Basic testing of the CdlInterpreter class
6
//
7
//==========================================================================
8
//####COPYRIGHTBEGIN####
9
//                                                                          
10
// ----------------------------------------------------------------------------
11
// Copyright (C) 1999, 2000 Red Hat, Inc.
12
//
13
// This file is part of the eCos host tools.
14
//
15
// This program is free software; you can redistribute it and/or modify it 
16
// under the terms of the GNU General Public License as published by the Free 
17
// Software Foundation; either version 2 of the License, or (at your option) 
18
// any later version.
19
// 
20
// This program is distributed in the hope that it will be useful, but WITHOUT 
21
// ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
22
// FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for 
23
// more details.
24
// 
25
// You should have received a copy of the GNU General Public License along with
26
// this program; if not, write to the Free Software Foundation, Inc., 
27
// 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
28
//
29
// ----------------------------------------------------------------------------
30
//                                                                          
31
//####COPYRIGHTEND####
32
//==========================================================================
33
//#####DESCRIPTIONBEGIN####                                             
34
//
35
// Author(s):           bartv
36
// Contributors:        bartv
37
// Date:                1999-01-21
38
// Description:         This test case deals with simple uses of the
39
//                      CdlInterpreter class, independent from any
40
//                      configuration data.
41
//
42
//####DESCRIPTIONEND####
43
//==========================================================================
44
 
45
#include <cstdio>
46
#include <cdlconfig.h>
47
#include <cdl.hxx>
48
#include <cyg/infra/cyg_ass.h>
49
#include <cyg/infra/cyg_trac.h>
50
#include <cyg/infra/testcase.h>
51
#include <cstdlib>
52
 
53
static CdlInterpreter interp = 0;
54
 
55
static int
56
extra_command1(ClientData data, Tcl_Interp* tcl_interp, int argc, char** argv)
57
{
58
    if (static_cast<CdlInterpreter>(data) != interp) {
59
        char* msg = "ClientData does not correspond to interpreter";
60
        Tcl_SetResult(tcl_interp, msg, TCL_STATIC);
61
        CYG_TEST_FAIL(msg);
62
        return TCL_ERROR;
63
    }
64
    if ((3 != argc) ||
65
        (0 != strcmp("extra_command1", argv[0])) ||
66
        (0 != strcmp("first_arg",      argv[1])) ||
67
        (0 != strcmp("second_arg",     argv[2]))) {
68
        char* msg = "Wrong arguments passed to extra_command1";
69
        interp->set_result(msg);
70
        CYG_TEST_FAIL(msg);
71
        return TCL_ERROR;
72
    }
73
    interp->set_result("To be or not to be");
74
    return TCL_OK;
75
}
76
 
77
static int
78
extra_command2(ClientData data, Tcl_Interp* tcl_interp, int argc, char** argv)
79
{
80
    if (0 != data) {
81
        char*msg = "ClientData should be zero here";
82
        Tcl_SetResult(tcl_interp, msg, TCL_STATIC);
83
        CYG_TEST_FAIL(msg);
84
        return TCL_ERROR;
85
    }
86
    if ((2 != argc) ||
87
        (0 != strcmp("extra_command2", argv[0])) ||
88
        (0 != strcmp("third_arg",      argv[1]))) {
89
        char* msg = "Wrong arguments passed to extra_command2";
90
        Tcl_SetResult(tcl_interp, msg, TCL_STATIC);
91
        CYG_TEST_FAIL(msg);
92
        return TCL_ERROR;
93
    }
94
    Tcl_SetResult(tcl_interp, "That is the question", TCL_STATIC);
95
    return TCL_OK;
96
}
97
 
98
int
99
main(int argc, char** argv)
100
{
101
    // Start by creating a simple interpreter using default settings
102
    bool ok = true;
103
    interp = CdlInterpreterBody::make();
104
    if (0 == interp) {
105
        CYG_TEST_FAIL_FINISH("Unable to create a new interpreter with default settings");
106
    }
107
    if ((!interp->check_this(cyg_quick)) ||
108
        (!interp->check_this(cyg_extreme))) {
109
        CYG_TEST_FAIL("check_this() failed");
110
        ok = false;
111
    }
112
    if ((0 != interp->get_configuration()) ||
113
        (0 != interp->get_package())) {
114
        CYG_TEST_FAIL("a new interpreter should not be associated with any package or configuration");
115
        ok = false;
116
    }
117
 
118
    // Now try evaluating a very simple script
119
    std::string str_result;
120
    if ((TCL_OK != interp->eval("expr 2 * 2 * 2\n", str_result)) ||
121
        ("8" != str_result)) {
122
        CYG_TEST_FAIL("simple command execution failed");
123
        ok = false;
124
    }
125
    // And something a bit more interesting
126
    std::string fibonaci = "                                                            \n\
127
proc fibonaci { arg } {                                                                 \n\
128
    if { $arg < 3 } {                                                                   \n\
129
        return 1                                                                        \n\
130
    } else {                                                                            \n\
131
        set result [expr [fibonaci [expr $arg - 1]] + [fibonaci [expr $arg - 2]]]       \n\
132
        return $result                                                                  \n\
133
    }                                                                                   \n\
134
}                                                                                       \n\
135
return [fibonaci 10]                                                                    \n\
136
";
137
    if ((TCL_OK != interp->eval(fibonaci, str_result)) ||
138
        ("55" != str_result)) {
139
        CYG_TEST_FAIL("full script execution failed");
140
        ok = false;
141
    }
142
 
143
    // A new interpreter should not know about "extra_command1"
144
    if ((TCL_OK != interp->eval("info command extra_command1", str_result)) ||
145
        ("" != str_result)) {
146
        CYG_TEST_FAIL("new interpreter should not have an extra_command1 command");
147
        ok = false;
148
    }
149
    try {
150
        interp->add_command("extra_command1", &extra_command1, 0);
151
        if ((TCL_OK != interp->eval("info command extra_command1", str_result)) ||
152
            ("extra_command1" != str_result)) {
153
            CYG_TEST_FAIL("interpreter does not know the new extra_command1 command");
154
            ok = false;
155
        }
156
        if ((TCL_OK != interp->eval("extra_command1 first_arg second_arg", str_result)) ||
157
            ("To be or not to be" != str_result)) {
158
            CYG_TEST_FAIL("execution of a new command failed");
159
            ok = false;
160
        }
161
        interp->remove_command("extra_command1");
162
    }
163
    catch(std::bad_alloc e) {
164
        CYG_TEST_FAIL("unable to add a new command to the interpreter");
165
        ok = false;
166
    }
167
 
168
    // Check the variables support
169
    try {
170
        interp->set_variable("some_variable", "random_value");
171
    }
172
    catch(std::bad_alloc e) {
173
        CYG_TEST_FAIL("unable to set a global variable inside the interpreter");
174
        ok = false;
175
    }
176
    if ("random_value" != interp->get_variable("some_variable")) {
177
        CYG_TEST_FAIL("unable to retrieve global variable setting");
178
        ok = false;
179
    }
180
    // Make absolutely sure the variable exists
181
    if ((TCL_OK != interp->eval("info exists ::some_variable", str_result)) ||
182
        ("1" != str_result)) {
183
        CYG_TEST_FAIL("Tcl code does not know about new global variable");
184
    }
185
    interp->unset_variable("some_variable");
186
    if ("" != interp->get_variable("some_variable")) {
187
        CYG_TEST_FAIL("variable still exists after it has been removed");
188
        ok = false;
189
    }
190
 
191
    // Check the AssocData support
192
    if (0 != interp->get_assoc_data("some_key")) {
193
        CYG_TEST_FAIL("unexpected assoc data already present");
194
        ok = false;
195
    }
196
    interp->set_assoc_data("some_key", static_cast<ClientData>(&ok), 0);
197
    if (&ok != static_cast<bool*>(interp->get_assoc_data("some_key"))) {
198
        CYG_TEST_FAIL("unable to retrieve assoc data");
199
        ok = false;
200
    }
201
    interp->delete_assoc_data("some_key");
202
    if (0 != interp->get_assoc_data("some_key")) {
203
        CYG_TEST_FAIL("assoc data still present after retrieval");
204
        ok = false;
205
    }
206
 
207
    // Make the interpreter safe. This should remove the file command.
208
    if ((TCL_OK != interp->eval("info command file", str_result)) ||
209
        ("file" != str_result)) {
210
        CYG_TEST_FAIL("interpreter should still have the file command");
211
        ok = false;
212
    }
213
    interp->make_safe();
214
    if ((TCL_OK != interp->eval("info command file", str_result)) ||
215
        ("" != str_result)) {
216
        CYG_TEST_FAIL("interpreter should no longer have the file command");
217
        ok = false;
218
    }
219
 
220
    // This is just a compilation check to make sure that interpreters can
221
    // be deleted.
222
#ifdef CYGBLD_LIBCDL_USE_SMART_POINTERS
223
    interp.destroy();
224
#else
225
    delete interp;
226
    interp = 0;
227
#endif    
228
 
229
    if (ok) {
230
        CYG_TEST_PASS("interpreter with default settings is functional");
231
    }
232
    ok = true;
233
 
234
    // Now try to create a new Tcl interpreter, register the extra command
235
    // at the Tcl level, and turn it into a CdlInterpreter
236
    Tcl_Interp* tcl_interp = Tcl_CreateInterp();
237
    if (0 == tcl_interp) {
238
        CYG_TEST_FAIL_FINISH("unable to create new Tcl interpreter");
239
    }
240
    if (0 == Tcl_CreateCommand(tcl_interp, "extra_command2", &extra_command2, 0, 0)) {
241
        CYG_TEST_FAIL_FINISH("unable to add new command to Tcl interpreter");
242
    }
243
 
244
    // And turn the Tcl interpreter into a Cdl one.
245
    interp = CdlInterpreterBody::make(tcl_interp);
246
    if (0 == interp) {
247
        CYG_TEST_FAIL_FINISH("unable to create new CDL interpreter using existing Tcl one");
248
        ok = false;
249
    }
250
    if (!interp->check_this(cyg_quick)) {
251
        CYG_TEST_FAIL_FINISH("new CDL interpreter fails checks");
252
        ok = false;
253
    }
254
 
255
    // The new interpreter should not have an extra_command1 command.
256
    if ((TCL_OK != interp->eval("info command extra_command1", str_result)) ||
257
        ("" != str_result)) {
258
        CYG_TEST_FAIL("new interpreter should not have an extra_command1 command");
259
        ok = false;
260
    }
261
    // But it should still have an extra_command2 command
262
    if ((TCL_OK != interp->eval("info command extra_command2", str_result)) ||
263
        ("extra_command2" != str_result)) {
264
        CYG_TEST_FAIL("new interpreter should have an extra_command2 command");
265
        ok = false;
266
    }
267
    // And that command should work
268
    if ((TCL_OK != interp->eval("extra_command2 third_arg", str_result)) ||
269
        ("That is the question" != str_result)) {
270
        CYG_TEST_FAIL("extra_command2 command not functional");
271
        ok = false;
272
    }
273
    // Get rid of the CdlInterpreter object. The Tcl interpreter should still
274
    // be valid.
275
#ifdef CYGBLD_LIBCDL_USE_SMART_POINTERS
276
    interp.destroy();
277
#else
278
    delete interp;
279
    interp = 0;
280
#endif
281
    if (Tcl_InterpDeleted(tcl_interp)) {
282
        CYG_TEST_FAIL("Tcl interpreter deleted when it should still be around");
283
        ok = false;
284
    }
285
 
286
    if (ok) {
287
        CYG_TEST_PASS("custom interpreter is functional");
288
    }
289
 
290
    return EXIT_SUCCESS;
291
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.