1/* Chantest.c - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
2 *
3 * Sample extention to check that the stubs library is working correctly.
4 * This also serves to illustrate the use of the stubs library.
5 *
6 * $Id: chantest.c,v 1.1 2004/11/09 23:11:00 patthoyts Exp $
7 */
8
9#include <memchan.h>
10
11#undef TCL_STORAGE_CLASS
12#define TCL_STORAGE_CLASS DLLEXPORT
13
14int TestObjCmd(ClientData clientData, Tcl_Interp *interp,
15               int objc, Tcl_Obj *const objv[]);
16
17
18EXTERN int
19Chantest_Init(Tcl_Interp *interp)
20{
21    int r = TCL_OK;
22    const char *tcl = NULL;
23    const char *memchan = NULL;
24
25#ifdef USE_TCL_STUBS
26    tcl = Tcl_InitStubs(interp, "8.4", 0);
27#endif
28
29#ifdef USE_MEMCHAN_STUBS
30    memchan = Memchan_InitStubs(interp, "2.2", 0);
31#endif
32
33    if (tcl == NULL || memchan == NULL) {
34        Tcl_SetResult(interp, "error loading memchan via stubs", TCL_STATIC);
35        r = TCL_ERROR;
36    } else {
37        Tcl_CreateObjCommand(interp, "chantest", TestObjCmd,
38                             (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
39        r = Tcl_PkgProvide(interp, "Chantest", "0.1");
40    }
41    return r;
42}
43
44int
45TestObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
46{
47    Tcl_Channel chan = NULL, chan2 = NULL;
48    Tcl_Obj *resObj = NULL;
49    char *type = "";
50    int r = TCL_OK;
51
52    if (objc != 2) {
53        Tcl_WrongNumArgs(interp, 1, objv, "type");
54        return TCL_ERROR;
55    }
56
57    type = Tcl_GetString(objv[1]);
58    if (strcmp("memchan", type) == 0) {
59        chan = Memchan_CreateMemoryChannel(interp, 0);
60    } else if (strcmp("fifo", type) == 0) {
61        chan = Memchan_CreateFifoChannel(interp);
62    } else if (strcmp("fifo2", type) == 0) {
63        Memchan_CreateFifo2Channel(interp, &chan, &chan2);
64    } else if (strcmp("null", type) == 0) {
65        chan = Memchan_CreateNullChannel(interp);
66    } else if (strcmp("zero", type) == 0) {
67        chan = Memchan_CreateZeroChannel(interp);
68    } else if (strcmp("random", type) == 0) {
69        chan = Memchan_CreateRandomChannel(interp);
70    }
71
72    if (chan2 != NULL) {
73        Tcl_Obj *name[2];
74        name[0] = Tcl_NewStringObj(Tcl_GetChannelName(chan), -1);
75        name[1] = Tcl_NewStringObj(Tcl_GetChannelName(chan2), -1);
76        resObj = Tcl_NewListObj(2, name);
77        r = TCL_OK;
78    } else if (chan != NULL) {
79        resObj = Tcl_NewStringObj(Tcl_GetChannelName(chan), -1);
80        r = TCL_OK;
81    } else {
82        resObj = Tcl_NewStringObj("error", -1);
83        r = TCL_ERROR;
84    }
85
86    Tcl_SetObjResult(interp, resObj);
87    return r;
88}
89