读源码之Tcl: 错误处理

catch 的实现

• 文件：
  1. generic/tclBasic.c: static const CmdInfo builtInCmds[]
  2. generic/tclCmdAH.c: Tcl_CatchObjCmd
• 概要：
  • 执行：TclEvalObjEx(inter, objv[1], 0, ((Interp *)interp)->cmdFramePtr, 1)
  • 赋值：Tcl_ObjSetVar2(interp, varName, NULL, Tcl_GetObjResult(interp))
  • 扫尾：Tcl_ResetResult , Tcl_SetObjResult
  • 成功：return TCL_OK
• 答疑：
  • 捕获错误的基本原理其实就是永远return TCL_OK（除了catch语句本身引起的错误）
  • 通过 ((Interp *)interp)->cmdFramePtr改变命令执行的frame
  • TclEvalObjEx是个内部函数。
  • Tcl_EvalObjEx = TclEvalObjEx(interp, objPtr, flags, NULL, 0)

源码

int
Tcl_CatchObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    Tcl_Obj *varNamePtr = NULL;
    Tcl_Obj *optionVarNamePtr = NULL;
    int result;
    Interp *iPtr = (Interp *) interp;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"script ?resultVarName? ?optionVarName?");
	return TCL_ERROR;
    }

    if (objc >= 3) {
	varNamePtr = objv[2];
    }
    if (objc == 4) {
	optionVarNamePtr = objv[3];
    }

    /*
     * TIP #280. Make invoking context available to caught script.
     */

    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);

    /*
     * We disable catch in interpreters where the limit has been exceeded.
     */

    if (Tcl_LimitExceeded(interp)) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"catch\" body line %d)", interp->errorLine));
	return TCL_ERROR;
    }

    if (objc >= 3) {
	if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
		Tcl_GetObjResult(interp), 0)) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp,
		    "couldn't save command result in variable", NULL);
	    return TCL_ERROR;
	}
    }
    if (objc == 4) {
	Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);
	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
		options, 0)) {
	    Tcl_DecrRefCount(options);
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp,
		    "couldn't save return options in variable", NULL);
	    return TCL_ERROR;
	}
    }

    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}

相关代码

int
Tcl_EvalObjEx(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * a previous call to Tcl_CreateInterp). */
    register Tcl_Obj *objPtr,	/* Pointer to object containing commands to
				 * execute. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Supported values
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
{
    return TclEvalObjEx(interp, objPtr, flags, NULL, 0);
}

int
TclEvalObjEx(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * a previous call to Tcl_CreateInterp). */
    register Tcl_Obj *objPtr,	/* Pointer to object containing commands to
				 * execute. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Supported values
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
    const CmdFrame *invoker,	/* Frame of the command doing the eval. */
    int word)			/* Index of the word which is in objPtr. */
{
  ... TODO ...
}