summaryrefslogtreecommitdiffstats
path: root/generic/tclIOCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIOCmd.c')
-rw-r--r--generic/tclIOCmd.c103
1 files changed, 38 insertions, 65 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index e8a534f..4ce27bb 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -44,7 +44,7 @@ static void RegisterTcpServerInterpCleanup(
Tcl_Interp *interp,
AcceptCallback *acceptCallbackPtr);
static Tcl_InterpDeleteProc TcpAcceptCallbacksDeleteProc;
-static void TcpServerCloseProc(void *callbackData);
+static void TcpServerCloseProc(ClientData callbackData);
static void UnregisterTcpServerInterpCleanupProc(
Tcl_Interp *interp,
AcceptCallback *acceptCallbackPtr);
@@ -132,19 +132,6 @@ Tcl_PutsObjCmd(
chanObjPtr = objv[2];
string = objv[3];
break;
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
- } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
- /*
- * The code below provides backwards compatibility with an old
- * form of the command that is no longer recommended or
- * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
- * maybe even earlier.
- */
-
- chanObjPtr = objv[1];
- string = objv[2];
- break;
-#endif
}
/* Fall through */
default: /* [puts] or
@@ -176,12 +163,12 @@ Tcl_PutsObjCmd(
TclChannelPreserve(chan);
result = Tcl_WriteObj(chan, string);
- if (result < 0) {
+ if (result == -1) {
goto error;
}
if (newline != 0) {
result = Tcl_WriteChars(chan, "\n", 1);
- if (result < 0) {
+ if (result == -1) {
goto error;
}
}
@@ -293,7 +280,7 @@ Tcl_GetsObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to read from. */
- int lineLen; /* Length of line just read. */
+ size_t lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *linePtr, *chanObjPtr;
int code = TCL_OK;
@@ -316,7 +303,7 @@ Tcl_GetsObjCmd(
TclChannelPreserve(chan);
TclNewObj(linePtr);
lineLen = Tcl_GetsObj(chan, linePtr);
- if (lineLen < 0) {
+ if (lineLen == TCL_IO_FAILURE) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
Tcl_DecrRefCount(linePtr);
@@ -335,7 +322,7 @@ Tcl_GetsObjCmd(
code = TCL_ERROR;
goto done;
}
- lineLen = TCL_INDEX_NONE;
+ lineLen = TCL_IO_FAILURE;
}
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
@@ -343,7 +330,7 @@ Tcl_GetsObjCmd(
code = TCL_ERROR;
goto done;
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(lineLen));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(lineLen + 1U)) - 1));
} else {
Tcl_SetObjResult(interp, linePtr);
}
@@ -378,8 +365,8 @@ Tcl_ReadObjCmd(
{
Tcl_Channel chan; /* The channel to read from. */
int newline, i; /* Discard newline at end? */
- int toRead; /* How many bytes to read? */
- int charactersRead; /* How many characters were read? */
+ Tcl_WideInt toRead; /* How many bytes to read? */
+ size_t charactersRead; /* How many characters were read? */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *resultPtr, *chanObjPtr;
@@ -429,27 +416,13 @@ Tcl_ReadObjCmd(
toRead = -1;
if (i < objc) {
- if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
+ if ((TclGetWideIntFromObj(NULL, objv[i], &toRead) != TCL_OK)
|| (toRead < 0)) {
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
- /*
- * The code below provides backwards compatibility with an old
- * form of the command that is no longer recommended or
- * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
- * maybe even earlier.
- */
-
- if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
-#endif
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected non-negative integer but got \"%s\"",
TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
return TCL_ERROR;
-#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
- }
- newline = 1;
-#endif
}
}
@@ -457,7 +430,7 @@ Tcl_ReadObjCmd(
Tcl_IncrRefCount(resultPtr);
TclChannelPreserve(chan);
charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
- if (charactersRead < 0) {
+ if (charactersRead == TCL_IO_FAILURE) {
/*
* TIP #219.
* Capture error messages put by the driver into the bypass area and
@@ -481,9 +454,9 @@ Tcl_ReadObjCmd(
if ((charactersRead > 0) && (newline != 0)) {
const char *result;
- int length;
+ size_t length;
- result = TclGetStringFromObj(resultPtr, &length);
+ result = Tcl_GetStringFromObj(resultPtr, &length);
if (result[length - 1] == '\n') {
Tcl_SetObjLength(resultPtr, length - 1);
}
@@ -724,13 +697,13 @@ Tcl_CloseObjCmd(
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
const char *string;
- int len;
+ size_t len;
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
Tcl_SetObjResult(interp, resultPtr);
}
- string = TclGetStringFromObj(resultPtr, &len);
+ string = Tcl_GetStringFromObj(resultPtr, &len);
if ((len > 0) && (string[len - 1] == '\n')) {
Tcl_SetObjLength(resultPtr, len - 1);
}
@@ -884,7 +857,7 @@ Tcl_ExecObjCmd(
const char *string;
Tcl_Channel chan;
int argc, background, i, index, keepNewline, result, skip, ignoreStderr;
- int length;
+ size_t length;
static const char *const options[] = {
"-ignorestderr", "-keepnewline", "--", NULL
};
@@ -969,7 +942,7 @@ Tcl_ExecObjCmd(
*/
TclGetAndDetachPids(interp, chan);
- if (Tcl_Close(interp, chan) != TCL_OK) {
+ if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
@@ -1001,7 +974,7 @@ Tcl_ExecObjCmd(
* string.
*/
- result = Tcl_Close(interp, chan);
+ result = Tcl_CloseEx(interp, chan, 0);
Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
/*
@@ -1010,7 +983,7 @@ Tcl_ExecObjCmd(
*/
if (keepNewline == 0) {
- string = TclGetStringFromObj(resultPtr, &length);
+ string = Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && (string[length - 1] == '\n')) {
Tcl_SetObjLength(resultPtr, length - 1);
}
@@ -1145,7 +1118,7 @@ Tcl_OpenObjCmd(
chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
} else {
int mode, seekFlag, binary;
- int cmdObjc;
+ size_t cmdObjc;
const char **cmdArgv;
if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
@@ -1177,7 +1150,7 @@ Tcl_OpenObjCmd(
Tcl_SetChannelOption(interp, chan, "-translation", "binary");
}
}
- ckfree(cmdArgv);
+ Tcl_Free((void *)cmdArgv);
}
if (chan == NULL) {
return TCL_ERROR;
@@ -1210,7 +1183,7 @@ Tcl_OpenObjCmd(
static void
TcpAcceptCallbacksDeleteProc(
- void *clientData, /* Data which was passed when the assocdata
+ ClientData clientData, /* Data which was passed when the assocdata
* was registered. */
TCL_UNUSED(Tcl_Interp *))
{
@@ -1225,7 +1198,7 @@ TcpAcceptCallbacksDeleteProc(
acceptCallbackPtr->interp = NULL;
}
Tcl_DeleteHashTable(hTblPtr);
- ckfree(hTblPtr);
+ Tcl_Free(hTblPtr);
}
/*
@@ -1265,7 +1238,7 @@ RegisterTcpServerInterpCleanup(
hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
if (hTblPtr == NULL) {
- hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+ hTblPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
TcpAcceptCallbacksDeleteProc, hTblPtr);
@@ -1313,7 +1286,7 @@ UnregisterTcpServerInterpCleanupProc(
return;
}
- hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
+ hPtr = Tcl_FindHashEntry(hTblPtr, acceptCallbackPtr);
if (hPtr != NULL) {
Tcl_DeleteHashEntry(hPtr);
}
@@ -1338,7 +1311,7 @@ UnregisterTcpServerInterpCleanupProc(
static void
AcceptCallbackProc(
- void *callbackData, /* The data stored when the callback was
+ ClientData callbackData, /* The data stored when the callback was
* created in the call to
* Tcl_OpenTcpServer. */
Tcl_Channel chan, /* Channel for the newly accepted
@@ -1402,7 +1375,7 @@ AcceptCallbackProc(
* the client socket - just close it.
*/
- Tcl_Close(NULL, chan);
+ Tcl_CloseEx(NULL, chan, 0);
}
}
@@ -1429,7 +1402,7 @@ AcceptCallbackProc(
static void
TcpServerCloseProc(
- void *callbackData) /* The data passed in the call to
+ ClientData callbackData) /* The data passed in the call to
* Tcl_CreateCloseHandler. */
{
AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;
@@ -1440,7 +1413,7 @@ TcpServerCloseProc(
acceptCallbackPtr);
}
Tcl_DecrRefCount(acceptCallbackPtr->script);
- ckfree(acceptCallbackPtr);
+ Tcl_Free(acceptCallbackPtr);
}
/*
@@ -1474,8 +1447,8 @@ Tcl_SocketObjCmd(
enum socketOptionsEnum {
SKT_ASYNC, SKT_BACKLOG, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR,
SKT_REUSEPORT, SKT_SERVER
- };
- int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
+ } optionIndex;
+ int a, server = 0, myport = 0, async = 0, reusep = -1,
reusea = -1, backlog = -1;
unsigned int flags = 0;
const char *host, *port, *myaddr = NULL;
@@ -1485,7 +1458,7 @@ Tcl_SocketObjCmd(
TclInitSockets();
for (a = 1; a < objc; a++) {
- const char *arg = Tcl_GetString(objv[a]);
+ const char *arg = TclGetString(objv[a]);
if (arg[0] != '-') {
break;
@@ -1494,7 +1467,7 @@ Tcl_SocketObjCmd(
TCL_EXACT, &optionIndex) != TCL_OK) {
return TCL_ERROR;
}
- switch ((enum socketOptionsEnum) optionIndex) {
+ switch (optionIndex) {
case SKT_ASYNC:
if (server == 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -1645,7 +1618,7 @@ Tcl_SocketObjCmd(
port = TclGetString(objv[a]);
if (server) {
- AcceptCallback *acceptCallbackPtr = (AcceptCallback *)ckalloc(sizeof(AcceptCallback));
+ AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_Alloc(sizeof(AcceptCallback));
Tcl_IncrRefCount(script);
acceptCallbackPtr->script = script;
@@ -1655,7 +1628,7 @@ Tcl_SocketObjCmd(
AcceptCallbackProc, acceptCallbackPtr);
if (chan == NULL) {
Tcl_DecrRefCount(script);
- ckfree(acceptCallbackPtr);
+ Tcl_Free(acceptCallbackPtr);
return TCL_ERROR;
}
@@ -1814,9 +1787,9 @@ ChanPendingObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
- int index, mode;
+ int mode;
static const char *const options[] = {"input", "output", NULL};
- enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT};
+ enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT} index;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "mode channelId");
@@ -1832,7 +1805,7 @@ ChanPendingObjCmd(
return TCL_ERROR;
}
- switch ((enum pendingOptionsEnum) index) {
+ switch (index) {
case PENDING_INPUT:
if (!(mode & TCL_READABLE)) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-1));
generated by cgit v0.12 at 2024-10-22 01:43:18 (GMT)