0001: /*
0002: * TestObjCmd.java --
0003: *
0004: * This file contains command procedures for the additional Tcl
0005: * commands that are used for testing implementations of the Tcl object
0006: * types. These commands are not normally included in Tcl
0007: * applications; they're only used for testing. Ported from tclTestObj.c.
0008: *
0009: * Copyright (c) 1997 by Sun Microsystems, Inc.
0010: *
0011: * See the file "license.terms" for information on usage and redistribution
0012: * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
0013: *
0014: * RCS: @(#) $Id: TestObjCmd.java,v 1.2 2005/10/12 22:39:39 mdejong Exp $
0015: */
0016:
0017: package tcl.lang;
0018:
0019: public class TestObjCmd implements Command {
0020:
0021: // An array of TclObject pointers used in the commands that operate on or get
0022: // the values of Tcl object-valued variables. varPtr[i] is the i-th
0023: // variable's TclObject.
0024:
0025: final static int NUMBER_OF_OBJECT_VARS = 20;
0026: final static TclObject[] varPtr = new TclObject[NUMBER_OF_OBJECT_VARS];
0027:
0028: /*
0029: *----------------------------------------------------------------------
0030: *
0031: * TclObjTest_Init -> TestObjCmd.init()
0032: *
0033: * This procedure creates additional commands that are used to test the
0034: * Tcl object support.
0035: *
0036: * Results:
0037: *
0038: *
0039: * Side effects:
0040: * Creates and registers several new testing commands.
0041: *
0042: *----------------------------------------------------------------------
0043: */
0044:
0045: public static void init(Interp interp) {
0046: int i;
0047:
0048: for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
0049: varPtr[i] = null;
0050: }
0051:
0052: interp.createCommand("testbooleanobj", new TestBooleanObjCmd());
0053: interp.createCommand("testconvertobj", new TestConvertObjCmd());
0054: interp.createCommand("testdoubleobj", new TestDoubleObjCmd());
0055: interp.createCommand("testintobj", new TestIntObjCmd());
0056: interp.createCommand("testindexobj", new TestIndexObjCmd());
0057: interp.createCommand("testobj", new TestObjCmd());
0058: interp.createCommand("teststringobj", new TestStringObjCmd());
0059: }
0060:
0061: /*
0062: *----------------------------------------------------------------------
0063: *
0064: * cmdProc --
0065: *
0066: * This method implements the "testobject" command.
0067: *
0068: * Results:
0069: * A standard Tcl result.
0070: *
0071: * Side effects:
0072: * None.
0073: *
0074: *----------------------------------------------------------------------
0075: */
0076:
0077: public void cmdProc(Interp interp, // The current Tcl interpreter.
0078: TclObject[] objv) // The arguments passed to the command.
0079: throws TclException // The standard Tcl exception.
0080: {
0081: TestObjCmdImpl.cmdProc(interp, objv);
0082: }
0083:
0084: } // end TestObjectCmd
0085:
0086: /*
0087: *----------------------------------------------------------------------
0088: *
0089: * TestbooleanobjCmd -> TestBooleanObjCmd
0090: *
0091: * This class implements the "testbooleanobj" command. It is used
0092: * to test the boolean Tcl object type implementation.
0093: *
0094: * Results:
0095: * A standard Tcl object result.
0096: *
0097: * Side effects:
0098: * Creates and frees boolean objects, and also converts objects to
0099: * have boolean type.
0100: *
0101: *----------------------------------------------------------------------
0102: */
0103:
0104: class TestBooleanObjCmd implements Command {
0105:
0106: public void cmdProc(Interp interp, // The current Tcl interpreter.
0107: TclObject[] objv) // The arguments passed to the command.
0108: throws TclException // The standard Tcl exception.
0109: {
0110: int varIndex;
0111: boolean boolValue;
0112: String index, subCmd;
0113:
0114: if (objv.length < 3) {
0115: throw new TclNumArgsException(interp, 1, objv,
0116: "option ?arg arg ...?");
0117: }
0118:
0119: index = objv[2].toString();
0120: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0121:
0122: subCmd = objv[1].toString();
0123: if (subCmd.equals("set")) {
0124: if (objv.length != 4) {
0125: throw new TclNumArgsException(interp, 1, objv,
0126: "option ?arg arg ...?");
0127: }
0128: boolValue = TclBoolean.get(interp, objv[3]);
0129:
0130: // The C implementation changes the internal rep of an unshared
0131: // object in the varPtr array. Jacl does not support functions
0132: // like Tcl_SetBooleanObj() so always use SetVarToObj().
0133:
0134: TestObjCmdUtil.SetVarToObj(varIndex, TclBoolean
0135: .newInstance(boolValue));
0136: interp.setResult(TestObjCmd.varPtr[varIndex]);
0137: } else if (subCmd.equals("get")) {
0138: if (objv.length != 3) {
0139: throw new TclNumArgsException(interp, 1, objv,
0140: "option ?arg arg ...?");
0141: }
0142: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0143: interp.setResult(TestObjCmd.varPtr[varIndex]);
0144: } else if (subCmd.equals("not")) {
0145: if (objv.length != 3) {
0146: throw new TclNumArgsException(interp, 1, objv,
0147: "option ?arg arg ...?");
0148: }
0149: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0150: boolValue = TclBoolean.get(interp,
0151: TestObjCmd.varPtr[varIndex]);
0152:
0153: // The C implementation changes the internal rep of an unshared
0154: // object in the varPtr array. Jacl does not support functions
0155: // like Tcl_SetBooleanObj() so always use SetVarToObj().
0156:
0157: TestObjCmdUtil.SetVarToObj(varIndex, TclBoolean
0158: .newInstance(!boolValue));
0159: interp.setResult(TestObjCmd.varPtr[varIndex]);
0160: } else {
0161: throw new TclException(interp, "bad option \"" + objv[1]
0162: + "\": must be set, get, or not");
0163: }
0164: }
0165:
0166: } // end class TestBooleanObjCmd
0167:
0168: /*
0169: *----------------------------------------------------------------------
0170: *
0171: * TestconvertobjCmd -> TestConvertObjCmd
0172: *
0173: * This procedure implements the "testconvertobj" command. It is used
0174: * to test converting objects to new types.
0175: *
0176: * Results:
0177: * A standard Tcl object result.
0178: *
0179: * Side effects:
0180: * Converts objects to new types.
0181: *
0182: *----------------------------------------------------------------------
0183: */
0184:
0185: class TestConvertObjCmd implements Command {
0186:
0187: public void cmdProc(Interp interp, // The current Tcl interpreter.
0188: TclObject[] objv) // The arguments passed to the command.
0189: throws TclException // The standard Tcl exception.
0190: {
0191: String subCmd;
0192:
0193: if (objv.length < 3) {
0194: throw new TclNumArgsException(interp, 1, objv,
0195: "option arg ?arg ...?");
0196: }
0197:
0198: subCmd = objv[1].toString();
0199: if (subCmd.equals("double")) {
0200: double d;
0201:
0202: if (objv.length != 3) {
0203: throw new TclNumArgsException(interp, 1, objv,
0204: "option arg ?arg ...?");
0205: }
0206: d = TclDouble.get(interp, objv[2]);
0207: interp.setResult("" + d); // Convert double to String
0208: } else {
0209: throw new TclException(interp, "bad option \"" + objv[1]
0210: + "\": must be double");
0211: }
0212: }
0213:
0214: } // end class TestConvertObjCmd
0215:
0216: /*
0217: *----------------------------------------------------------------------
0218: *
0219: * TestdoubleobjCmd --
0220: *
0221: * This procedure implements the "testdoubleobj" command. It is used
0222: * to test the double-precision floating point Tcl object type
0223: * implementation.
0224: *
0225: * Results:
0226: * A standard Tcl object result.
0227: *
0228: * Side effects:
0229: * Creates and frees double objects, and also converts objects to
0230: * have double type.
0231: *
0232: *----------------------------------------------------------------------
0233: */
0234:
0235: class TestDoubleObjCmd implements Command {
0236:
0237: public void cmdProc(Interp interp, // The current Tcl interpreter.
0238: TclObject[] objv) // The arguments passed to the command.
0239: throws TclException // The standard Tcl exception.
0240: {
0241: int varIndex;
0242: double doubleValue;
0243: String index, subCmd, string;
0244:
0245: if (objv.length < 3) {
0246: throw new TclNumArgsException(interp, 1, objv,
0247: "option arg ?arg ...?");
0248: }
0249:
0250: index = objv[2].toString();
0251: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0252:
0253: subCmd = objv[1].toString();
0254: if (subCmd.equals("set")) {
0255: if (objv.length != 4) {
0256: throw new TclNumArgsException(interp, 1, objv,
0257: "option arg ?arg ...?");
0258: }
0259: string = objv[3].toString();
0260: doubleValue = Util.getDouble(interp, string);
0261:
0262: // The C implementation changes the internal rep of an unshared
0263: // object in the varPtr array. Jacl does not support functions
0264: // like Tcl_SetDoubleObj() so always use SetVarToObj().
0265:
0266: TestObjCmdUtil.SetVarToObj(varIndex, TclDouble
0267: .newInstance(doubleValue));
0268: interp.setResult(TestObjCmd.varPtr[varIndex]);
0269: } else if (subCmd.equals("get")) {
0270: if (objv.length != 3) {
0271: throw new TclNumArgsException(interp, 1, objv,
0272: "option arg ?arg ...?");
0273: }
0274: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0275: interp.setResult(TestObjCmd.varPtr[varIndex]);
0276: } else if (subCmd.equals("mult10")) {
0277: if (objv.length != 3) {
0278: throw new TclNumArgsException(interp, 1, objv,
0279: "option arg ?arg ...?");
0280: }
0281: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0282: doubleValue = TclDouble.get(interp,
0283: TestObjCmd.varPtr[varIndex]);
0284:
0285: // The C implementation changes the internal rep of an unshared
0286: // object in the varPtr array. Jacl does not support functions
0287: // like Tcl_SetDoubleObj() so always use SetVarToObj().
0288:
0289: TestObjCmdUtil.SetVarToObj(varIndex, TclDouble
0290: .newInstance((doubleValue * 10.0)));
0291: interp.setResult(TestObjCmd.varPtr[varIndex]);
0292: } else if (subCmd.equals("div10")) {
0293: if (objv.length != 3) {
0294: throw new TclNumArgsException(interp, 1, objv,
0295: "option arg ?arg ...?");
0296: }
0297: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0298: doubleValue = TclDouble.get(interp,
0299: TestObjCmd.varPtr[varIndex]);
0300:
0301: // The C implementation changes the internal rep of an unshared
0302: // object in the varPtr array. Jacl does not support functions
0303: // like Tcl_SetDoubleObj() so always use SetVarToObj().
0304:
0305: TestObjCmdUtil.SetVarToObj(varIndex, TclDouble
0306: .newInstance((doubleValue / 10.0)));
0307: interp.setResult(TestObjCmd.varPtr[varIndex]);
0308: } else {
0309: throw new TclException(interp, "bad option \"" + objv[1]
0310: + "\": must be set, get, mult10, or div10");
0311: }
0312: }
0313:
0314: } // end class TestDoubleObjCmd
0315:
0316: /*
0317: *----------------------------------------------------------------------
0318: *
0319: * TestindexobjCmd -> TestIndexObjCmd
0320: *
0321: * This procedure implements the "testindexobj" command. It is used to
0322: * test the index Tcl object type implementation.
0323: *
0324: * Results:
0325: * A standard Tcl object result.
0326: *
0327: * Side effects:
0328: * Creates and frees int objects, and also converts objects to
0329: * have int type.
0330: *
0331: *----------------------------------------------------------------------
0332: */
0333:
0334: class TestIndexObjCmd implements Command {
0335:
0336: public void cmdProc(Interp interp, // The current Tcl interpreter.
0337: TclObject[] objv) // The arguments passed to the command.
0338: throws TclException // The standard Tcl exception.
0339: {
0340: boolean allowAbbrev, setError;
0341: int index, index2, i, result;
0342: String[] argv;
0343: String[] tablePtr = { "a", "b", "check", null };
0344:
0345: InternalRep indexRep;
0346:
0347: if ((objv.length == 3) && (objv[1].toString().equals("check"))) {
0348: // This code checks to be sure that the results of
0349: // Tcl_GetIndexFromObj are properly cached in the object and
0350: // returned on subsequent lookups.
0351:
0352: index2 = TclInteger.get(interp, objv[2]);
0353:
0354: index = TclIndex.get(null, objv[1], tablePtr, "token", 0);
0355: indexRep = objv[1].getInternalRep();
0356: ((TclIndex) indexRep).testUpdateIndex(index2);
0357: index = TclIndex.get(null, objv[1], tablePtr, "token", 0);
0358: interp.setResult(index);
0359: return;
0360: }
0361:
0362: if (objv.length < 5) {
0363: throw new TclException(interp, "wrong # args");
0364: }
0365:
0366: setError = TclBoolean.get(interp, objv[1]);
0367: allowAbbrev = TclBoolean.get(interp, objv[2]);
0368:
0369: argv = new String[objv.length - 3];
0370: for (i = 4; i < objv.length; i++) {
0371: argv[i - 4] = objv[i].toString();
0372: }
0373: argv[objv.length - 4] = null;
0374:
0375: // No need to worry about a cached table pointer matching the
0376: // newly allocated array pointer.
0377:
0378: index = TclIndex.get((setError ? interp : null), objv[3], argv,
0379: "token", (allowAbbrev ? 0 : TCL.EXACT));
0380: interp.setResult(index);
0381: }
0382:
0383: } // end class TestIndexObjCmd
0384:
0385: /*
0386: *----------------------------------------------------------------------
0387: *
0388: * TestintobjCmd -> TestIntObjCmd
0389: *
0390: * This procedure implements the "testintobj" command. It is used to
0391: * test the int Tcl object type implementation.
0392: *
0393: * Results:
0394: * A standard Tcl object result.
0395: *
0396: * Side effects:
0397: * Creates and frees int objects, and also converts objects to
0398: * have int type.
0399: *
0400: *----------------------------------------------------------------------
0401: */
0402:
0403: class TestIntObjCmd implements Command {
0404:
0405: public void cmdProc(Interp interp, // The current Tcl interpreter.
0406: TclObject[] objv) // The arguments passed to the command.
0407: throws TclException // The standard Tcl exception.
0408: {
0409: int intValue, varIndex, i;
0410: int longValue;
0411: String index, subCmd, string;
0412:
0413: if (objv.length < 3) {
0414: throw new TclNumArgsException(interp, 1, objv,
0415: "option arg ?arg ...?");
0416: }
0417:
0418: index = objv[2].toString();
0419: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0420:
0421: subCmd = objv[1].toString();
0422: if (subCmd.equals("set")) {
0423: if (objv.length != 4) {
0424: throw new TclNumArgsException(interp, 1, objv,
0425: "option arg ?arg ...?");
0426: }
0427: string = objv[3].toString();
0428: i = Util.getInt(interp, string);
0429: intValue = i;
0430:
0431: // The C implementation changes the internal rep of an unshared
0432: // object in the varPtr array. Jacl does not support functions
0433: // like Tcl_SetIntObj() so always use SetVarToObj().
0434:
0435: TestObjCmdUtil.SetVarToObj(varIndex, TclInteger
0436: .newInstance(intValue));
0437: interp.setResult(TestObjCmd.varPtr[varIndex]);
0438: } else if (subCmd.equals("set2")) { // doesn't set result
0439: if (objv.length != 4) {
0440: throw new TclNumArgsException(interp, 1, objv,
0441: "option arg ?arg ...?");
0442: }
0443: string = objv[3].toString();
0444: i = Util.getInt(interp, string);
0445: intValue = i;
0446:
0447: // The C implementation changes the internal rep of an unshared
0448: // object in the varPtr array. Jacl does not support functions
0449: // like Tcl_SetIntObj() so always use SetVarToObj().
0450:
0451: TestObjCmdUtil.SetVarToObj(varIndex, TclInteger
0452: .newInstance(intValue));
0453: } else if (subCmd.equals("setlong")) {
0454: if (objv.length != 4) {
0455: throw new TclNumArgsException(interp, 1, objv,
0456: "option arg ?arg ...?");
0457: }
0458: string = objv[3].toString();
0459: i = Util.getInt(interp, string);
0460: intValue = i;
0461:
0462: // The C implementation changes the internal rep of an unshared
0463: // object in the varPtr array. Jacl does not support functions
0464: // like Tcl_SetLongObj() so always use SetVarToObj().
0465:
0466: TestObjCmdUtil.SetVarToObj(varIndex, TclInteger
0467: .newInstance(intValue));
0468: interp.setResult(TestObjCmd.varPtr[varIndex]);
0469: } else if (subCmd.equals("setmaxlong")) {
0470: int maxLong = Integer.MAX_VALUE;
0471: if (objv.length != 3) {
0472: throw new TclNumArgsException(interp, 1, objv,
0473: "option arg ?arg ...?");
0474: }
0475:
0476: // The C implementation changes the internal rep of an unshared
0477: // object in the varPtr array. Jacl does not support functions
0478: // like Tcl_SetLongObj() so always use SetVarToObj().
0479:
0480: TestObjCmdUtil.SetVarToObj(varIndex, TclInteger
0481: .newInstance(maxLong));
0482: } else if (subCmd.equals("ismaxlong")) {
0483: if (objv.length != 3) {
0484: throw new TclNumArgsException(interp, 1, objv,
0485: "option arg ?arg ...?");
0486: }
0487: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0488: longValue = TclInteger.get(interp,
0489: TestObjCmd.varPtr[varIndex]);
0490: interp.setResult(((longValue == Integer.MAX_VALUE) ? "1"
0491: : "0"));
0492: } else if (subCmd.equals("get")) {
0493: if (objv.length != 3) {
0494: throw new TclNumArgsException(interp, 1, objv,
0495: "option arg ?arg ...?");
0496: }
0497: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0498: interp.setResult(TestObjCmd.varPtr[varIndex]);
0499: } else if (subCmd.equals("get2")) {
0500: if (objv.length != 3) {
0501: throw new TclNumArgsException(interp, 1, objv,
0502: "option arg ?arg ...?");
0503: }
0504: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0505: string = TestObjCmd.varPtr[varIndex].toString();
0506: interp.setResult(string);
0507: } else if (subCmd.equals("inttoobigtest")) {
0508: // If long ints have more bits than ints on this platform, verify
0509: // that Tcl_GetIntFromObj returns an error if the long int held
0510: // in an integer object's internal representation is too large
0511: // to fit in an int.
0512:
0513: if (objv.length != 3) {
0514: throw new TclNumArgsException(interp, 1, objv,
0515: "option arg ?arg ...?");
0516: }
0517:
0518: // 64 bit integer type not supported in Java
0519: interp.setResult(1);
0520: } else if (subCmd.equals("mult10")) {
0521: if (objv.length != 3) {
0522: throw new TclNumArgsException(interp, 1, objv,
0523: "option arg ?arg ...?");
0524: }
0525: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0526: intValue = TclInteger.get(interp,
0527: TestObjCmd.varPtr[varIndex]);
0528:
0529: // The C implementation changes the internal rep of an unshared
0530: // object in the varPtr array. Jacl does not support functions
0531: // like Tcl_SetIntObj() so always use SetVarToObj().
0532:
0533: TestObjCmdUtil.SetVarToObj(varIndex, TclInteger
0534: .newInstance(intValue * 10));
0535: interp.setResult(TestObjCmd.varPtr[varIndex]);
0536: } else if (subCmd.equals("div10")) {
0537: if (objv.length != 3) {
0538: throw new TclNumArgsException(interp, 1, objv,
0539: "option arg ?arg ...?");
0540: }
0541: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0542: intValue = TclInteger.get(interp,
0543: TestObjCmd.varPtr[varIndex]);
0544:
0545: // The C implementation changes the internal rep of an unshared
0546: // object in the varPtr array. Jacl does not support functions
0547: // like Tcl_SetIntObj() so always use SetVarToObj().
0548:
0549: TestObjCmdUtil.SetVarToObj(varIndex, TclInteger
0550: .newInstance(intValue / 10));
0551: interp.setResult(TestObjCmd.varPtr[varIndex]);
0552: } else {
0553: throw new TclException(interp, "bad option \"" + objv[1]
0554: + "\": must be set, get, get2, mult10, or div10");
0555: }
0556: }
0557:
0558: } // end class TestIntObjCmd
0559:
0560: /*
0561: *----------------------------------------------------------------------
0562: *
0563: * TestobjCmd --
0564: *
0565: * This procedure implements the "testobj" command. It is used to test
0566: * the type-independent portions of the Tcl object type implementation.
0567: *
0568: * Results:
0569: * A standard Tcl object result.
0570: *
0571: * Side effects:
0572: * Creates and frees objects.
0573: *
0574: *----------------------------------------------------------------------
0575: */
0576:
0577: class TestObjCmdImpl {
0578:
0579: public static void cmdProc(Interp interp, // The current Tcl interpreter.
0580: TclObject[] objv) // The arguments passed to the command.
0581: throws TclException // The standard Tcl exception.
0582: {
0583: int varIndex, destIndex, i;
0584: String index, subCmd, string;
0585:
0586: if (objv.length < 2) {
0587: throw new TclNumArgsException(interp, 1, objv,
0588: "option arg ?arg ...?");
0589: }
0590:
0591: subCmd = objv[1].toString();
0592: if (subCmd.equals("assign")) {
0593: if (objv.length != 4) {
0594: throw new TclNumArgsException(interp, 1, objv,
0595: "option arg ?arg ...?");
0596: }
0597: index = objv[2].toString();
0598: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0599: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0600: string = objv[3].toString();
0601: destIndex = TestObjCmdUtil.GetVariableIndex(interp, string);
0602: TestObjCmdUtil.SetVarToObj(destIndex,
0603: TestObjCmd.varPtr[varIndex]);
0604: interp.setResult(TestObjCmd.varPtr[destIndex]);
0605: } else if (subCmd.equals("convert")) {
0606: String typeName;
0607: if (objv.length != 4) {
0608: throw new TclNumArgsException(interp, 1, objv,
0609: "option arg ?arg ...?");
0610: }
0611: index = objv[2].toString();
0612: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0613: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0614: typeName = objv[3].toString();
0615:
0616: if (!TestObjCmdUtil.IsSupportedType(typeName)) {
0617: throw new TclException(interp, "no type " + typeName
0618: + " found");
0619: }
0620: TestObjCmdUtil.ConvertToType(interp,
0621: TestObjCmd.varPtr[varIndex], typeName);
0622: interp.setResult(TestObjCmd.varPtr[varIndex]);
0623: } else if (subCmd.equals("duplicate")) {
0624: if (objv.length != 4) {
0625: throw new TclNumArgsException(interp, 1, objv,
0626: "option arg ?arg ...?");
0627: }
0628: index = objv[2].toString();
0629: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0630: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0631: string = objv[3].toString();
0632: destIndex = TestObjCmdUtil.GetVariableIndex(interp, string);
0633: TestObjCmdUtil.SetVarToObj(destIndex,
0634: TestObjCmd.varPtr[varIndex].duplicate());
0635: interp.setResult(TestObjCmd.varPtr[destIndex]);
0636: } else if (subCmd.equals("freeallvars")) {
0637: if (objv.length != 2) {
0638: throw new TclNumArgsException(interp, 1, objv,
0639: "option arg ?arg ...?");
0640: }
0641: for (i = 0; i < TestObjCmd.NUMBER_OF_OBJECT_VARS; i++) {
0642: if (TestObjCmd.varPtr[i] != null) {
0643: TestObjCmd.varPtr[i].release();
0644: TestObjCmd.varPtr[i] = null;
0645: }
0646: }
0647: } else if (subCmd.equals("invalidateStringRep")) {
0648: if (objv.length != 3) {
0649: throw new TclNumArgsException(interp, 1, objv,
0650: "option arg ?arg ...?");
0651: }
0652: index = objv[2].toString();
0653: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0654: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0655: TestObjCmd.varPtr[varIndex].invalidateStringRep();
0656: interp.setResult(TestObjCmd.varPtr[varIndex]);
0657: } else if (subCmd.equals("newobj")) {
0658: if (objv.length != 3) {
0659: throw new TclNumArgsException(interp, 1, objv,
0660: "option arg ?arg ...?");
0661: }
0662: index = objv[2].toString();
0663: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0664: TestObjCmdUtil.SetVarToObj(varIndex, TclString
0665: .newInstance(""));
0666: interp.setResult(TestObjCmd.varPtr[varIndex]);
0667: } else if (subCmd.equals("objtype")) {
0668: String typeName;
0669:
0670: // return an object containing the name of the argument's type
0671: // of internal rep. If none exists, return "none".
0672:
0673: if (objv.length != 3) {
0674: throw new TclNumArgsException(interp, 1, objv,
0675: "option arg ?arg ...?");
0676: }
0677: typeName = TestObjCmdUtil.GetObjType(objv[2]);
0678: if (typeName == null) {
0679: typeName = "none";
0680: }
0681: interp.setResult(typeName);
0682: } else if (subCmd.equals("refcount")) {
0683: if (objv.length != 3) {
0684: throw new TclNumArgsException(interp, 1, objv,
0685: "option arg ?arg ...?");
0686: }
0687: index = objv[2].toString();
0688: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0689: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0690: interp.setResult(TestObjCmd.varPtr[varIndex].getRefCount());
0691: } else if (subCmd.equals("type")) {
0692: String typeName;
0693:
0694: if (objv.length != 3) {
0695: throw new TclNumArgsException(interp, 1, objv,
0696: "option arg ?arg ...?");
0697: }
0698: index = objv[2].toString();
0699: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0700: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0701: typeName = TestObjCmdUtil
0702: .GetObjType(TestObjCmd.varPtr[varIndex]);
0703: if (typeName == null) {
0704: typeName = "string";
0705: }
0706: interp.setResult(typeName);
0707: } else if (subCmd.equals("types")) {
0708: if (objv.length != 2) {
0709: throw new TclNumArgsException(interp, 1, objv,
0710: "option arg ?arg ...?");
0711: }
0712: interp.setResult(TestObjCmdUtil.GetObjTypes());
0713: } else {
0714: throw new TclException(
0715: interp,
0716: "bad option \""
0717: + objv[1]
0718: + "\": must be assign, convert, duplicate, freeallvars, "
0719: + "newobj, objcount, objtype, refcount, type, or types");
0720: }
0721: }
0722:
0723: } // end class TestObjCmdImpl
0724:
0725: /*
0726: *----------------------------------------------------------------------
0727: *
0728: * TeststringobjCmd -> TestStringObjCmd
0729: *
0730: * This procedure implements the "teststringobj" command. It is used to
0731: * test the string Tcl object type implementation.
0732: *
0733: * Results:
0734: * A standard Tcl object result.
0735: *
0736: * Side effects:
0737: * Creates and frees string objects, and also converts objects to
0738: * have string type.
0739: *
0740: *----------------------------------------------------------------------
0741: */
0742:
0743: class TestStringObjCmd implements Command {
0744:
0745: public void cmdProc(Interp interp, // The current Tcl interpreter.
0746: TclObject[] objv) // The arguments passed to the command.
0747: throws TclException // The standard Tcl exception.
0748: {
0749: int varIndex, option, i, length;
0750: final int MAX_STRINGS = 11;
0751: String[] strings = new String[MAX_STRINGS + 1];
0752: String index, string;
0753: String[] options = { "append", "appendstrings", "get", "get2",
0754: "length", "length2", "set", "set2", "setlength",
0755: "ualloc", "getunicode", null };
0756:
0757: if (objv.length < 3) {
0758: throw new TclNumArgsException(interp, 1, objv,
0759: "option arg ?arg ...?");
0760: }
0761:
0762: index = objv[2].toString();
0763: varIndex = TestObjCmdUtil.GetVariableIndex(interp, index);
0764: option = TclIndex.get(interp, objv[1], options, "option", 0);
0765:
0766: switch (option) {
0767: case 0: { // append
0768: if (objv.length != 5) {
0769: throw new TclNumArgsException(interp, 1, objv,
0770: "option arg ?arg ...?");
0771: }
0772: length = TclInteger.get(interp, objv[4]);
0773: if (TestObjCmd.varPtr[varIndex] == null) {
0774: TestObjCmdUtil.SetVarToObj(varIndex, TclString
0775: .newInstance(""));
0776: }
0777:
0778: // If the object bound to variable "varIndex" is shared, we must
0779: // "copy on write" and append to a copy of the object.
0780:
0781: if (TestObjCmd.varPtr[varIndex].isShared()) {
0782: TestObjCmdUtil.SetVarToObj(varIndex,
0783: TestObjCmd.varPtr[varIndex].duplicate());
0784: }
0785: string = objv[3].toString();
0786: if (length != -1) {
0787: string = string.substring(0, length);
0788: }
0789: TclString.append(TestObjCmd.varPtr[varIndex], string);
0790: interp.setResult(TestObjCmd.varPtr[varIndex]);
0791: break;
0792: }
0793: case 1: { // appendstrings
0794: if (objv.length > (MAX_STRINGS + 3)) {
0795: throw new TclNumArgsException(interp, 1, objv,
0796: "option arg ?arg ...?");
0797: }
0798: if (TestObjCmd.varPtr[varIndex] == null) {
0799: TestObjCmdUtil.SetVarToObj(varIndex, TclString
0800: .newInstance(""));
0801: }
0802:
0803: // If the object bound to variable "varIndex" is shared, we must
0804: // "copy on write" and append to a copy of the object.
0805:
0806: if (TestObjCmd.varPtr[varIndex].isShared()) {
0807: TestObjCmdUtil.SetVarToObj(varIndex,
0808: TestObjCmd.varPtr[varIndex].duplicate());
0809: }
0810: for (i = 3; i < objv.length; i++) {
0811: strings[i - 3] = objv[i].toString();
0812: }
0813: for (; i < (MAX_STRINGS + 1) + 3; i++) {
0814: strings[i - 3] = null;
0815: }
0816: // FIXME: Use of TclString.append() not same as Tcl_AppendStringsToObj()
0817: // WRT buffer capacity management.
0818: for (i = 0; i < (MAX_STRINGS + 1) && strings[i] != null; i++) {
0819: TclString.append(TestObjCmd.varPtr[varIndex],
0820: strings[i]);
0821: }
0822: interp.setResult(TestObjCmd.varPtr[varIndex]);
0823: break;
0824: }
0825: case 2: { // get
0826: if (objv.length != 3) {
0827: throw new TclNumArgsException(interp, 1, objv,
0828: "option arg ?arg ...?");
0829: }
0830: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0831: interp.setResult(TestObjCmd.varPtr[varIndex]);
0832: break;
0833: }
0834: case 3: { // get2
0835: if (objv.length != 3) {
0836: throw new TclNumArgsException(interp, 1, objv,
0837: "option arg ?arg ...?");
0838: }
0839: TestObjCmdUtil.CheckIfVarUnset(interp, varIndex);
0840: string = TestObjCmd.varPtr[varIndex].toString();
0841: interp.setResult(string);
0842: break;
0843: }
0844: case 4: { // length
0845: if (objv.length != 3) {
0846: throw new TclNumArgsException(interp, 1, objv,
0847: "option arg ?arg ...?");
0848: }
0849: interp
0850: .setResult((TestObjCmd.varPtr[varIndex] != null) ? TestObjCmd.varPtr[varIndex]
0851: .toString().length()
0852: : -1);
0853: break;
0854: }
0855: case 5: { // length2
0856: if (objv.length != 3) {
0857: throw new TclNumArgsException(interp, 1, objv,
0858: "option arg ?arg ...?");
0859: }
0860: if (TestObjCmd.varPtr[varIndex] != null) {
0861: TclString tstr = (TclString) TestObjCmd.varPtr[varIndex]
0862: .getInternalRep();
0863: // C Tcl's String.allocated is the number of bytes allocated for
0864: // a UTF-8 string - 1 byte for the termination char.
0865: length = (tstr.sbuf == null ? 0 : tstr.sbuf.capacity());
0866: if (length != 0 && tstr.sbuf.length() == 0) {
0867: // Empty string rep, report zero capacity
0868: length = 0;
0869: }
0870: } else {
0871: length = -1;
0872: }
0873: interp.setResult(length);
0874: break;
0875: }
0876: case 6: { // set
0877: if (objv.length != 4) {
0878: throw new TclNumArgsException(interp, 1, objv,
0879: "option arg ?arg ...?");
0880: }
0881:
0882: // The C implementation changes the internal rep of an unshared
0883: // object in the varPtr array. Jacl does not support functions
0884: // like Tcl_SetStringObj() so always use SetVarToObj().
0885:
0886: string = objv[3].toString();
0887: // Manage StringBuffer capacity so that tests pass
0888: StringBuffer sbuf = new StringBuffer(string.length());
0889: sbuf.append(string);
0890: TestObjCmdUtil.SetVarToObj(varIndex, TclString
0891: .newInstance(sbuf));
0892: interp.setResult(TestObjCmd.varPtr[varIndex]);
0893:
0894: break;
0895: }
0896: case 7: { // set2
0897: if (objv.length != 4) {
0898: throw new TclNumArgsException(interp, 1, objv,
0899: "option arg ?arg ...?");
0900: }
0901: TestObjCmdUtil.SetVarToObj(varIndex, objv[3]);
0902: break;
0903: }
0904: case 8: { // setlength
0905: if (objv.length != 4) {
0906: throw new TclNumArgsException(interp, 1, objv,
0907: "option arg ?arg ...?");
0908: }
0909: length = TclInteger.get(interp, objv[3]);
0910: if (TestObjCmd.varPtr[varIndex] != null) {
0911: // Jacl does not support Tcl_SetObjLength() so inline the logic here.
0912: TclObject tobj = TestObjCmd.varPtr[varIndex];
0913: TclString.append(tobj, ""); // Convert to TclString internal rep
0914: TclString tstr = (TclString) tobj.getInternalRep();
0915: // Allocate a new StringBuffer so that we can control the capacity.
0916: int prev_length = tstr.sbuf.length();
0917: String prev_str = tstr.sbuf.toString();
0918: if (length == 0) {
0919: tstr.sbuf = null;
0920: } else if (length < prev_length) {
0921: // Retain original capacity and shorten the length
0922: tstr.sbuf.setLength(length);
0923: } else if (length > prev_length) {
0924: // Expand capacity but keep the original string
0925: tstr.sbuf = new StringBuffer(length);
0926: tstr.sbuf.append(prev_str);
0927: tstr.sbuf.setLength(length);
0928: }
0929: tobj.invalidateStringRep();
0930: }
0931: break;
0932: }
0933: case 9: { // ualloc
0934: if (objv.length != 3) {
0935: throw new TclNumArgsException(interp, 1, objv,
0936: "option arg ?arg ...?");
0937: }
0938: if (TestObjCmd.varPtr[varIndex] != null) {
0939: TclString tstr = (TclString) TestObjCmd.varPtr[varIndex]
0940: .getInternalRep();
0941: // C Tcl's String.uallocated is the number of bytes allocated - 2
0942: // bytes for termination char. Jacl has no termination char.
0943: length = (tstr.sbuf == null ? 0
0944: : tstr.sbuf.capacity() * 2);
0945: } else {
0946: length = -1;
0947: }
0948: interp.setResult(length);
0949: break;
0950: }
0951: case 10: { // getunicode
0952: if (objv.length != 3) {
0953: throw new TclNumArgsException(interp, 1, objv,
0954: "option arg ?arg ...?");
0955: }
0956: TestObjCmd.varPtr[varIndex].toString();
0957: break;
0958: }
0959: }
0960: }
0961:
0962: } // end class TestStringObjCmd
0963:
0964: class TestObjCmdUtil {
0965:
0966: /*
0967: *----------------------------------------------------------------------
0968: *
0969: * SetVarToObj -> TestObjCmdUtil.SetVarToObj
0970: *
0971: * Utility routine to assign a TclObject to a test variable. The
0972: * TclObject can be null.
0973: *
0974: * Results:
0975: * None.
0976: *
0977: * Side effects:
0978: * This routine handles ref counting details for assignment:
0979: * i.e. the old value's ref count must be decremented (if not null) and
0980: * the new one incremented (also if not null).
0981: *
0982: *----------------------------------------------------------------------
0983: */
0984:
0985: static void SetVarToObj(int varIndex, TclObject objPtr) {
0986: if (TestObjCmd.varPtr[varIndex] != null) {
0987: TestObjCmd.varPtr[varIndex].release();
0988: }
0989: TestObjCmd.varPtr[varIndex] = objPtr;
0990: if (objPtr != null) {
0991: objPtr.preserve();
0992: }
0993: }
0994:
0995: /*
0996: *----------------------------------------------------------------------
0997: *
0998: * GetVariableIndex -> TestObjCmdUtil.GetVariableIndex
0999: *
1000: * Utility routine to get a test variable index from the command line.
1001: *
1002: * Results:
1003: * Returns the variable index.
1004: *
1005: * Side effects:
1006: * None.
1007: *
1008: *----------------------------------------------------------------------
1009: */
1010:
1011: static int GetVariableIndex(Interp interp, String string) // String containing a variable index
1012: // specified as a nonnegative number less
1013: // than NUMBER_OF_OBJECT_VARS.
1014: throws TclException {
1015: int index;
1016:
1017: index = Util.getInt(interp, string);
1018: if (index < 0 || index >= TestObjCmd.NUMBER_OF_OBJECT_VARS) {
1019: throw new TclException(interp, "bad variable index");
1020: }
1021:
1022: return index;
1023: }
1024:
1025: /*
1026: *----------------------------------------------------------------------
1027: *
1028: * CheckIfVarUnset -> TestObjCmdUtil.CheckIfVarUnset
1029: *
1030: * Utility procedure that checks whether a test variable is readable:
1031: * i.e., that varPtr[varIndex] is non-null.
1032: *
1033: * Results:
1034: * Raises a TclException if the var is unset.
1035: *
1036: * Side effects:
1037: *
1038: *----------------------------------------------------------------------
1039: */
1040:
1041: static void CheckIfVarUnset(Interp interp, int varIndex) // Index of the test variable to check.
1042: throws TclException {
1043: if (TestObjCmd.varPtr[varIndex] == null) {
1044: String msg = "variable " + varIndex + " is unset (NULL)";
1045: throw new TclException(interp, msg);
1046: }
1047: }
1048:
1049: // Return true if this is a supported type. This methods exists since
1050: // Jacl has no way to lookup supported types at runtime.
1051:
1052: static boolean IsSupportedType(String typeName) {
1053: // Note, many types like "end-offset" are not actually supported in Jacl
1054:
1055: if (typeName.equals("int")) {
1056: return true;
1057: } else if (typeName.equals("double")) {
1058: return true;
1059: } else if (typeName.equals("boolean")) {
1060: return true;
1061: } else if (typeName.equals("end-offset")) {
1062: return true;
1063: } else {
1064: return false;
1065: }
1066: }
1067:
1068: // Convert a TclObject to a named type. This method exists because
1069: // Jacl has no way to lookup a type or convert at runtime.
1070:
1071: static void ConvertToType(Interp interp, TclObject tobj,
1072: String typeName) throws TclException {
1073: if (typeName.equals("int")) {
1074: TclInteger.get(interp, tobj);
1075: } else if (typeName.equals("double")) {
1076: TclDouble.get(interp, tobj);
1077: } else if (typeName.equals("boolean")) {
1078: TclBoolean.get(interp, tobj);
1079: }
1080: }
1081:
1082: // Return the type name string of a TclObject.
1083:
1084: static String GetObjType(TclObject tobj) {
1085: InternalRep irep = tobj.getInternalRep();
1086:
1087: if (irep instanceof TclInteger) {
1088: return "int";
1089: } else if (irep instanceof TclDouble) {
1090: return "double";
1091: } else if (irep instanceof TclBoolean) {
1092: return "boolean";
1093: } else if (irep instanceof TclList) {
1094: return "list";
1095: } else if (irep instanceof TclString) {
1096: return "string";
1097: } else {
1098: return null;
1099: }
1100: }
1101:
1102: // Return a list of available types
1103:
1104: static String GetObjTypes() {
1105: String types = "{array search} boolean bytearray bytecode double end-offset index "
1106: + "int list nsName procbody string";
1107: return types;
1108: }
1109:
1110: } // end class TestObjCmdUtil
|