tcl/unix/dltest/pkgb.c

   1 /*
   2  * pkgb.c --
   3  *
   4  *      This file contains a simple Tcl package "pkgb" 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  * SCCS: @(#) pkgb.c 1.4 96/02/15 12:30:34
  14  */
  15 #include "tcl.h"
  16
  17 /*
  18  * Prototypes for procedures defined later in this file:
  19  */
  20
  21 static int      Pkgb_SubCmd _ANSI_ARGS_((ClientData clientData,
  22                     Tcl_Interp *interp, int argc, char **argv));
  23 static int      Pkgb_UnsafeCmd _ANSI_ARGS_((ClientData clientData,
  24                     Tcl_Interp *interp, int argc, char **argv));
  25 \f
  26 /*
  27  *----------------------------------------------------------------------
  28  *
  29  * Pkgb_SubCmd --
  30  *
  31  *      This procedure is invoked to process the "pkgb_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
  43 static int
  44 Pkgb_SubCmd(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     int first, second;
  51
  52     if (argc != 3) {
  53         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  54                 " num num\"", (char *) NULL);
  55         return TCL_ERROR;
  56     }
  57     if ((Tcl_GetInt(interp, argv[1], &first) != TCL_OK)
  58             || (Tcl_GetInt(interp, argv[2], &second) != TCL_OK)) {
  59         return TCL_ERROR;
  60     }
  61     sprintf(interp->result, "%d", first - second);
  62     return TCL_OK;
  63 }
  64 \f
  65 /*
  66  *----------------------------------------------------------------------
  67  *
  68  * Pkgb_UnsafeCmd --
  69  *
  70  *      This procedure is invoked to process the "pkgb_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 Pkgb_UnsafeCmd(dummy, interp, argc, argv)
  84     ClientData dummy;                   /* Not used. */
  85     Tcl_Interp *interp;                 /* Current interpreter. */
  86     int argc;                           /* Number of arguments. */
  87     char **argv;                        /* Argument strings. */
  88 {
  89     interp->result = "unsafe command invoked";
  90     return TCL_OK;
  91 }
  92 \f
  93 /*
  94  *----------------------------------------------------------------------
  95  *
  96  * Pkgb_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 Pkgb_Init(interp)
 112     Tcl_Interp *interp;         /* Interpreter in which the package is
 113                                  * to be made available. */
 114 {
 115     int code;
 116
 117     code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
 118     if (code != TCL_OK) {
 119         return code;
 120     }
 121     Tcl_CreateCommand(interp, "pkgb_sub", Pkgb_SubCmd, (ClientData) 0,
 122             (Tcl_CmdDeleteProc *) NULL);
 123     Tcl_CreateCommand(interp, "pkgb_unsafe", Pkgb_UnsafeCmd, (ClientData) 0,
 124             (Tcl_CmdDeleteProc *) NULL);
 125     return TCL_OK;
 126 }
 127 \f
 128 /*
 129  *----------------------------------------------------------------------
 130  *
 131  * Pkgb_SafeInit --
 132  *
 133  *      This is a package initialization procedure, which is called
 134  *      by Tcl when this package is to be added to an unsafe interpreter.
 135  *
 136  * Results:
 137  *      None.
 138  *
 139  * Side effects:
 140  *      None.
 141  *
 142  *----------------------------------------------------------------------
 143  */
 144
 145 int
 146 Pkgb_SafeInit(interp)
 147     Tcl_Interp *interp;         /* Interpreter in which the package is
 148                                  * to be made available. */
 149 {
 150     Tcl_CreateCommand(interp, "pkgb_sub", Pkgb_SubCmd, (ClientData) 0,
 151             (Tcl_CmdDeleteProc *) NULL);
 152     return TCL_OK;
 153 }