diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 99 |
1 files changed, 93 insertions, 6 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index a9dc1ca..ebd90ae 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -67,6 +67,18 @@ typedef struct TestAsyncHandler { /* Next is list of handlers. */ } TestAsyncHandler; +/* + * Start of the socket driver state structure to acces field testFlags + */ + +typedef struct TcpState TcpState; + +struct TcpState { + Tcl_Channel channel; /* Channel associated with this socket. */ + int testFlags; /* bit field for tests. Is set by testsocket + * test procedure */ +}; + TCL_DECLARE_MUTEX(asyncTestMutex) static TestAsyncHandler *firstHandler = NULL; @@ -364,6 +376,8 @@ static int TestChannelCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); static int TestChannelEventCmd(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); +static int TestSocketCmd(ClientData clientData, + Tcl_Interp *interp, int argc, const char **argv); static int TestFilesystemObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -676,6 +690,8 @@ Tcltest_Init( TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); + Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, + NULL, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, NULL, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", @@ -3405,7 +3421,7 @@ TestMathFunc2( resultPtr->type = TCL_WIDE_INT; resultPtr->wideValue = ((w0 > w1)? w0 : w1); } else { - Tcl_SetResult(interp, (char *)"T3: wrong type for arg 2", TCL_STATIC); + Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL); result = TCL_ERROR; } } else if (args[0].type == TCL_DOUBLE) { @@ -3427,7 +3443,7 @@ TestMathFunc2( resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); } else { - Tcl_SetResult(interp, (char *)"T3: wrong type for arg 2", TCL_STATIC); + Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL); result = TCL_ERROR; } } else if (args[0].type == TCL_WIDE_INT) { @@ -3450,11 +3466,11 @@ TestMathFunc2( resultPtr->type = TCL_WIDE_INT; resultPtr->wideValue = ((w0 > w1)? w0 : w1); } else { - Tcl_SetResult(interp, (char *)"T3: wrong type for arg 2", TCL_STATIC); + Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL); result = TCL_ERROR; } } else { - Tcl_SetResult(interp, (char *)"T3: wrong type for arg 1", TCL_STATIC); + Tcl_AppendResult(interp, "T3: wrong type for arg 1", NULL); result = TCL_ERROR; } return result; @@ -3847,6 +3863,7 @@ TestprintObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_WideInt argv1 = 0; + size_t argv2; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "format wideint"); @@ -3855,7 +3872,8 @@ TestprintObjCmd( if (objc > 1) { Tcl_GetWideIntFromObj(interp, objv[2], &argv1); } - Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1)); + argv2 = (size_t)argv1; + Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2)); return TCL_OK; } @@ -6079,6 +6097,75 @@ TestChannelEventCmd( /* *---------------------------------------------------------------------- * + * TestSocketCmd -- + * + * Implements the Tcl "testsocket" debugging command and its + * subcommands. This is part of the testing environment. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestSocketCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Interpreter for result. */ + int argc, /* Count of additional args. */ + const char **argv) /* Additional arg strings. */ +{ + const char *cmdName; /* Sub command. */ + size_t len; /* Length of subcommand string. */ + + if (argc < 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " subcommand ?additional args..?\"", NULL); + return TCL_ERROR; + } + cmdName = argv[1]; + len = strlen(cmdName); + + if ((cmdName[0] == 't') && (strncmp(cmdName, "testflags", len) == 0)) { + Tcl_Channel hChannel; + int modePtr; + TcpState *statePtr; + /* Set test value in the socket driver + */ + /* Check for argument "channel name" + */ + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " testflags channel flags\"", NULL); + return TCL_ERROR; + } + hChannel = Tcl_GetChannel(interp, argv[2], &modePtr); + if ( NULL == hChannel ) { + Tcl_AppendResult(interp, "unknown channel:", argv[2], NULL); + return TCL_ERROR; + } + statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel); + if ( NULL == statePtr) { + Tcl_AppendResult(interp, "No channel instance data:", argv[2], + NULL); + return TCL_ERROR; + } + statePtr->testFlags = atoi(argv[3]); + return TCL_OK; + } + + Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be " + "testflags", NULL); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * * TestWrongNumArgsObjCmd -- * * Test the Tcl_WrongNumArgs function. @@ -6749,7 +6836,7 @@ TestNumUtfCharsCmd( int len = -1; if (objc > 2) { - (void) Tcl_GetStringFromObj(objv[1], &len); + (void) Tcl_GetIntFromObj(interp, objv[2], &len); } len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len); Tcl_SetObjResult(interp, Tcl_NewIntObj(len)); |