1/*
2 * pkgc.c --
3 *
4 *	This file contains a simple Tcl package "pkgc" 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: pkgc.c,v 1.4 2000/04/04 08:06:07 hobbs Exp $
14 */
15#include "tcl.h"
16
17/*
18 * Prototypes for procedures defined later in this file:
19 */
20
21static int    Pkgc_SubObjCmd _ANSI_ARGS_((ClientData clientData,
22		Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
23static int    Pkgc_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData,
24		Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
25
26/*
27 *----------------------------------------------------------------------
28 *
29 * Pkgc_SubObjCmd --
30 *
31 *	This procedure is invoked to process the "pkgc_sub" Tcl command.
32 *	It expects two arguments and returns their difference.
33 *
34 * Results:
35 *	A standard Tcl result.
36 *
37 * Side effects:
38 *	See the user documentation.
39 *
40 *----------------------------------------------------------------------
41 */
42
43static int
44Pkgc_SubObjCmd(dummy, interp, objc, objv)
45    ClientData dummy;		/* Not used. */
46    Tcl_Interp *interp;		/* Current interpreter. */
47    int objc;			/* Number of arguments. */
48    Tcl_Obj * CONST objv[];	/* Argument objects. */
49{
50    int first, second;
51
52    if (objc != 3) {
53	Tcl_WrongNumArgs(interp, 1, objv, "num num");
54	return TCL_ERROR;
55    }
56    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
57	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
58	return TCL_ERROR;
59    }
60    Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
61    return TCL_OK;
62}
63
64/*
65 *----------------------------------------------------------------------
66 *
67 * Pkgc_UnsafeCmd --
68 *
69 *	This procedure is invoked to process the "pkgc_unsafe" Tcl command.
70 *	It just returns a constant string.
71 *
72 * Results:
73 *	A standard Tcl result.
74 *
75 * Side effects:
76 *	See the user documentation.
77 *
78 *----------------------------------------------------------------------
79 */
80
81static int
82Pkgc_UnsafeObjCmd(dummy, interp, objc, objv)
83    ClientData dummy;		/* Not used. */
84    Tcl_Interp *interp;		/* Current interpreter. */
85    int objc;			/* Number of arguments. */
86    Tcl_Obj * CONST objv[];	/* Argument objects. */
87{
88    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
89    return TCL_OK;
90}
91
92/*
93 *----------------------------------------------------------------------
94 *
95 * Pkgc_Init --
96 *
97 *	This is a package initialization procedure, which is called
98 *	by Tcl when this package is to be added to an interpreter.
99 *
100 * Results:
101 *	None.
102 *
103 * Side effects:
104 *	None.
105 *
106 *----------------------------------------------------------------------
107 */
108
109int
110Pkgc_Init(interp)
111    Tcl_Interp *interp;		/* Interpreter in which the package is
112				 * to be made available. */
113{
114    int code;
115
116    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
117	return TCL_ERROR;
118    }
119    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
120    if (code != TCL_OK) {
121	return code;
122    }
123    Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd,
124	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
125    Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd,
126	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
127    return TCL_OK;
128}
129
130/*
131 *----------------------------------------------------------------------
132 *
133 * Pkgc_SafeInit --
134 *
135 *	This is a package initialization procedure, which is called
136 *	by Tcl when this package is to be added to an unsafe interpreter.
137 *
138 * Results:
139 *	None.
140 *
141 * Side effects:
142 *	None.
143 *
144 *----------------------------------------------------------------------
145 */
146
147int
148Pkgc_SafeInit(interp)
149    Tcl_Interp *interp;		/* Interpreter in which the package is
150				 * to be made available. */
151{
152    int code;
153
154    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
155	return TCL_ERROR;
156    }
157    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
158    if (code != TCL_OK) {
159      return code;
160    }
161    Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, (ClientData) 0,
162	    (Tcl_CmdDeleteProc *) NULL);
163    return TCL_OK;
164}
165