tcltest.c

tcl是工具命令语言

/* 
 * tclTest.c --
 *
 *	This file contains C command procedures for a bunch of additional
 *	Tcl commands that are used for testing out Tcl's C interfaces.
 *	These commands are not normally included in Tcl applications;
 *	they're only used for testing.
 *
 * Copyright (c) 1993-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.62 2003/02/18 10:13:25 vincentdarley Exp $
 */

#define TCL_TEST
#include "tclInt.h"
#include "tclPort.h"

/*
 * Required for Testregexp*Cmd
 */
#include "tclRegexp.h"

/*
 * Required for TestlocaleCmd
 */
#include <locale.h>

/*
 * Required for the TestChannelCmd and TestChannelEventCmd
 */
#include "tclIO.h"

/*
 * Declare external functions used in Windows tests.
 */

/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc;  used
 * to collect the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;

/*
 * One of the following structures exists for each asynchronous
 * handler created by the "testasync" command".
 */

typedef struct TestAsyncHandler {
    int id;				/* Identifier for this handler. */
    Tcl_AsyncHandler handler;		/* Tcl's token for the handler. */
    char *command;			/* Command to invoke when the
					 * handler is invoked. */
    struct TestAsyncHandler *nextPtr;	/* Next is list of handlers. */
} TestAsyncHandler;

static TestAsyncHandler *firstHandler = NULL;

/*
 * The dynamic string below is used by the "testdstring" command
 * to test the dynamic string facilities.
 */

static Tcl_DString dstring;

/*
 * The command trace below is used by the "testcmdtraceCmd" command
 * to test the command tracing facilities.
 */

static Tcl_Trace cmdTrace;

/*
 * One of the following structures exists for each command created
 * by TestdelCmd:
 */

typedef struct DelCmd {
    Tcl_Interp *interp;		/* Interpreter in which command exists. */
    char *deleteCmd;		/* Script to execute when command is
				 * deleted.  Malloc'ed. */
} DelCmd;

/*
 * The following is used to keep track of an encoding that invokes a Tcl
 * command. 
 */

typedef struct TclEncoding {
    Tcl_Interp *interp;
    char *toUtfCmd;
    char *fromUtfCmd;
} TclEncoding;

/*
 * The counter below is used to determine if the TestsaveresultFree
 * routine was called for a result.
 */

static int freeCount;

/*
 * Boolean flag used by the "testsetmainloop" and "testexitmainloop"
 * commands.
 */
static int exitMainLoop = 0;

/*
 * Event structure used in testing the event queue management procedures.
 */
typedef struct TestEvent {
    Tcl_Event header;		/* Header common to all events */
    Tcl_Interp* interp;		/* Interpreter that will handle the event */
    Tcl_Obj* command;		/* Command to evaluate when the event occurs */
    Tcl_Obj* tag;		/* Tag for this event used to delete it */
} TestEvent;

/*
 * Forward declarations for procedures defined later in this file:
 */

int			Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
static int		AsyncHandlerProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int code));
static void		CleanupTestSetassocdataTests _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
static void		CmdDelProc1 _ANSI_ARGS_((ClientData clientData));
static void		CmdDelProc2 _ANSI_ARGS_((ClientData clientData));
static int		CmdProc1 _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		CmdProc2 _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static void		CmdTraceDeleteProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int level, char *command, Tcl_CmdProc *cmdProc,
			    ClientData cmdClientData, int argc,
			    char **argv));
static void		CmdTraceProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int level, char *command,
			    Tcl_CmdProc *cmdProc, ClientData cmdClientData,
                            int argc, char **argv));
static int		CreatedCommandProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int argc, CONST char **argv));
static int		CreatedCommandProc2 _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int argc, CONST char **argv));
static void		DelCallbackProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp));
static int		DelCmdProc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static void		DelDeleteProc _ANSI_ARGS_((ClientData clientData));
static void		EncodingFreeProc _ANSI_ARGS_((ClientData clientData));
static int		EncodingToUtfProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst,
			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
static int		EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData,
			    CONST char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst,
			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr));
static void		ExitProcEven _ANSI_ARGS_((ClientData clientData));
static void		ExitProcOdd _ANSI_ARGS_((ClientData clientData));
static int              GetTimesCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, CONST char **argv));
static void		MainLoop _ANSI_ARGS_((void));
static int              NoopCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int argc, CONST char **argv));
static int              NoopObjCmd _ANSI_ARGS_((ClientData clientData,
                            Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		ObjTraceProc _ANSI_ARGS_(( ClientData clientData,
						   Tcl_Interp* interp,
						   int level,
						   CONST char* command,
						   Tcl_Command commandToken,
						   int objc,
						   Tcl_Obj *CONST objv[] ));
static void		ObjTraceDeleteProc _ANSI_ARGS_(( ClientData ));
static void		PrintParse _ANSI_ARGS_((Tcl_Interp *interp,
						Tcl_Parse *parsePtr));
static void		SpecialFree _ANSI_ARGS_((char *blockPtr));
static int		StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp));
static int		TestaccessprocCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		PretendTclpAccess _ANSI_ARGS_((CONST char *path,
			   int mode));
static int		TestAccessProc1 _ANSI_ARGS_((CONST char *path,
			   int mode));
static int		TestAccessProc2 _ANSI_ARGS_((CONST char *path,
			   int mode));
