tcltestobj.c

linux系统下的音频通信

				 &doubleValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue / 10.0));
	} else {
	    SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue / 10.0) ));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
		"\": must be set, get, mult10, or div10", (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestindexobjCmd --
 *
 *	This procedure implements the "testindexobj" command. It is used to
 *	test the index Tcl object type implementation.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	Creates and frees int objects, and also converts objects to
 *	have int type.
 *
 *----------------------------------------------------------------------
 */

static int
TestindexobjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int allowAbbrev, index, index2, setError, i, dummy, result;
    char **argv;
    static char *tablePtr[] = {"a", "b", "check", (char *) NULL};

    if ((objc == 3) && (strcmp(Tcl_GetStringFromObj(objv[1], &dummy),
	    "check") == 0)) {
	/*
	 * This code checks to be sure that the results of
	 * Tcl_GetIndexFromObj are properly cached in the object and
	 * returned on subsequent lookups.
	 */

	Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
		"token", 0, &index);
	if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}
	objv[1]->internalRep.twoPtrValue.ptr2 = (VOID *) index2;
	result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1],
		tablePtr, "token", 0, &index);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
	}
	return result;
    }

    if (objc < 5) {
	Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
	return TCL_ERROR;
    }

    if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
	return TCL_ERROR;
    }
    argv = (char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetStringFromObj(objv[i], &dummy);
    }
    argv[objc-4] = NULL;
    result = Tcl_GetIndexFromObj(setError ? interp : NULL, objv[3],
	    argv, "token", allowAbbrev ? 0 : TCL_EXACT, &index);
    ckfree((char *) argv);
    if (result == TCL_OK) {
	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TestintobjCmd --
 *
 *	This procedure implements the "testintobj" command. It is used to
 *	test the int Tcl object type implementation.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	Creates and frees int objects, and also converts objects to
 *	have int type.
 *
 *----------------------------------------------------------------------
 */

static int
TestintobjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int intValue, varIndex, length, i;
    long longValue;
    char *index, *subCmd, *string;
	
    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
     */

    index = Tcl_GetStringFromObj(objv[2], &length);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    subCmd = Tcl_GetStringFromObj(objv[1], &length);
    if (strcmp(subCmd, "set") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetStringFromObj(objv[3], &length);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	intValue = i;

	/*
	 * If the object currently bound to the variable with index varIndex
	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
	 * we must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetStringFromObj(objv[3], &length);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
	}
    } else if (strcmp(subCmd, "setlong") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetStringFromObj(objv[3], &length);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetLongObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "setmaxlong") == 0) {
	long maxLong = LONG_MAX;
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetLongObj(varPtr[varIndex], maxLong);
	} else {
	    SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
	}
    } else if (strcmp(subCmd, "ismaxlong") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendToObj(Tcl_GetObjResult(interp),
	        ((longValue == LONG_MAX)? "1" : "0"), -1);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "inttoobigtest") == 0) {
	/*
	 * If long ints have more bits than ints on this platform, verify
	 * that Tcl_GetIntFromObj returns an error if the long int held
	 * in an integer object's internal representation is too large
	 * to fit in an int.
	 */
	
	long maxLong = LONG_MAX;
	
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (INT_MAX == LONG_MAX) { /* int is same size as long int */
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
	} else {
	    if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
		Tcl_SetLongObj(varPtr[varIndex], maxLong);
	    } else {
		SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
	    }
	    if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
		Tcl_ResetResult(interp);
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
		return TCL_OK;
	    }
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
	}
    } else if (strcmp(subCmd, "mult10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
			      &intValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], (intValue * 10));
	} else {
	    SetVarToObj(varIndex, Tcl_NewIntObj( (intValue * 10) ));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "div10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
			      &intValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], (intValue / 10));
	} else {
	    SetVarToObj(varIndex, Tcl_NewIntObj( (intValue / 10) ));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetStringFromObj(objv[1], (int *) NULL),
		"\": must be set, get, mult10, or div10", (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestobjCmd --
 *
 *	This procedure implements the "testobj" command. It is used to test
 *	the type-independent portions of the Tcl object type implementation.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	Creates and frees objects.
 *
 *----------------------------------------------------------------------
 */

static int
TestobjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int varIndex, destIndex, i;
    char *index, *subCmd, *string;
    Tcl_ObjType *targetType;
    char buf[20];
    int length;
	
    if (objc < 2) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * THIS FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
     */

    subCmd = Tcl_GetStringFromObj(objv[1], &length);
    if (strcmp(subCmd, "assign") == 0) {
        if (objc != 4) {
            goto wrongNumArgs;
        }
        index = Tcl_GetStringFromObj(objv[2], &length);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	string = Tcl_GetStringFromObj(objv[3], &length);
        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        SetVarToObj(destIndex, varPtr[varIndex]);
	Tcl_SetObjResult(interp, varPtr[destIndex]);
     } else if (strcmp(subCmd, "convert") == 0) {
        char *typeName;
        if (objc != 4) {
            goto wrongNumArgs;
        }
        index = Tcl_GetStringFromObj(objv[2], &length);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
        typeName = Tcl_GetStringFromObj(objv[3], &length);
        if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),