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: pkgd.c,v 1.4 2000/04/04 08:06:07 hobbs Exp $
14 */
15
16#include "tcl.h"
17
18/*
19 * Prototypes for procedures defined later in this file:
20 */
21
22static int    Pkgd_SubObjCmd _ANSI_ARGS_((ClientData clientData,
23		Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
24static int    Pkgd_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData,
25		Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
26
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
44static int
45Pkgd_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
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
82static int
83Pkgd_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
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
110int
111Pkgd_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
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
148int
149Pkgd_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}
166