os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacTest.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacTest.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,213 @@
1.4 +/*
1.5 + * tclMacTest.c --
1.6 + *
1.7 + * Contains commands for platform specific tests for
1.8 + * the Macintosh platform.
1.9 + *
1.10 + * Copyright (c) 1996 Sun Microsystems, Inc.
1.11 + *
1.12 + * See the file "license.terms" for information on usage and redistribution
1.13 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.14 + *
1.15 + * RCS: @(#) $Id: tclMacTest.c,v 1.6 2002/10/09 11:54:42 das Exp $
1.16 + */
1.17 +
1.18 +#define TCL_TEST
1.19 +#define USE_COMPAT_CONST
1.20 +#include "tclInt.h"
1.21 +#include "tclMacInt.h"
1.22 +#include "tclMacPort.h"
1.23 +#include "Files.h"
1.24 +#include <Errors.h>
1.25 +#include <Resources.h>
1.26 +#include <Script.h>
1.27 +#include <Strings.h>
1.28 +#include <FSpCompat.h>
1.29 +
1.30 +/*
1.31 + * Forward declarations of procedures defined later in this file:
1.32 + */
1.33 +
1.34 +int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
1.35 +static int DebuggerCmd _ANSI_ARGS_((ClientData dummy,
1.36 + Tcl_Interp *interp, int argc, CONST char **argv));
1.37 +static int WriteTextResource _ANSI_ARGS_((ClientData dummy,
1.38 + Tcl_Interp *interp, int argc, CONST char **argv));
1.39 +
1.40 +
1.41 +/*
1.42 + *----------------------------------------------------------------------
1.43 + *
1.44 + * TclplatformtestInit --
1.45 + *
1.46 + * Defines commands that test platform specific functionality for
1.47 + * Unix platforms.
1.48 + *
1.49 + * Results:
1.50 + * A standard Tcl result.
1.51 + *
1.52 + * Side effects:
1.53 + * Defines new commands.
1.54 + *
1.55 + *----------------------------------------------------------------------
1.56 + */
1.57 +
1.58 +int
1.59 +TclplatformtestInit(
1.60 + Tcl_Interp *interp) /* Interpreter to add commands to. */
1.61 +{
1.62 + /*
1.63 + * Add commands for platform specific tests on MacOS here.
1.64 + */
1.65 +
1.66 + Tcl_CreateCommand(interp, "debugger", DebuggerCmd,
1.67 + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
1.68 + Tcl_CreateCommand(interp, "testWriteTextResource", WriteTextResource,
1.69 + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
1.70 +
1.71 + return TCL_OK;
1.72 +}
1.73 +
1.74 +/*
1.75 + *----------------------------------------------------------------------
1.76 + *
1.77 + * DebuggerCmd --
1.78 + *
1.79 + * This procedure simply calls the low level debugger.
1.80 + *
1.81 + * Results:
1.82 + * A standard Tcl result.
1.83 + *
1.84 + * Side effects:
1.85 + * None.
1.86 + *
1.87 + *----------------------------------------------------------------------
1.88 + */
1.89 +
1.90 +static int
1.91 +DebuggerCmd(
1.92 + ClientData clientData, /* Not used. */
1.93 + Tcl_Interp *interp, /* Not used. */
1.94 + int argc, /* Not used. */
1.95 + CONST char **argv) /* Not used. */
1.96 +{
1.97 + Debugger();
1.98 + return TCL_OK;
1.99 +}
1.100 +
1.101 +/*
1.102 + *----------------------------------------------------------------------
1.103 + *
1.104 + * WriteTextResource --
1.105 + *
1.106 + * This procedure will write a text resource out to the
1.107 + * application or a given file. The format for this command is
1.108 + * textwriteresource
1.109 + *
1.110 + * Results:
1.111 + * A standard Tcl result.
1.112 + *
1.113 + * Side effects:
1.114 + * None.
1.115 + *
1.116 + *----------------------------------------------------------------------
1.117 + */
1.118 +
1.119 +static int
1.120 +WriteTextResource(
1.121 + ClientData clientData, /* Not used. */
1.122 + Tcl_Interp *interp, /* Current interpreter. */
1.123 + int argc, /* Number of arguments. */
1.124 + CONST char **argv) /* Argument strings. */
1.125 +{
1.126 + char *errNum = "wrong # args: ";
1.127 + char *errBad = "bad argument: ";
1.128 + char *errStr;
1.129 + CONST char *fileName = NULL, *rsrcName = NULL;
1.130 + CONST char *data = NULL;
1.131 + int rsrcID = -1, i, protectIt = 0;
1.132 + short fileRef = -1;
1.133 + OSErr err;
1.134 + Handle dataHandle;
1.135 + Str255 resourceName;
1.136 + FSSpec fileSpec;
1.137 +
1.138 + /*
1.139 + * Process the arguments.
1.140 + */
1.141 + for (i = 1 ; i < argc ; i++) {
1.142 + if (!strcmp(argv[i], "-rsrc")) {
1.143 + rsrcName = argv[i + 1];
1.144 + i++;
1.145 + } else if (!strcmp(argv[i], "-rsrcid")) {
1.146 + rsrcID = atoi(argv[i + 1]);
1.147 + i++;
1.148 + } else if (!strcmp(argv[i], "-file")) {
1.149 + fileName = argv[i + 1];
1.150 + i++;
1.151 + } else if (!strcmp(argv[i], "-protected")) {
1.152 + protectIt = 1;
1.153 + } else {
1.154 + data = argv[i];
1.155 + }
1.156 + }
1.157 +
1.158 + if ((rsrcName == NULL && rsrcID < 0) ||
1.159 + (fileName == NULL) || (data == NULL)) {
1.160 + errStr = errBad;
1.161 + goto sourceFmtErr;
1.162 + }
1.163 +
1.164 + /*
1.165 + * Open the resource file.
1.166 + */
1.167 + err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
1.168 + if (!(err == noErr || err == fnfErr)) {
1.169 + Tcl_AppendResult(interp, "couldn't validate file name", (char *) NULL);
1.170 + return TCL_ERROR;
1.171 + }
1.172 +
1.173 + if (err == fnfErr) {
1.174 + FSpCreateResFile(&fileSpec, 'WIsH', 'rsrc', smSystemScript);
1.175 + }
1.176 + fileRef = FSpOpenResFile(&fileSpec, fsRdWrPerm);
1.177 + if (fileRef == -1) {
1.178 + Tcl_AppendResult(interp, "couldn't open resource file", (char *) NULL);
1.179 + return TCL_ERROR;
1.180 + }
1.181 +
1.182 + UseResFile(fileRef);
1.183 +
1.184 + /*
1.185 + * Prepare data needed to create resource.
1.186 + */
1.187 + if (rsrcID < 0) {
1.188 + rsrcID = UniqueID('TEXT');
1.189 + }
1.190 +
1.191 + strcpy((char *) resourceName, rsrcName);
1.192 + c2pstr((char *) resourceName);
1.193 +
1.194 + dataHandle = NewHandle(strlen(data));
1.195 + HLock(dataHandle);
1.196 + strcpy(*dataHandle, data);
1.197 + HUnlock(dataHandle);
1.198 +
1.199 + /*
1.200 + * Add the resource to the file and close it.
1.201 + */
1.202 + AddResource(dataHandle, 'TEXT', rsrcID, resourceName);
1.203 +
1.204 + UpdateResFile(fileRef);
1.205 + if (protectIt) {
1.206 + SetResAttrs(Get1Resource('TEXT', rsrcID), resProtected);
1.207 + }
1.208 +
1.209 + CloseResFile(fileRef);
1.210 + return TCL_OK;
1.211 +
1.212 + sourceFmtErr:
1.213 + Tcl_AppendResult(interp, errStr, "error in \"", argv[0], "\"",
1.214 + (char *) NULL);
1.215 + return TCL_ERROR;
1.216 +}