Source Code Cross Referenced for TestObjCmd.java in  » Scripting » jacl » tcl » lang » Java Source Code / Java DocumentationJava Source Code and Java Documentation

Java Source Code / Java Documentation
1. 6.0 JDK Core
2. 6.0 JDK Modules
3. 6.0 JDK Modules com.sun
4. 6.0 JDK Modules com.sun.java
5. 6.0 JDK Modules sun
6. 6.0 JDK Platform
7. Ajax
8. Apache Harmony Java SE
9. Aspect oriented
10. Authentication Authorization
11. Blogger System
12. Build
13. Byte Code
14. Cache
15. Chart
16. Chat
17. Code Analyzer
18. Collaboration
19. Content Management System
20. Database Client
21. Database DBMS
22. Database JDBC Connection Pool
23. Database ORM
24. Development
25. EJB Server geronimo
26. EJB Server GlassFish
27. EJB Server JBoss 4.2.1
28. EJB Server resin 3.1.5
29. ERP CRM Financial
30. ESB
31. Forum
32. GIS
33. Graphic Library
34. Groupware
35. HTML Parser
36. IDE
37. IDE Eclipse
38. IDE Netbeans
39. Installer
40. Internationalization Localization
41. Inversion of Control
42. Issue Tracking
43. J2EE
44. JBoss
45. JMS
46. JMX
47. Library
48. Mail Clients
49. Net
50. Parser
51. PDF
52. Portal
53. Profiler
54. Project Management
55. Report
56. RSS RDF
57. Rule Engine
58. Science
59. Scripting
60. Search Engine
61. Security
62. Sevlet Container
63. Source Control
64. Swing Library
65. Template Engine
66. Test Coverage
67. Testing
68. UML
69. Web Crawler
70. Web Framework
71. Web Mail
72. Web Server
73. Web Services
74. Web Services apache cxf 2.0.1
75. Web Services AXIS2
76. Wiki Engine
77. Workflow Engines
78. XML
79. XML UI
Java
Java Tutorial
Java Open Source
Jar File Download
Java Articles
Java Products
Java by API
Photoshop Tutorials
Maya Tutorials
Flash Tutorials
3ds-Max Tutorials
Illustrator Tutorials
GIMP Tutorials
C# / C Sharp
C# / CSharp Tutorial
C# / CSharp Open Source
ASP.Net
ASP.NET Tutorial
JavaScript DHTML
JavaScript Tutorial
JavaScript Reference
HTML / CSS
HTML CSS Reference
C / ANSI-C
C Tutorial
C++
C++ Tutorial
Ruby
PHP
Python
Python Tutorial
Python Open Source
SQL Server / T-SQL
SQL Server / T-SQL Tutorial
Oracle PL / SQL
Oracle PL/SQL Tutorial
PostgreSQL
SQL / MySQL
MySQL Tutorial
VB.Net
VB.Net Tutorial
Flash / Flex / ActionScript
VBA / Excel / Access / Word
XML
XML Tutorial
Microsoft Office PowerPoint 2007 Tutorial
Microsoft Office Excel 2007 Tutorial
Microsoft Office Word 2007 Tutorial
Java Source Code / Java Documentation » Scripting » jacl » tcl.lang 
Source Cross Referenced  Class Diagram Java Document (Java Doc) 


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
www.java2java.com | Contact Us
Copyright 2009 - 12 Demo Source and Support. All rights reserved.
All other trademarks are property of their respective owners.