static int		TestAccessProc3 _ANSI_ARGS_((CONST char *path,
			   int mode));
static int		TestasyncCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestchmodCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestdcallCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestdelCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestdstringCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestencodingObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
static int		TestevalexObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
static int		TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
static int		TesteventObjCmd _ANSI_ARGS_((ClientData unused,
						     Tcl_Interp* interp,
						     int argc,
						     Tcl_Obj *CONST objv[]));
static int		TesteventProc _ANSI_ARGS_((Tcl_Event* event,
						   int flags));
static int		TesteventDeleteProc _ANSI_ARGS_((
			    Tcl_Event* event,
			    ClientData clientData));
static int		TestexithandlerCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestexprlongCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		TestexprstringCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestfileCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int		TestfilelinkCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int		TestfeventCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestgetplatformCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestgetvarfullnameCmd _ANSI_ARGS_((
			    ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]));
static int		TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy,
		            Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestlinkCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestlocaleCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		TestMathFunc _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, Tcl_Value *args,
			    Tcl_Value *resultPtr));
static int		TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, Tcl_Value *args,
			    Tcl_Value *resultPtr));
static int		TestmainthreadCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static Tcl_Channel	PretendTclpOpenFileChannel _ANSI_ARGS_((
			    Tcl_Interp *interp, CONST char *fileName,
			    CONST char *modeString, int permissions));
static Tcl_Channel	TestOpenFileChannelProc1 _ANSI_ARGS_((
			    Tcl_Interp *interp, CONST char *fileName,
			    CONST char *modeString, int permissions));
static Tcl_Channel	TestOpenFileChannelProc2 _ANSI_ARGS_((
			    Tcl_Interp *interp, CONST char *fileName,
			    CONST char *modeString, int permissions));
static Tcl_Channel	TestOpenFileChannelProc3 _ANSI_ARGS_((
			    Tcl_Interp *interp, CONST char *fileName,
			    CONST char *modeString, int permissions));
static int		TestpanicCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestparserObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		TestparsevarObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		TestparsevarnameObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static int		TestregexpObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static void		TestregexpXflags _ANSI_ARGS_((char *string,
			    int length, int *cflagsPtr, int *eflagsPtr));
static int		TestsaveresultCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static void		TestsaveresultFree _ANSI_ARGS_((char *blockPtr));
static int		TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestsetCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestsetobjerrorcodeCmd _ANSI_ARGS_((
			    ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]));
static int		TestopenfilechannelprocCmd _ANSI_ARGS_((
			    ClientData dummy, Tcl_Interp *interp, int argc,
			    CONST char **argv));
static int		TestsetplatformCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		PretendTclpStat _ANSI_ARGS_((CONST char *path,
			    struct stat *buf));
static int		TestStatProc1 _ANSI_ARGS_((CONST char *path,
			    struct stat *buf));
static int		TestStatProc2 _ANSI_ARGS_((CONST char *path,
			    struct stat *buf));
static int		TestStatProc3 _ANSI_ARGS_((CONST char *path,
			    struct stat *buf));
static int		TeststatprocCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestupvarCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int              TestWrongNumArgsObjCmd _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]));
static int              TestGetIndexFromObjStructObjCmd _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *CONST objv[]));
static int		TestChannelCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static int		TestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, CONST char **argv));
/* Filesystem testing */

static int		TestFilesystemObjCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));
static int		TestSimpleFilesystemObjCmd _ANSI_ARGS_((
			    ClientData dummy, Tcl_Interp *interp, int objc, 
			    Tcl_Obj *CONST objv[]));

static void             TestReport _ANSI_ARGS_ ((CONST char* cmd, Tcl_Obj* arg1, 
			    Tcl_Obj* arg2));

static Tcl_Obj*         TestReportGetNativePath _ANSI_ARGS_ ((
			    Tcl_Obj* pathObjPtr));

static int		TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path,
			    Tcl_StatBuf *buf));
static int		TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path,
			    int mode));
static Tcl_Channel	TestReportOpenFileChannel _ANSI_ARGS_ ((
			    Tcl_Interp *interp, Tcl_Obj *fileName,
			    int mode, int permissions));
static int		TestReportMatchInDirectory _ANSI_ARGS_ ((
			    Tcl_Interp *interp, Tcl_Obj *resultPtr,
			    Tcl_Obj *dirPtr, CONST char *pattern,
			    Tcl_GlobTypeData *types));
static int		TestReportChdir _ANSI_ARGS_ ((Tcl_Obj *dirName));
static int		TestReportLstat _ANSI_ARGS_ ((Tcl_Obj *path,
			    Tcl_StatBuf *buf));
static int		TestReportCopyFile _ANSI_ARGS_ ((Tcl_Obj *src,
			    Tcl_Obj *dst));
static int		TestReportDeleteFile _ANSI_ARGS_ ((Tcl_Obj *path));
static int		TestReportRenameFile _ANSI_ARGS_ ((Tcl_Obj *src,
			    Tcl_Obj *dst));
static int		TestReportCreateDirectory _ANSI_ARGS_ ((Tcl_Obj *path));
static int		TestReportCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *src,
			    Tcl_Obj *dst, Tcl_Obj **errorPtr));
static int		TestReportRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *path,
			    int recursive, Tcl_Obj **errorPtr));
static int		TestReportLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp,
			    Tcl_Obj *fileName,