URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [unix/] [dltest/] [pkga.c] - Blame information for rev 1765

Details | Compare with Previous | View Log


/*
 * pkga.c --
 *
 *      This file contains a simple Tcl package "pkga" that is intended
 *      for testing the Tcl dynamic loading facilities.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) pkga.c 1.4 96/02/15 12:30:35
 */
#include "tcl.h"
 
/*
 * Prototypes for procedures defined later in this file:
 */
 
static int      Pkga_EqCmd _ANSI_ARGS_((ClientData clientData,
                    Tcl_Interp *interp, int argc, char **argv));
static int      Pkga_QuoteCmd _ANSI_ARGS_((ClientData clientData,
                    Tcl_Interp *interp, int argc, char **argv));
 
/*
 *----------------------------------------------------------------------
 *
 * Pkga_EqCmd --
 *
 *      This procedure is invoked to process the "pkga_eq" Tcl command.
 *      It expects two arguments and returns 1 if they are the same,
 *      0 if they are different.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *----------------------------------------------------------------------
 */
 
static int
Pkga_EqCmd(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    if (argc != 3) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " string1 string2\"", (char *) NULL);
        return TCL_ERROR;
    }
 
    if (strcmp(argv[1], argv[2]) == 0) {
        interp->result = "1";
    } else {
        interp->result = "0";
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Pkga_quoteCmd --
 *
 *      This procedure is invoked to process the "pkga_quote" Tcl command.
 *      It expects one argument, which it returns as result.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      See the user documentation.
 *
 *----------------------------------------------------------------------
 */
 
static int
Pkga_QuoteCmd(dummy, interp, argc, argv)
    ClientData dummy;                   /* Not used. */
    Tcl_Interp *interp;                 /* Current interpreter. */
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Argument strings. */
{
    if (argc != 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " value\"", (char *) NULL);
        return TCL_ERROR;
    }
    strcpy(interp->result, argv[1]);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Pkga_Init --
 *
 *      This is a package initialization procedure, which is called
 *      by Tcl when this package is to be added to an interpreter.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
 
int
Pkga_Init(interp)
    Tcl_Interp *interp;         /* Interpreter in which the package is
                                 * to be made available. */
{
    int code;
 
    code = Tcl_PkgProvide(interp, "Pkga", "1.0");
    if (code != TCL_OK) {
        return code;
    }
    Tcl_CreateCommand(interp, "pkga_eq", Pkga_EqCmd, (ClientData) 0,
            (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "pkga_quote", Pkga_QuoteCmd, (ClientData) 0,
            (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

Line No.	Rev	Author	Line
1	578	markom	`/*`
2			`* pkga.c --`
3			`*`
4			`* This file contains a simple Tcl package "pkga" that is intended`
5			`* for testing the Tcl dynamic loading facilities.`
6			`*`
7			`* Copyright (c) 1995 Sun Microsystems, Inc.`
8			`*`
9			`* See the file "license.terms" for information on usage and redistribution`
10			`* of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
11			`*`
12			`* SCCS: @(#) pkga.c 1.4 96/02/15 12:30:35`
13			`*/`
14			`#include "tcl.h"`
15
16			`/*`
17			`* Prototypes for procedures defined later in this file:`
18			`*/`
19
20			`static int Pkga_EqCmd _ANSI_ARGS_((ClientData clientData,`
21			`Tcl_Interp interp, int argc, char *argv));`
22			`static int Pkga_QuoteCmd _ANSI_ARGS_((ClientData clientData,`
23			`Tcl_Interp interp, int argc, char *argv));`
24
25			`/*`
26			`*----------------------------------------------------------------------`
27			`*`
28			`* Pkga_EqCmd --`
29			`*`
30			`* This procedure is invoked to process the "pkga_eq" Tcl command.`
31			`* It expects two arguments and returns 1 if they are the same,`
32			`* 0 if they are different.`
33			`*`
34			`* Results:`
35			`* A standard Tcl result.`
36			`*`
37			`* Side effects:`
38			`* See the user documentation.`
39			`*`
40			`*----------------------------------------------------------------------`
41			`*/`
42
43			`static int`
44			`Pkga_EqCmd(dummy, interp, argc, argv)`
45			`ClientData dummy; /* Not used. */`
46			`Tcl_Interp interp; / Current interpreter. */`
47			`int argc; /* Number of arguments. */`
48			`char *argv; / Argument strings. */`
49			`{`
50			`if (argc != 3) {`
51			`Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],`
52			`" string1 string2\"", (char *) NULL);`
53			`return TCL_ERROR;`
54			`}`
55
56			`if (strcmp(argv[1], argv[2]) == 0) {`
57			`interp->result = "1";`
58			`} else {`
59			`interp->result = "0";`
60			`}`
61			`return TCL_OK;`
62			`}`
63
64			`/*`
65			`*----------------------------------------------------------------------`
66			`*`
67			`* Pkga_quoteCmd --`
68			`*`
69			`* This procedure is invoked to process the "pkga_quote" Tcl command.`
70			`* It expects one argument, which it returns as result.`
71			`*`
72			`* Results:`
73			`* A standard Tcl result.`
74			`*`
75			`* Side effects:`
76			`* See the user documentation.`
77			`*`
78			`*----------------------------------------------------------------------`
79			`*/`
80
81			`static int`
82			`Pkga_QuoteCmd(dummy, interp, argc, argv)`
83			`ClientData dummy; /* Not used. */`
84			`Tcl_Interp interp; / Current interpreter. */`
85			`int argc; /* Number of arguments. */`
86			`char *argv; / Argument strings. */`
87			`{`
88			`if (argc != 2) {`
89			`Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],`
90			`" value\"", (char *) NULL);`
91			`return TCL_ERROR;`
92			`}`
93			`strcpy(interp->result, argv[1]);`
94			`return TCL_OK;`
95			`}`
96
97			`/*`
98			`*----------------------------------------------------------------------`
99			`*`
100			`* Pkga_Init --`
101			`*`
102			`* This is a package initialization procedure, which is called`
103			`* by Tcl when this package is to be added to an interpreter.`
104			`*`
105			`* Results:`
106			`* None.`
107			`*`
108			`* Side effects:`
109			`* None.`
110			`*`
111			`*----------------------------------------------------------------------`
112			`*/`
113
114			`int`
115			`Pkga_Init(interp)`
116			`Tcl_Interp interp; / Interpreter in which the package is`
117			`* to be made available. */`
118			`{`
119			`int code;`
120
121			`code = Tcl_PkgProvide(interp, "Pkga", "1.0");`
122			`if (code != TCL_OK) {`
123			`return code;`
124			`}`
125			`Tcl_CreateCommand(interp, "pkga_eq", Pkga_EqCmd, (ClientData) 0,`
126			`(Tcl_CmdDeleteProc *) NULL);`
127			`Tcl_CreateCommand(interp, "pkga_quote", Pkga_QuoteCmd, (ClientData) 0,`
128			`(Tcl_CmdDeleteProc *) NULL);`
129			`return TCL_OK;`
130			`}`

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [unix/] [dltest/] [pkga.c] - Blame information for rev 1765