OSDN Git Service

* configure.in: Fix for autoconf 2.5.
[pf3gnuchains/pf3gnuchains3x.git] / tcl / unix / dltest / pkgd.c
1 /* 
2  * pkgd.c --
3  *
4  *      This file contains a simple Tcl package "pkgd" that is intended
5  *      for testing the Tcl dynamic loading facilities.  It can be used
6  *      in both safe and unsafe interpreters.
7  *
8  * Copyright (c) 1995 Sun Microsystems, Inc.
9  *
10  * See the file "license.terms" for information on usage and redistribution
11  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12  *
13  * RCS: @(#) $Id$
14  */
15
16 #include "tcl.h"
17
18 /*
19  * Prototypes for procedures defined later in this file:
20  */
21
22 static int    Pkgd_SubObjCmd _ANSI_ARGS_((ClientData clientData,
23                 Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
24 static int    Pkgd_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData,
25                 Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
26 \f
27 /*
28  *----------------------------------------------------------------------
29  *
30  * Pkgd_SubObjCmd --
31  *
32  *      This procedure is invoked to process the "pkgd_sub" Tcl command.
33  *      It expects two arguments and returns their difference.
34  *
35  * Results:
36  *      A standard Tcl result.
37  *
38  * Side effects:
39  *      See the user documentation.
40  *
41  *----------------------------------------------------------------------
42  */
43
44 static int
45 Pkgd_SubObjCmd(dummy, interp, objc, objv)
46     ClientData dummy;           /* Not used. */
47     Tcl_Interp *interp;         /* Current interpreter. */
48     int objc;                   /* Number of arguments. */
49     Tcl_Obj * CONST objv[];     /* Argument objects. */
50 {
51     int first, second;
52
53     if (objc != 3) {
54         Tcl_WrongNumArgs(interp, 1, objv, "num num");
55         return TCL_ERROR;
56     }
57     if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
58             || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
59         return TCL_ERROR;
60     }
61     Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
62     return TCL_OK;
63 }
64 \f
65 /*
66  *----------------------------------------------------------------------
67  *
68  * Pkgd_UnsafeCmd --
69  *
70  *      This procedure is invoked to process the "pkgd_unsafe" Tcl command.
71  *      It just returns a constant string.
72  *
73  * Results:
74  *      A standard Tcl result.
75  *
76  * Side effects:
77  *      See the user documentation.
78  *
79  *----------------------------------------------------------------------
80  */
81
82 static int
83 Pkgd_UnsafeObjCmd(dummy, interp, objc, objv)
84     ClientData dummy;           /* Not used. */
85     Tcl_Interp *interp;         /* Current interpreter. */
86     int objc;                   /* Number of arguments. */
87     Tcl_Obj * CONST objv[];     /* Argument objects. */
88 {
89     Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
90     return TCL_OK;
91 }
92 \f
93 /*
94  *----------------------------------------------------------------------
95  *
96  * Pkgd_Init --
97  *
98  *      This is a package initialization procedure, which is called
99  *      by Tcl when this package is to be added to an interpreter.
100  *
101  * Results:
102  *      None.
103  *
104  * Side effects:
105  *      None.
106  *
107  *----------------------------------------------------------------------
108  */
109
110 int
111 Pkgd_Init(interp)
112     Tcl_Interp *interp;         /* Interpreter in which the package is
113                                  * to be made available. */
114 {
115     int code;
116
117     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
118         return TCL_ERROR;
119     }
120     code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
121     if (code != TCL_OK) {
122         return code;
123     }
124     Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd,
125             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
126     Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd,
127             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
128     return TCL_OK;
129 }
130 \f
131 /*
132  *----------------------------------------------------------------------
133  *
134  * Pkgd_SafeInit --
135  *
136  *      This is a package initialization procedure, which is called
137  *      by Tcl when this package is to be added to an unsafe interpreter.
138  *
139  * Results:
140  *      None.
141  *
142  * Side effects:
143  *      None.
144  *
145  *----------------------------------------------------------------------
146  */
147
148 int
149 Pkgd_SafeInit(interp)
150     Tcl_Interp *interp;         /* Interpreter in which the package is
151                                  * to be made available. */
152 {
153     int code;
154
155     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
156         return TCL_ERROR;
157     }
158     code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
159     if (code != TCL_OK) {
160         return code;
161     }
162     Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, (ClientData) 0,
163             (Tcl_CmdDeleteProc *) NULL);
164     return TCL_OK;
165 }