001: /*
002: * JtestCmd.java
003: *
004: * Copyright (c) 1997 Cornell University.
005: * Copyright (c) 1997 Sun Microsystems, Inc.
006: *
007: * See the file "license.terms" for information on usage and
008: * redistribution of this file, and for a DISCLAIMER OF ALL
009: * WARRANTIES.
010: *
011: * RCS: @(#) $Id: JtestCmd.java,v 1.5 2006/07/26 20:55:27 mdejong Exp $
012: *
013: */
014:
015: package tcl.lang;
016:
017: import java.util.*;
018:
019: /**
020: * This class implements the built-in "Jtest" command in Tcl. This
021: * command is used mainly for debug purposes. E.g., verify whether the
022: * refCount is maintained properly.
023: */
024:
025: class JtestCmd implements Command {
026: static final private String[] validCmds = { "compcode", "equal",
027: "gc", "getobject", "refcount", "type", "tclexception",
028: "npe" };
029:
030: static final private int OPT_COMPCODE = 0;
031: static final private int OPT_EQUAL = 1;
032: static final private int OPT_GC = 2;
033: static final private int OPT_GETOBJECT = 3;
034: static final private int OPT_REFCOUNT = 4;
035: static final private int OPT_TYPE = 5;
036: static final private int OPT_TCLEXCEPTION = 6;
037: static final private int OPT_NPE = 7;
038:
039: public void cmdProc(Interp interp, TclObject[] objv)
040: throws TclException {
041: if (objv.length < 2) {
042: throw new TclNumArgsException(interp, 1, objv,
043: "option ?arg arg ...?");
044: }
045: int opt = TclIndex.get(interp, objv[1], validCmds, "option", 0);
046:
047: switch (opt) {
048: case OPT_COMPCODE: {
049: // Returns a TclException completion code, or ""
050:
051: if (objv.length != 3) {
052: throw new TclException(interp,
053: "wrong # args: should be \"" + objv[0]
054: + " compcode script\"");
055: }
056:
057: TclObject obj = objv[2];
058: obj.preserve();
059: try {
060: interp.eval(obj, TCL.EVAL_GLOBAL);
061: } catch (TclException e) {
062: interp.setResult(e.getCompletionCode());
063: } finally {
064: obj.release();
065: }
066: break;
067: }
068: case OPT_EQUAL: {
069: // Returns if the two objects refer to the same Java object.
070:
071: if (objv.length != 4) {
072: throw new TclException(interp,
073: "wrong # args: should be \"" + objv[0]
074: + " equal object1 object2\"");
075: }
076:
077: TclObject obj1 = objv[2];
078: TclObject obj2 = objv[3];
079:
080: interp.setResult(obj1 == obj2);
081: break;
082: }
083: case OPT_GC: {
084: System.gc();
085: break;
086: }
087: case OPT_GETOBJECT: {
088: // Wraps a TclObject into a ReflectObject so that
089: // it can be passed to methods that take TclObject's.
090:
091: if (objv.length != 3) {
092: throw new TclNumArgsException(interp, 2, objv,
093: "tclvalue");
094: }
095: interp.setResult(ReflectObject.newInstance(interp,
096: TclObject.class, objv[2]));
097: break;
098: }
099: case OPT_REFCOUNT: {
100: // Returns the reference count of an object.
101: // E.g. jtest refcount $obj
102:
103: if (objv.length != 3) {
104: throw new TclException(interp,
105: "wrong # args: should be \"" + objv[0]
106: + " type object\"");
107: }
108:
109: TclObject o = objv[2];
110:
111: /*
112: * The following script will return 1
113: *
114: * set obj [java::new Object]
115: * jtest refcount $obj
116: *
117: * Subtract 1 from the returned refCount to account for
118: * the reference added by the 3rd argument to jtest.
119: */
120: interp.setResult(o.getRefCount() - 1);
121: break;
122: }
123: case OPT_TYPE: {
124: // Returns the Java class name of an object.
125: // E.g. info type $a
126:
127: if (objv.length != 3) {
128: throw new TclException(interp,
129: "wrong # args: should be \"" + objv[0]
130: + " type object\"");
131: }
132:
133: interp.setResult(TclString.newInstance(objv[2]
134: .getInternalRep().getClass().getName()));
135: break;
136: }
137: case OPT_TCLEXCEPTION: {
138: // Raise a TclException
139:
140: throw new TclException(interp, "msg");
141: }
142: case OPT_NPE: {
143: // Raise a NPE, it extends RuntimeException
144:
145: throw new NullPointerException();
146: }
147: } // end switch block
148: }
149: }
|