summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclIOCmd.c118
1 files changed, 51 insertions, 67 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index cc01b91..ceed522 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOCmd.c,v 1.46 2007/11/18 22:32:47 dkf Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.47 2007/11/19 14:50:55 dkf Exp $
*/
#include "tclInt.h"
@@ -121,7 +121,7 @@ Tcl_PutsObjCmd(
}
chan = Tcl_GetChannel(interp, channelId, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
@@ -192,7 +192,7 @@ Tcl_FlushObjCmd(
}
channelId = TclGetString(objv[1]);
chan = Tcl_GetChannel(interp, channelId, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
@@ -255,7 +255,7 @@ Tcl_GetsObjCmd(
}
name = TclGetString(objv[1]);
chan = Tcl_GetChannel(interp, name, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
@@ -363,7 +363,7 @@ Tcl_ReadObjCmd(
name = TclGetString(objv[i]);
chan = Tcl_GetChannel(interp, name, &mode);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
@@ -477,7 +477,7 @@ Tcl_SeekObjCmd(
}
chanName = TclGetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
@@ -550,7 +550,7 @@ Tcl_TellObjCmd(
chanName = TclGetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
@@ -605,7 +605,7 @@ Tcl_CloseObjCmd(
arg = TclGetString(objv[1]);
chan = Tcl_GetChannel(interp, arg, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
@@ -621,11 +621,10 @@ Tcl_CloseObjCmd(
* a terminating newline.
*/
- Tcl_Obj *resultPtr;
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *string;
int len;
- resultPtr = Tcl_GetObjResult(interp);
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
Tcl_SetObjResult(interp, resultPtr);
@@ -677,7 +676,7 @@ Tcl_FconfigureObjCmd(
chanName = TclGetString(objv[1]);
chan = Tcl_GetChannel(interp, chanName, NULL);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
@@ -874,7 +873,7 @@ Tcl_ExecObjCmd(
TclStackFree(interp, (void *)argv);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
@@ -901,7 +900,7 @@ Tcl_ExecObjCmd(
* the regular message if nothing was found in the bypass.
*/
- if (!TclChanCaughtErrorBypass (interp, chan)) {
+ if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading output from command: ",
Tcl_PosixError(interp), NULL);
@@ -1096,7 +1095,7 @@ Tcl_OpenObjCmd(
}
ckfree((char *) cmdArgv);
}
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
@@ -1132,15 +1131,14 @@ TcpAcceptCallbacksDeleteProc(
* was registered. */
Tcl_Interp *interp) /* Interpreter being deleted - not used. */
{
- Tcl_HashTable *hTblPtr;
+ Tcl_HashTable *hTblPtr = clientData;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
- AcceptCallback *acceptCallbackPtr;
- hTblPtr = (Tcl_HashTable *) clientData;
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
- acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
+ AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);
+
acceptCallbackPtr->interp = NULL;
}
Tcl_DeleteHashTable(hTblPtr);
@@ -1188,14 +1186,14 @@ RegisterTcpServerInterpCleanup(
hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
(void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
- TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr);
+ TcpAcceptCallbacksDeleteProc, hTblPtr);
}
hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &isNew);
if (!isNew) {
Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table");
}
- Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr);
+ Tcl_SetHashValue(hPtr, acceptCallbackPtr);
}
/*
@@ -1267,13 +1265,7 @@ AcceptCallbackProc(
char *address, /* Address of client that was accepted. */
int port) /* Port of client that was accepted. */
{
- AcceptCallback *acceptCallbackPtr;
- Tcl_Interp *interp;
- char *script;
- char portBuf[TCL_INTEGER_SPACE];
- int result;
-
- acceptCallbackPtr = (AcceptCallback *) callbackData;
+ AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
/*
* Check if the callback is still valid; the interpreter may have gone
@@ -1282,12 +1274,13 @@ AcceptCallbackProc(
*/
if (acceptCallbackPtr->interp != NULL) {
+ char portBuf[TCL_INTEGER_SPACE];
+ char *script = acceptCallbackPtr->script;
+ Tcl_Interp *interp = acceptCallbackPtr->interp;
+ int result;
- script = acceptCallbackPtr->script;
- interp = acceptCallbackPtr->interp;
-
- Tcl_Preserve((ClientData) script);
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(script);
+ Tcl_Preserve(interp);
TclFormatInt(portBuf, port);
Tcl_RegisterChannel(interp, chan);
@@ -1313,9 +1306,8 @@ AcceptCallbackProc(
Tcl_UnregisterChannel(NULL, chan);
- Tcl_Release((ClientData) interp);
- Tcl_Release((ClientData) script);
-
+ Tcl_Release(interp);
+ Tcl_Release(script);
} else {
/*
* The interpreter has been deleted, so there is no useful way to
@@ -1352,15 +1344,14 @@ TcpServerCloseProc(
ClientData callbackData) /* The data passed in the call to
* Tcl_CreateCloseHandler. */
{
- AcceptCallback *acceptCallbackPtr;
+ AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
/* The actual data. */
- acceptCallbackPtr = (AcceptCallback *) callbackData;
if (acceptCallbackPtr->interp != NULL) {
UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
acceptCallbackPtr);
}
- Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
+ Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
ckfree((char *) acceptCallbackPtr);
}
@@ -1394,23 +1385,17 @@ Tcl_SocketObjCmd(
enum socketOptions {
SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
};
- int optionIndex, a, server, port;
- char *arg, *copyScript, *host, *script;
- char *myaddr = NULL;
- int myport = 0;
- int async = 0;
+ int optionIndex, a, server = 0, port, myport = 0, async = 0;
+ char *host, *script = NULL, *myaddr = NULL;
Tcl_Channel chan;
- AcceptCallback *acceptCallbackPtr;
-
- server = 0;
- script = NULL;
if (TclpHasSockets(interp) != TCL_OK) {
return TCL_ERROR;
}
for (a = 1; a < objc; a++) {
- arg = TclGetString(objv[a]);
+ const char *arg = Tcl_GetString(objv[a]);
+
if (arg[0] != '-') {
break;
}
@@ -1504,15 +1489,17 @@ Tcl_SocketObjCmd(
}
if (server) {
- acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned)
- sizeof(AcceptCallback));
- copyScript = ckalloc((unsigned) strlen(script) + 1);
- strcpy(copyScript, script);
+ AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
+ ckalloc((unsigned) sizeof(AcceptCallback));
+ unsigned len = strlen(script) + 1;
+ char *copyScript = ckalloc(len);
+
+ memcpy(copyScript, script, len);
acceptCallbackPtr->script = copyScript;
acceptCallbackPtr->interp = interp;
chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
- (ClientData) acceptCallbackPtr);
- if (chan == (Tcl_Channel) NULL) {
+ acceptCallbackPtr);
+ if (chan == NULL) {
ckfree(copyScript);
ckfree((char *) acceptCallbackPtr);
return TCL_ERROR;
@@ -1533,11 +1520,10 @@ Tcl_SocketObjCmd(
* be informed when the interpreter is deleted.
*/
- Tcl_CreateCloseHandler(chan, TcpServerCloseProc,
- (ClientData) acceptCallbackPtr);
+ Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
} else {
chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
- if (chan == (Tcl_Channel) NULL) {
+ if (chan == NULL) {
return TCL_ERROR;
}
}
@@ -1573,9 +1559,8 @@ Tcl_FcopyObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel inChan, outChan;
- char *arg;
- int mode, i;
- int toRead, index;
+ const char *arg;
+ int mode, i, toRead, index;
Tcl_Obj *cmdPtr;
static const char* switches[] = { "-size", "-command", NULL };
enum { FcopySize, FcopyCommand };
@@ -1593,7 +1578,7 @@ Tcl_FcopyObjCmd(
arg = TclGetString(objv[1]);
inChan = Tcl_GetChannel(interp, arg, &mode);
- if (inChan == (Tcl_Channel) NULL) {
+ if (inChan == NULL) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
@@ -1603,7 +1588,7 @@ Tcl_FcopyObjCmd(
}
arg = TclGetString(objv[2]);
outChan = Tcl_GetChannel(interp, arg, &mode);
- if (outChan == (Tcl_Channel) NULL) {
+ if (outChan == NULL) {
return TCL_ERROR;
}
if ((mode & TCL_WRITABLE) == 0) {
@@ -1616,7 +1601,7 @@ Tcl_FcopyObjCmd(
cmdPtr = NULL;
for (i = 3; i < objc; i += 2) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
- (int *) &index) != TCL_OK) {
+ &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
@@ -1639,9 +1624,8 @@ Tcl_FcopyObjCmd(
*
* TclChanPendingObjCmd --
*
- * This function is invoked to process the Tcl "chan pending"
- * command (TIP #287). See the user documentation for details on
- * what it does.
+ * This function is invoked to process the Tcl "chan pending" command
+ * (TIP #287). See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -1673,7 +1657,7 @@ TclChanPendingObjCmd(
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}