开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tclTestObj.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：34k
源码类别：

通讯编程

开发平台：

Visual C++

tclTestObj.c：源码内容
  1. /* 
  2.  * tclTestObj.c --
  3.  *
  4.  * This file contains C command procedures for the additional Tcl
  5.  * commands that are used for testing implementations of the Tcl object
  6.  * types. These commands are not normally included in Tcl
  7.  * applications; they're only used for testing.
  8.  *
  9.  * Copyright (c) 1995-1998 Sun Microsystems, Inc.
  10.  * Copyright (c) 1999 by Scriptics Corporation.
  11.  *
  12.  * See the file "license.terms" for information on usage and redistribution
  13.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14.  *
  15.  * RCS: @(#) $Id: tclTestObj.c,v 1.12 2002/12/04 13:09:24 vincentdarley Exp $
  16.  */
  18. #include "tclInt.h"
  20. /*
  21.  * An array of Tcl_Obj pointers used in the commands that operate on or get
  22.  * the values of Tcl object-valued variables. varPtr[i] is the i-th
  23.  * variable's Tcl_Obj *.
  24.  */
  26. #define NUMBER_OF_OBJECT_VARS 20
  27. static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS];
  29. /*
  30.  * Forward declarations for procedures defined later in this file:
  31.  */
  33. static int CheckIfVarUnset _ANSI_ARGS_((Tcl_Interp *interp,
  34.     int varIndex));
  35. static int GetVariableIndex _ANSI_ARGS_((Tcl_Interp *interp,
  36.     char *string, int *indexPtr));
  37. static void SetVarToObj _ANSI_ARGS_((int varIndex,
  38.     Tcl_Obj *objPtr));
  39. int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
  40. static int TestbooleanobjCmd _ANSI_ARGS_((ClientData dummy,
  41.     Tcl_Interp *interp, int objc,
  42.     Tcl_Obj *CONST objv[]));
  43. static int TestconvertobjCmd _ANSI_ARGS_((ClientData dummy,
  44.     Tcl_Interp *interp, int objc,
  45.     Tcl_Obj *CONST objv[]));
  46. static int TestdoubleobjCmd _ANSI_ARGS_((ClientData dummy,
  47.     Tcl_Interp *interp, int objc,
  48.     Tcl_Obj *CONST objv[]));
  49. static int TestindexobjCmd _ANSI_ARGS_((ClientData dummy,
  50.     Tcl_Interp *interp, int objc,
  51.     Tcl_Obj *CONST objv[]));
  52. static int TestintobjCmd _ANSI_ARGS_((ClientData dummy,
  53.     Tcl_Interp *interp, int objc,
  54.     Tcl_Obj *CONST objv[]));
  55. static int TestobjCmd _ANSI_ARGS_((ClientData dummy,
  56.     Tcl_Interp *interp, int objc,
  57.     Tcl_Obj *CONST objv[]));
  58. static int TeststringobjCmd _ANSI_ARGS_((ClientData dummy,
  59.     Tcl_Interp *interp, int objc,
  60.     Tcl_Obj *CONST objv[]));
  62. typedef struct TestString {
  63.     int numChars;
  64.     size_t allocated;
  65.     size_t uallocated;
  66.     Tcl_UniChar unicode[2];
  67. } TestString;
  70. /*
  71.  *----------------------------------------------------------------------
  72.  *
  73.  * TclObjTest_Init --
  74.  *
  75.  * This procedure creates additional commands that are used to test the
  76.  * Tcl object support.
  77.  *
  78.  * Results:
  79.  * Returns a standard Tcl completion code, and leaves an error
  80.  * message in the interp's result if an error occurs.
  81.  *
  82.  * Side effects:
  83.  * Creates and registers several new testing commands.
  84.  *
  85.  *----------------------------------------------------------------------
  86.  */
  88. int
  89. TclObjTest_Init(interp)
  90.     Tcl_Interp *interp;
  91. {
  92.     register int i;
  93.     
  94.     for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
  95.         varPtr[i] = NULL;
  96.     }
  98.     Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
  99.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  100.     Tcl_CreateObjCommand(interp, "testconvertobj", TestconvertobjCmd,
  101.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  102.     Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
  103.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  104.     Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
  105.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  106.     Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
  107.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  108.     Tcl_CreateObjCommand(interp, "testobj", TestobjCmd,
  109.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  110.     Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
  111.     (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  112.     return TCL_OK;
  113. }
  115. /*
  116.  *----------------------------------------------------------------------
  117.  *
  118.  * TestbooleanobjCmd --
  119.  *
  120.  * This procedure implements the "testbooleanobj" command.  It is used
  121.  * to test the boolean Tcl object type implementation.
  122.  *
  123.  * Results:
  124.  * A standard Tcl object result.
  125.  *
  126.  * Side effects:
  127.  * Creates and frees boolean objects, and also converts objects to
  128.  * have boolean type.
  129.  *
  130.  *----------------------------------------------------------------------
  131.  */
  133. static int
  134. TestbooleanobjCmd(clientData, interp, objc, objv)
  135.     ClientData clientData; /* Not used. */
  136.     Tcl_Interp *interp; /* Current interpreter. */
  137.     int objc; /* Number of arguments. */
  138.     Tcl_Obj *CONST objv[]; /* Argument objects. */
  139. {
  140.     int varIndex, boolValue;
  141.     char *index, *subCmd;
  143.     if (objc < 3) {
  144. wrongNumArgs:
  145. Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
  146. return TCL_ERROR;
  147.     }
  149.     index = Tcl_GetString(objv[2]);
  150.     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  151. return TCL_ERROR;
  152.     }
  154.     subCmd = Tcl_GetString(objv[1]);
  155.     if (strcmp(subCmd, "set") == 0) {
  156. if (objc != 4) {
  157.     goto wrongNumArgs;
  158. }
  159. if (Tcl_GetBooleanFromObj(interp, objv[3], &boolValue) != TCL_OK) {
  160.     return TCL_ERROR;
  161. }
  163. /*
  164.  * If the object currently bound to the variable with index varIndex
  165.  * has ref count 1 (i.e. the object is unshared) we can modify that
  166.  * object directly. Otherwise, if RC>1 (i.e. the object is shared),
  167.  * we must create a new object to modify/set and decrement the old
  168.  * formerly-shared object's ref count. This is "copy on write".
  169.  */
  171. if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
  172.     Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
  173. } else {
  174.     SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
  175. }
  176. Tcl_SetObjResult(interp, varPtr[varIndex]);
  177.     } else if (strcmp(subCmd, "get") == 0) {
  178. if (objc != 3) {
  179.     goto wrongNumArgs;
  180. }
  181. if (CheckIfVarUnset(interp, varIndex)) {
  182.     return TCL_ERROR;
  183. }
  184. Tcl_SetObjResult(interp, varPtr[varIndex]);
  185.     } else if (strcmp(subCmd, "not") == 0) {
  186. if (objc != 3) {
  187.     goto wrongNumArgs;
  188. }
  189. if (CheckIfVarUnset(interp, varIndex)) {
  190.     return TCL_ERROR;
  191. }
  192. if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
  193.   &boolValue) != TCL_OK) {
  194.     return TCL_ERROR;
  195. }
  196. if (!Tcl_IsShared(varPtr[varIndex])) {
  197.     Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
  198. } else {
  199.     SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
  200. }
  201. Tcl_SetObjResult(interp, varPtr[varIndex]);
  202.     } else {
  203. Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  204. "bad option "", Tcl_GetString(objv[1]),
  205. "": must be set, get, or not", (char *) NULL);
  206. return TCL_ERROR;
  207.     }
  208.     return TCL_OK;
  209. }
  211. /*
  212.  *----------------------------------------------------------------------
  213.  *
  214.  * TestconvertobjCmd --
  215.  *
  216.  * This procedure implements the "testconvertobj" command. It is used
  217.  * to test converting objects to new types.
  218.  *
  219.  * Results:
  220.  * A standard Tcl object result.
  221.  *
  222.  * Side effects:
  223.  * Converts objects to new types.
  224.  *
  225.  *----------------------------------------------------------------------
  226.  */
  228. static int
  229. TestconvertobjCmd(clientData, interp, objc, objv)
  230.     ClientData clientData; /* Not used. */
  231.     Tcl_Interp *interp; /* Current interpreter. */
  232.     int objc; /* Number of arguments. */
  233.     Tcl_Obj *CONST objv[]; /* Argument objects. */
  234. {
  235.     char *subCmd;
  236.     char buf[20];
  238.     if (objc < 3) {
  239. wrongNumArgs:
  240. Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
  241. return TCL_ERROR;
  242.     }
  244.     subCmd = Tcl_GetString(objv[1]);
  245.     if (strcmp(subCmd, "double") == 0) {
  246. double d;
  248. if (objc != 3) {
  249.     goto wrongNumArgs;
  250. }
  251. if (Tcl_GetDoubleFromObj(interp, objv[2], &d) != TCL_OK) {
  252.     return TCL_ERROR;
  253. }
  254. sprintf(buf, "%f", d);
  255.         Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
  256.     } else {
  257. Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  258. "bad option "", Tcl_GetString(objv[1]),
  259. "": must be double", (char *) NULL);
  260. return TCL_ERROR;
  261.     }
  262.     return TCL_OK;
  263. }
  265. /*
  266.  *----------------------------------------------------------------------
  267.  *
  268.  * TestdoubleobjCmd --
  269.  *
  270.  * This procedure implements the "testdoubleobj" command.  It is used
  271.  * to test the double-precision floating point Tcl object type
  272.  * implementation.
  273.  *
  274.  * Results:
  275.  * A standard Tcl object result.
  276.  *
  277.  * Side effects:
  278.  * Creates and frees double objects, and also converts objects to
  279.  * have double type.
  280.  *
  281.  *----------------------------------------------------------------------
  282.  */
  284. static int
  285. TestdoubleobjCmd(clientData, interp, objc, objv)
  286.     ClientData clientData; /* Not used. */
  287.     Tcl_Interp *interp; /* Current interpreter. */
  288.     int objc; /* Number of arguments. */
  289.     Tcl_Obj *CONST objv[]; /* Argument objects. */
  290. {
  291.     int varIndex;
  292.     double doubleValue;
  293.     char *index, *subCmd, *string;
  295.     if (objc < 3) {
  296. wrongNumArgs:
  297. Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
  298. return TCL_ERROR;
  299.     }
  301.     index = Tcl_GetString(objv[2]);
  302.     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  303. return TCL_ERROR;
  304.     }
  306.     subCmd = Tcl_GetString(objv[1]);
  307.     if (strcmp(subCmd, "set") == 0) {
  308. if (objc != 4) {
  309.     goto wrongNumArgs;
  310. }
  311. string = Tcl_GetString(objv[3]);
  312. if (Tcl_GetDouble(interp, string, &doubleValue) != TCL_OK) {
  313.     return TCL_ERROR;
  314. }
  316. /*
  317.  * If the object currently bound to the variable with index varIndex
  318.  * has ref count 1 (i.e. the object is unshared) we can modify that
  319.  * object directly. Otherwise, if RC>1 (i.e. the object is shared),
  320.  * we must create a new object to modify/set and decrement the old
  321.  * formerly-shared object's ref count. This is "copy on write".
  322.  */
  324. if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
  325.     Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
  326. } else {
  327.     SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
  328. }
  329. Tcl_SetObjResult(interp, varPtr[varIndex]);
  330.     } else if (strcmp(subCmd, "get") == 0) {
  331. if (objc != 3) {
  332.     goto wrongNumArgs;
  333. }
  334. if (CheckIfVarUnset(interp, varIndex)) {
  335.     return TCL_ERROR;
  336. }
  337. Tcl_SetObjResult(interp, varPtr[varIndex]);
  338.     } else if (strcmp(subCmd, "mult10") == 0) {
  339. if (objc != 3) {
  340.     goto wrongNumArgs;
  341. }
  342. if (CheckIfVarUnset(interp, varIndex)) {
  343.     return TCL_ERROR;
  344. }
  345. if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
  346.  &doubleValue) != TCL_OK) {
  347.     return TCL_ERROR;
  348. }
  349. if (!Tcl_IsShared(varPtr[varIndex])) {
  350.     Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue * 10.0));
  351. } else {
  352.     SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue * 10.0) ));
  353. }
  354. Tcl_SetObjResult(interp, varPtr[varIndex]);
  355.     } else if (strcmp(subCmd, "div10") == 0) {
  356. if (objc != 3) {
  357.     goto wrongNumArgs;
  358. }
  359. if (CheckIfVarUnset(interp, varIndex)) {
  360.     return TCL_ERROR;
  361. }
  362. if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
  363.  &doubleValue) != TCL_OK) {
  364.     return TCL_ERROR;
  365. }
  366. if (!Tcl_IsShared(varPtr[varIndex])) {
  367.     Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue / 10.0));
  368. } else {
  369.     SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue / 10.0) ));
  370. }
  371. Tcl_SetObjResult(interp, varPtr[varIndex]);
  372.     } else {
  373. Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  374. "bad option "", Tcl_GetString(objv[1]),
  375. "": must be set, get, mult10, or div10", (char *) NULL);
  376. return TCL_ERROR;
  377.     }
  378.     return TCL_OK;
  379. }
  381. /*
  382.  *----------------------------------------------------------------------
  383.  *
  384.  * TestindexobjCmd --
  385.  *
  386.  * This procedure implements the "testindexobj" command. It is used to
  387.  * test the index Tcl object type implementation.
  388.  *
  389.  * Results:
  390.  * A standard Tcl object result.
  391.  *
  392.  * Side effects:
  393.  * Creates and frees int objects, and also converts objects to
  394.  * have int type.
  395.  *
  396.  *----------------------------------------------------------------------
  397.  */
  399. static int
  400. TestindexobjCmd(clientData, interp, objc, objv)
  401.     ClientData clientData; /* Not used. */
  402.     Tcl_Interp *interp; /* Current interpreter. */
  403.     int objc; /* Number of arguments. */
  404.     Tcl_Obj *CONST objv[]; /* Argument objects. */
  405. {
  406.     int allowAbbrev, index, index2, setError, i, result;
  407.     CONST char **argv;
  408.     static CONST char *tablePtr[] = {"a", "b", "check", (char *) NULL};
  409.     /*
  410.      * Keep this structure declaration in sync with tclIndexObj.c
  411.      */
  412.     struct IndexRep {
  413. VOID *tablePtr; /* Pointer to the table of strings */
  414. int offset; /* Offset between table entries */
  415. int index; /* Selected index into table. */
  416.     };
  417.     struct IndexRep *indexRep;
  419.     if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
  420.     "check") == 0)) {
  421. /*
  422.  * This code checks to be sure that the results of
  423.  * Tcl_GetIndexFromObj are properly cached in the object and
  424.  * returned on subsequent lookups.
  425.  */
  427. if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
  428.     return TCL_ERROR;
  429. }
  431. Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
  432. "token", 0, &index);
  433. indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
  434. indexRep->index = index2;
  435. result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1],
  436. tablePtr, "token", 0, &index);
  437. if (result == TCL_OK) {
  438.     Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
  439. }
  440. return result;
  441.     }
  443.     if (objc < 5) {
  444. Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
  445. return TCL_ERROR;
  446.     }
  448.     if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
  449. return TCL_ERROR;
  450.     }
  451.     if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
  452. return TCL_ERROR;
  453.     }
  455.     argv = (CONST char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
  456.     for (i = 4; i < objc; i++) {
  457. argv[i-4] = Tcl_GetString(objv[i]);
  458.     }
  459.     argv[objc-4] = NULL;
  460.     
  461.     /*
  462.      * Tcl_GetIndexFromObj assumes that the table is statically-allocated
  463.      * so that its address is different for each index object. If we
  464.      * accidently allocate a table at the same address as that cached in
  465.      * the index object, clear out the object's cached state.
  466.      */
  468.     if ( objv[3]->typePtr != NULL
  469.  && !strcmp( "index", objv[3]->typePtr->name ) ) {
  470. indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
  471. if (indexRep->tablePtr == (VOID *) argv) {
  472.     objv[3]->typePtr->freeIntRepProc(objv[3]);
  473.     objv[3]->typePtr = NULL;
  474. }
  475.     }
  477.     result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
  478.     argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
  479.     ckfree((char *) argv);
  480.     if (result == TCL_OK) {
  481. Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
  482.     }
  483.     return result;
  484. }
  486. /*
  487.  *----------------------------------------------------------------------
  488.  *
  489.  * TestintobjCmd --
  490.  *
  491.  * This procedure implements the "testintobj" command. It is used to
  492.  * test the int Tcl object type implementation.
  493.  *
  494.  * Results:
  495.  * A standard Tcl object result.
  496.  *
  497.  * Side effects:
  498.  * Creates and frees int objects, and also converts objects to
  499.  * have int type.
  500.  *
  501.  *----------------------------------------------------------------------
  502.  */
  504. static int
  505. TestintobjCmd(clientData, interp, objc, objv)
  506.     ClientData clientData; /* Not used. */
  507.     Tcl_Interp *interp; /* Current interpreter. */
  508.     int objc; /* Number of arguments. */
  509.     Tcl_Obj *CONST objv[]; /* Argument objects. */
  510. {
  511.     int intValue, varIndex, i;
  512.     long longValue;
  513.     char *index, *subCmd, *string;
  515.     if (objc < 3) {
  516. wrongNumArgs:
  517. Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
  518. return TCL_ERROR;
  519.     }
  521.     index = Tcl_GetString(objv[2]);
  522.     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  523. return TCL_ERROR;
  524.     }
  526.     subCmd = Tcl_GetString(objv[1]);
  527.     if (strcmp(subCmd, "set") == 0) {
  528. if (objc != 4) {
  529.     goto wrongNumArgs;
  530. }
  531. string = Tcl_GetString(objv[3]);
  532. if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
  533.     return TCL_ERROR;
  534. }
  535. intValue = i;
  537. /*
  538.  * If the object currently bound to the variable with index varIndex
  539.  * has ref count 1 (i.e. the object is unshared) we can modify that
  540.  * object directly. Otherwise, if RC>1 (i.e. the object is shared),
  541.  * we must create a new object to modify/set and decrement the old
  542.  * formerly-shared object's ref count. This is "copy on write".
  543.  */
  545. if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
  546.     Tcl_SetIntObj(varPtr[varIndex], intValue);
  547. } else {
  548.     SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
  549. }
  550. Tcl_SetObjResult(interp, varPtr[varIndex]);
  551.     } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
  552. if (objc != 4) {
  553.     goto wrongNumArgs;
  554. }
  555. string = Tcl_GetString(objv[3]);
  556. if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
  557.     return TCL_ERROR;
  558. }
  559. intValue = i;
  560. if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
  561.     Tcl_SetIntObj(varPtr[varIndex], intValue);
  562. } else {
  563.     SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
  564. }
  565.     } else if (strcmp(subCmd, "setlong") == 0) {
  566. if (objc != 4) {
  567.     goto wrongNumArgs;
  568. }
  569. string = Tcl_GetString(objv[3]);
  570. if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
  571.     return TCL_ERROR;
  572. }
  573. intValue = i;
  574. if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
  575.     Tcl_SetLongObj(varPtr[varIndex], intValue);
  576. } else {
  577.     SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
  578. }
  579. Tcl_SetObjResult(interp, varPtr[varIndex]);
  580.     } else if (strcmp(subCmd, "setmaxlong") == 0) {
  581. long maxLong = LONG_MAX;
  582. if (objc != 3) {
  583.     goto wrongNumArgs;
  584. }
  585. if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
  586.     Tcl_SetLongObj(varPtr[varIndex], maxLong);
  587. } else {
  588.     SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
  589. }
  590.     } else if (strcmp(subCmd, "ismaxlong") == 0) {
  591. if (objc != 3) {
  592.     goto wrongNumArgs;
  593. }
  594. if (CheckIfVarUnset(interp, varIndex)) {
  595.     return TCL_ERROR;
  596. }
  597. if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
  598.     return TCL_ERROR;
  599. }
  600. Tcl_AppendToObj(Tcl_GetObjResult(interp),
  601.         ((longValue == LONG_MAX)? "1" : "0"), -1);
  602.     } else if (strcmp(subCmd, "get") == 0) {
  603. if (objc != 3) {
  604.     goto wrongNumArgs;
  605. }
  606. if (CheckIfVarUnset(interp, varIndex)) {
  607.     return TCL_ERROR;
  608. }
  609. Tcl_SetObjResult(interp, varPtr[varIndex]);
  610.     } else if (strcmp(subCmd, "get2") == 0) {
  611. if (objc != 3) {
  612.     goto wrongNumArgs;
  613. }
  614. if (CheckIfVarUnset(interp, varIndex)) {
  615.     return TCL_ERROR;
  616. }
  617. string = Tcl_GetString(varPtr[varIndex]);
  618. Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
  619.     } else if (strcmp(subCmd, "inttoobigtest") == 0) {
  620. /*
  621.  * If long ints have more bits than ints on this platform, verify
  622.  * that Tcl_GetIntFromObj returns an error if the long int held
  623.  * in an integer object's internal representation is too large
  624.  * to fit in an int.
  625.  */
  627. if (objc != 3) {
  628.     goto wrongNumArgs;
  629. }
  630. #if (INT_MAX == LONG_MAX)   /* int is same size as long int */
  631. Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
  632. #else 
  633. if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
  634.     Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
  635. } else {
  636.     SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
  637. }
  638. if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
  639.     Tcl_ResetResult(interp);
  640.     Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
  641.     return TCL_OK;
  642. }
  643. Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
  644. #endif
  645.     } else if (strcmp(subCmd, "mult10") == 0) {
  646. if (objc != 3) {
  647.     goto wrongNumArgs;
  648. }
  649. if (CheckIfVarUnset(interp, varIndex)) {
  650.     return TCL_ERROR;
  651. }
  652. if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
  653.       &intValue) != TCL_OK) {
  654.     return TCL_ERROR;
  655. }
  656. if (!Tcl_IsShared(varPtr[varIndex])) {
  657.     Tcl_SetIntObj(varPtr[varIndex], (intValue * 10));
  658. } else {
  659.     SetVarToObj(varIndex, Tcl_NewIntObj( (intValue * 10) ));
  660. }
  661. Tcl_SetObjResult(interp, varPtr[varIndex]);
  662.     } else if (strcmp(subCmd, "div10") == 0) {
  663. if (objc != 3) {
  664.     goto wrongNumArgs;
  665. }
  666. if (CheckIfVarUnset(interp, varIndex)) {
  667.     return TCL_ERROR;
  668. }
  669. if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
  670.       &intValue) != TCL_OK) {
  671.     return TCL_ERROR;
  672. }
  673. if (!Tcl_IsShared(varPtr[varIndex])) {
  674.     Tcl_SetIntObj(varPtr[varIndex], (intValue / 10));
  675. } else {
  676.     SetVarToObj(varIndex, Tcl_NewIntObj( (intValue / 10) ));
  677. }
  678. Tcl_SetObjResult(interp, varPtr[varIndex]);
  679.     } else {
  680. Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  681. "bad option "", Tcl_GetString(objv[1]),
  682. "": must be set, get, get2, mult10, or div10",
  683. (char *) NULL);
  684. return TCL_ERROR;
  685.     }
  686.     return TCL_OK;
  687. }
  689. /*
  690.  *----------------------------------------------------------------------
  691.  *
  692.  * TestobjCmd --
  693.  *
  694.  * This procedure implements the "testobj" command. It is used to test
  695.  * the type-independent portions of the Tcl object type implementation.
  696.  *
  697.  * Results:
  698.  * A standard Tcl object result.
  699.  *
  700.  * Side effects:
  701.  * Creates and frees objects.
  702.  *
  703.  *----------------------------------------------------------------------
  704.  */
  706. static int
  707. TestobjCmd(clientData, interp, objc, objv)
  708.     ClientData clientData; /* Not used. */
  709.     Tcl_Interp *interp; /* Current interpreter. */
  710.     int objc; /* Number of arguments. */
  711.     Tcl_Obj *CONST objv[]; /* Argument objects. */
  712. {
  713.     int varIndex, destIndex, i;
  714.     char *index, *subCmd, *string;
  715.     Tcl_ObjType *targetType;
  717.     if (objc < 2) {
  718. wrongNumArgs:
  719. Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
  720. return TCL_ERROR;
  721.     }
  723.     subCmd = Tcl_GetString(objv[1]);
  724.     if (strcmp(subCmd, "assign") == 0) {
  725.         if (objc != 4) {
  726.             goto wrongNumArgs;
  727.         }
  728.         index = Tcl_GetString(objv[2]);
  729.         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  730.             return TCL_ERROR;
  731.         }
  732.         if (CheckIfVarUnset(interp, varIndex)) {
  733.     return TCL_ERROR;
  734. }
  735. string = Tcl_GetString(objv[3]);
  736.         if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
  737.             return TCL_ERROR;
  738.         }
  739.         SetVarToObj(destIndex, varPtr[varIndex]);
  740. Tcl_SetObjResult(interp, varPtr[destIndex]);
  741.      } else if (strcmp(subCmd, "convert") == 0) {
  742.         char *typeName;
  743.         if (objc != 4) {
  744.             goto wrongNumArgs;
  745.         }
  746.         index = Tcl_GetString(objv[2]);
  747.         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  748.             return TCL_ERROR;
  749.         }
  750.         if (CheckIfVarUnset(interp, varIndex)) {
  751.     return TCL_ERROR;
  752. }
  753.         typeName = Tcl_GetString(objv[3]);
  754.         if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
  755.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  756.     "no type ", typeName, " found", (char *) NULL);
  757.             return TCL_ERROR;
  758.         }
  759.         if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
  760.             != TCL_OK) {
  761.             return TCL_ERROR;
  762.         }
  763. Tcl_SetObjResult(interp, varPtr[varIndex]);
  764.     } else if (strcmp(subCmd, "duplicate") == 0) {
  765.         if (objc != 4) {
  766.             goto wrongNumArgs;
  767.         }
  768.         index = Tcl_GetString(objv[2]);
  769.         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  770.             return TCL_ERROR;
  771.         }
  772.         if (CheckIfVarUnset(interp, varIndex)) {
  773.     return TCL_ERROR;
  774. }
  775. string = Tcl_GetString(objv[3]);
  776.         if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
  777.             return TCL_ERROR;
  778.         }
  779.         SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
  780. Tcl_SetObjResult(interp, varPtr[destIndex]);
  781.     } else if (strcmp(subCmd, "freeallvars") == 0) {
  782.         if (objc != 2) {
  783.             goto wrongNumArgs;
  784.         }
  785.         for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
  786.             if (varPtr[i] != NULL) {
  787.                 Tcl_DecrRefCount(varPtr[i]);
  788.                 varPtr[i] = NULL;
  789.             }
  790.         }
  791.     } else if ( strcmp ( subCmd, "invalidateStringRep" ) == 0 ) {
  792. if ( objc != 3 ) {
  793.     goto wrongNumArgs;
  794. }
  795. index = Tcl_GetString( objv[2] );
  796. if ( GetVariableIndex( interp, index, &varIndex ) != TCL_OK ) {
  797.     return TCL_ERROR;
  798. }
  799.         if (CheckIfVarUnset(interp, varIndex)) {
  800.     return TCL_ERROR;
  801. }
  802. Tcl_InvalidateStringRep( varPtr[varIndex] );
  803. Tcl_SetObjResult( interp, varPtr[varIndex] );
  804.     } else if (strcmp(subCmd, "newobj") == 0) {
  805.         if (objc != 3) {
  806.             goto wrongNumArgs;
  807.         }
  808.         index = Tcl_GetString(objv[2]);
  809.         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  810.             return TCL_ERROR;
  811.         }
  812.         SetVarToObj(varIndex, Tcl_NewObj());
  813. Tcl_SetObjResult(interp, varPtr[varIndex]);
  814.     } else if (strcmp(subCmd, "objtype") == 0) {
  815. char *typeName;
  817. /*
  818.  * return an object containing the name of the argument's type
  819.  * of internal rep.  If none exists, return "none".
  820.  */
  822.         if (objc != 3) {
  823.             goto wrongNumArgs;
  824.         }
  825. if (objv[2]->typePtr == NULL) {
  826.     Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
  827. } else {
  828.     typeName = objv[2]->typePtr->name;
  829.     Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
  830. }
  831.     } else if (strcmp(subCmd, "refcount") == 0) {
  832. char buf[TCL_INTEGER_SPACE];
  834.         if (objc != 3) {
  835.             goto wrongNumArgs;
  836.         }
  837.         index = Tcl_GetString(objv[2]);
  838.         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  839.             return TCL_ERROR;
  840.         }
  841.         if (CheckIfVarUnset(interp, varIndex)) {
  842.     return TCL_ERROR;
  843. }
  844. TclFormatInt(buf, varPtr[varIndex]->refCount);
  845.         Tcl_SetResult(interp, buf, TCL_VOLATILE);
  846.     } else if (strcmp(subCmd, "type") == 0) {
  847.         if (objc != 3) {
  848.             goto wrongNumArgs;
  849.         }
  850.         index = Tcl_GetString(objv[2]);
  851.         if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  852.             return TCL_ERROR;
  853.         }
  854.         if (CheckIfVarUnset(interp, varIndex)) {
  855.     return TCL_ERROR;
  856. }
  857.         if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
  858.     Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
  859.         } else {
  860.             Tcl_AppendToObj(Tcl_GetObjResult(interp),
  861.                     varPtr[varIndex]->typePtr->name, -1);
  862.         }
  863.     } else if (strcmp(subCmd, "types") == 0) {
  864.         if (objc != 2) {
  865.             goto wrongNumArgs;
  866.         }
  867. if (Tcl_AppendAllObjTypes(interp,
  868. Tcl_GetObjResult(interp)) != TCL_OK) {
  869.     return TCL_ERROR;
  870. }
  871.     } else {
  872. Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  873. "bad option "",
  874. Tcl_GetString(objv[1]),
  875. "": must be assign, convert, duplicate, freeallvars, ",
  876. "newobj, objcount, objtype, refcount, type, or types",
  877. (char *) NULL);
  878. return TCL_ERROR;
  879.     }
  880.     return TCL_OK;
  881. }
  883. /*
  884.  *----------------------------------------------------------------------
  885.  *
  886.  * TeststringobjCmd --
  887.  *
  888.  * This procedure implements the "teststringobj" command. It is used to
  889.  * test the string Tcl object type implementation.
  890.  *
  891.  * Results:
  892.  * A standard Tcl object result.
  893.  *
  894.  * Side effects:
  895.  * Creates and frees string objects, and also converts objects to
  896.  * have string type.
  897.  *
  898.  *----------------------------------------------------------------------
  899.  */
  901. static int
  902. TeststringobjCmd(clientData, interp, objc, objv)
  903.     ClientData clientData; /* Not used. */
  904.     Tcl_Interp *interp; /* Current interpreter. */
  905.     int objc; /* Number of arguments. */
  906.     Tcl_Obj *CONST objv[]; /* Argument objects. */
  907. {
  908.     int varIndex, option, i, length;
  909. #define MAX_STRINGS 11
  910.     char *index, *string, *strings[MAX_STRINGS+1];
  911.     TestString *strPtr;
  912.     static CONST char *options[] = {
  913. "append", "appendstrings", "get", "get2", "length", "length2",
  914. "set", "set2", "setlength", "ualloc", "getunicode", 
  915. (char *) NULL
  916.     };
  918.     if (objc < 3) {
  919. wrongNumArgs:
  920. Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
  921. return TCL_ERROR;
  922.     }
  924.     index = Tcl_GetString(objv[2]);
  925.     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
  926. return TCL_ERROR;
  927.     }
  929.     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option)
  930.     != TCL_OK) {
  931. return TCL_ERROR;
  932.     }
  933.     switch (option) {
  934. case 0: /* append */
  935.     if (objc != 5) {
  936. goto wrongNumArgs;
  937.     }
  938.     if (Tcl_GetIntFromObj(interp, objv[4], &length) != TCL_OK) {
  939. return TCL_ERROR;
  940.     }
  941.     if (varPtr[varIndex] == NULL) {
  942. SetVarToObj(varIndex, Tcl_NewObj());
  943.     }
  944.     
  945.     /*
  946.      * If the object bound to variable "varIndex" is shared, we must
  947.      * "copy on write" and append to a copy of the object. 
  948.      */
  949.     
  950.     if (Tcl_IsShared(varPtr[varIndex])) {
  951. SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
  952.     }
  953.     string = Tcl_GetString(objv[3]);
  954.     Tcl_AppendToObj(varPtr[varIndex], string, length);
  955.     Tcl_SetObjResult(interp, varPtr[varIndex]);
  956.     break;
  957. case 1: /* appendstrings */
  958.     if (objc > (MAX_STRINGS+3)) {
  959. goto wrongNumArgs;
  960.     }
  961.     if (varPtr[varIndex] == NULL) {
  962. SetVarToObj(varIndex, Tcl_NewObj());
  963.     }
  965.     /*
  966.      * If the object bound to variable "varIndex" is shared, we must
  967.      * "copy on write" and append to a copy of the object. 
  968.      */
  970.     if (Tcl_IsShared(varPtr[varIndex])) {
  971. SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
  972.     }
  973.     for (i = 3;  i < objc;  i++) {
  974. strings[i-3] = Tcl_GetString(objv[i]);
  975.     }
  976.     for ( ; i < 12 + 3; i++) {
  977. strings[i - 3] = NULL;
  978.     }
  979.     Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
  980.     strings[2], strings[3], strings[4], strings[5],
  981.     strings[6], strings[7], strings[8], strings[9],
  982.     strings[10], strings[11]);
  983.     Tcl_SetObjResult(interp, varPtr[varIndex]);
  984.     break;
  985. case 2: /* get */
  986.     if (objc != 3) {
  987. goto wrongNumArgs;
  988.     }
  989.     if (CheckIfVarUnset(interp, varIndex)) {
  990. return TCL_ERROR;
  991.     }
  992.     Tcl_SetObjResult(interp, varPtr[varIndex]);
  993.     break;
  994. case 3: /* get2 */
  995.     if (objc != 3) {
  996. goto wrongNumArgs;
  997.     }
  998.     if (CheckIfVarUnset(interp, varIndex)) {
  999. return TCL_ERROR;
  1000.     }
  1001.     string = Tcl_GetString(varPtr[varIndex]);
  1002.     Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
  1003.     break;
  1004. case 4: /* length */
  1005.     if (objc != 3) {
  1006. goto wrongNumArgs;
  1007.     }
  1008.     Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
  1009.     ? varPtr[varIndex]->length : -1);
  1010.     break;
  1011. case 5: /* length2 */
  1012.     if (objc != 3) {
  1013. goto wrongNumArgs;
  1014.     }
  1015.     if (varPtr[varIndex] != NULL) {
  1016. strPtr = (TestString *)
  1017.     (varPtr[varIndex])->internalRep.otherValuePtr;
  1018. length = (int) strPtr->allocated;
  1019.     } else {
  1020. length = -1;
  1021.     }
  1022.     Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
  1023.     break;
  1024. case 6: /* set */
  1025.     if (objc != 4) {
  1026. goto wrongNumArgs;
  1027.     }
  1029.     /*
  1030.      * If the object currently bound to the variable with index
  1031.      * varIndex has ref count 1 (i.e. the object is unshared) we
  1032.      * can modify that object directly. Otherwise, if RC>1 (i.e.
  1033.      * the object is shared), we must create a new object to
  1034.      * modify/set and decrement the old formerly-shared object's
  1035.      * ref count. This is "copy on write".
  1036.      */
  1037.     
  1038.     string = Tcl_GetStringFromObj(objv[3], &length);
  1039.     if ((varPtr[varIndex] != NULL)
  1040.     && !Tcl_IsShared(varPtr[varIndex])) {
  1041. Tcl_SetStringObj(varPtr[varIndex], string, length);
  1042.     } else {
  1043. SetVarToObj(varIndex, Tcl_NewStringObj(string, length));
  1044.     }
  1045.     Tcl_SetObjResult(interp, varPtr[varIndex]);
  1046.     break;
  1047. case 7: /* set2 */
  1048.     if (objc != 4) {
  1049. goto wrongNumArgs;
  1050.     }
  1051.     SetVarToObj(varIndex, objv[3]);
  1052.     break;
  1053. case 8: /* setlength */
  1054.     if (objc != 4) {
  1055. goto wrongNumArgs;
  1056.     }
  1057.     if (Tcl_GetIntFromObj(interp, objv[3], &length) != TCL_OK) {
  1058. return TCL_ERROR;
  1059.     }
  1060.     if (varPtr[varIndex] != NULL) {
  1061. Tcl_SetObjLength(varPtr[varIndex], length);
  1062.     }
  1063.     break;
  1064. case 9: /* ualloc */
  1065.     if (objc != 3) {
  1066. goto wrongNumArgs;
  1067.     }
  1068.     if (varPtr[varIndex] != NULL) {
  1069. strPtr = (TestString *)
  1070.     (varPtr[varIndex])->internalRep.otherValuePtr;
  1071. length = (int) strPtr->uallocated;
  1072.     } else {
  1073. length = -1;
  1074.     }
  1075.     Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
  1076.     break;
  1077. case 10: /* getunicode */
  1078.     if (objc != 3) {
  1079. goto wrongNumArgs;
  1080.     }
  1081.     Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
  1082.     break;
  1083.     }
  1085.     return TCL_OK;
  1086. }
  1088. /*
  1089.  *----------------------------------------------------------------------
  1090.  *
  1091.  * SetVarToObj --
  1092.  *
  1093.  * Utility routine to assign a Tcl_Obj* to a test variable. The
  1094.  * Tcl_Obj* can be NULL.
  1095.  *
  1096.  * Results:
  1097.  * None.
  1098.  *
  1099.  * Side effects:
  1100.  * This routine handles ref counting details for assignment:
  1101.  * i.e. the old value's ref count must be decremented (if not NULL) and
  1102.  * the new one incremented (also if not NULL).
  1103.  *
  1104.  *----------------------------------------------------------------------
  1105.  */
  1107. static void
  1108. SetVarToObj(varIndex, objPtr)
  1109.     int varIndex; /* Designates the assignment variable. */
  1110.     Tcl_Obj *objPtr; /* Points to object to assign to var. */
  1111. {
  1112.     if (varPtr[varIndex] != NULL) {
  1113. Tcl_DecrRefCount(varPtr[varIndex]);
  1114.     }
  1115.     varPtr[varIndex] = objPtr;
  1116.     if (objPtr != NULL) {
  1117. Tcl_IncrRefCount(objPtr);
  1118.     }
  1119. }
  1121. /*
  1122.  *----------------------------------------------------------------------
  1123.  *
  1124.  * GetVariableIndex --
  1125.  *
  1126.  * Utility routine to get a test variable index from the command line.
  1127.  *
  1128.  * Results:
  1129.  * A standard Tcl object result.
  1130.  *
  1131.  * Side effects:
  1132.  * None.
  1133.  *
  1134.  *----------------------------------------------------------------------
  1135.  */
  1137. static int
  1138. GetVariableIndex(interp, string, indexPtr)
  1139.     Tcl_Interp *interp;         /* Interpreter for error reporting. */
  1140.     char *string;               /* String containing a variable index
  1141.  * specified as a nonnegative number less
  1142.  * than NUMBER_OF_OBJECT_VARS. */
  1143.     int *indexPtr;              /* Place to store converted result. */
  1144. {
  1145.     int index;
  1146.     
  1147.     if (Tcl_GetInt(interp, string, &index) != TCL_OK) {
  1148. return TCL_ERROR;
  1149.     }
  1150.     if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) {
  1151. Tcl_ResetResult(interp);
  1152. Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1);
  1153. return TCL_ERROR;
  1154.     }
  1156.     *indexPtr = index;
  1157.     return TCL_OK;
  1158. }
  1160. /*
  1161.  *----------------------------------------------------------------------
  1162.  *
  1163.  * CheckIfVarUnset --
  1164.  *
  1165.  * Utility procedure that checks whether a test variable is readable:
  1166.  * i.e., that varPtr[varIndex] is non-NULL.
  1167.  *
  1168.  * Results:
  1169.  * 1 if the test variable is unset (NULL); 0 otherwise.
  1170.  *
  1171.  * Side effects:
  1172.  * Sets the interpreter result to an error message if the variable is
  1173.  * unset (NULL).
  1174.  *
  1175.  *----------------------------------------------------------------------
  1176.  */
  1178. static int
  1179. CheckIfVarUnset(interp, varIndex)
  1180.     Tcl_Interp *interp; /* Interpreter for error reporting. */
  1181.     int varIndex; /* Index of the test variable to check. */
  1182. {
  1183.     if (varPtr[varIndex] == NULL) {
  1184. char buf[32 + TCL_INTEGER_SPACE];
  1186. sprintf(buf, "variable %d is unset (NULL)", varIndex);
  1187. Tcl_ResetResult(interp);
  1188. Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
  1189. return 1;
  1190.     }
  1191.     return 0;
  1192. }