summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclIORChan.c138
-rw-r--r--generic/tclInt.decls27
-rw-r--r--generic/tclIntPlatDecls.h27
-rw-r--r--generic/tclStubInit.c26
-rw-r--r--tests/ioCmd.test19
-rw-r--r--win/tclWinInit.c24
-rw-r--r--win/tclWinPort.h9
-rw-r--r--win/tclWinSock.c118
8 files changed, 76 insertions, 312 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 2f2c95c..b992de4 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -99,25 +99,7 @@ typedef struct {
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
-
- /* See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- * ~~~~ CT ~~~ ~~ CT ~~
- *
- * CT = Belongs to the 'Command handler Thread'.
- */
-
- int argc; /* Number of preallocated words - 2 */
- Tcl_Obj **argv; /* Preallocated array for calling the handler.
- * args[0] is placeholder for cmd word.
- * Followed by the arguments in the prefix,
- * plus 4 placeholders for method, channel,
- * and at most two varying (method specific)
- * words. */
+ Tcl_Obj *cmd; /* Callback command prefix */
int methods; /* Bitmask of supported methods */
/*
@@ -450,7 +432,6 @@ static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
static Tcl_Obj * NextHandle(void);
static void FreeReflectedChannel(ReflectedChannel *rcPtr);
-static void FreeReflectedChannelArgs(ReflectedChannel *rcPtr);
static int InvokeTclMethod(ReflectedChannel *rcPtr,
const char *method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
@@ -2160,8 +2141,6 @@ NewReflectedChannel(
Tcl_Obj *handleObj)
{
ReflectedChannel *rcPtr;
- int i, listc;
- Tcl_Obj **listv;
rcPtr = ckalloc(sizeof(ReflectedChannel));
@@ -2178,54 +2157,11 @@ NewReflectedChannel(
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
- /*
- * Method placeholder.
- */
-
/* ASSERT: cmdpfxObj is a Tcl List */
-
- Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
-
- /*
- * See [==] as well.
- * Storage for the command prefix and the additional words required for
- * the invocation of methods in the command handler.
- *
- * listv [0] [listc-1] | [listc] [listc+1] |
- * argv [0] ... [.] | [argc-2] [argc-1] | [argc] [argc+2]
- * cmd ... pfx | method chan | detail1 detail2
- */
-
- rcPtr->argc = listc + 2;
- rcPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
-
- /*
- * Duplicate object references.
- */
-
- for (i=0; i<listc ; i++) {
- Tcl_Obj *word = rcPtr->argv[i] = listv[i];
-
- Tcl_IncrRefCount(word);
- }
-
- i++; /* Skip placeholder for method */
-
- /*
- * [Bug 1667990]: See [x] in FreeReflectedChannel for release
- */
-
- rcPtr->argv[i] = handleObj;
- Tcl_IncrRefCount(handleObj);
-
- /*
- * The next two objects are kept empty, varying arguments.
- */
-
- /*
- * Initialization complete.
- */
-
+ rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
+ Tcl_ListObjAppendElement(NULL, rcPtr->cmd, Tcl_NewObj());
+ Tcl_ListObjAppendElement(NULL, rcPtr->cmd, handleObj);
+ Tcl_IncrRefCount(rcPtr->cmd);
return rcPtr;
}
@@ -2272,28 +2208,6 @@ NextHandle(void)
}
static void
-FreeReflectedChannelArgs(
- ReflectedChannel *rcPtr)
-{
- int i, n = rcPtr->argc - 2;
-
- if (n < 0) {
- return;
- }
- for (i=0; i<n; i++) {
- Tcl_DecrRefCount(rcPtr->argv[i]);
- }
-
- /*
- * [Bug 1667990]: See [x] in NewReflectedChannel for lock. n+1 = argc-1.
- */
-
- Tcl_DecrRefCount(rcPtr->argv[n+1]);
-
- rcPtr->argc = 1;
-}
-
-static void
FreeReflectedChannel(
ReflectedChannel *rcPtr)
{
@@ -2308,10 +2222,7 @@ FreeReflectedChannel(
chanPtr->typePtr = NULL;
}
Tcl_Release(chanPtr);
-
- FreeReflectedChannelArgs(rcPtr);
-
- ckfree(rcPtr->argv);
+ Tcl_DecrRefCount(rcPtr->cmd);
ckfree(rcPtr);
}
@@ -2347,11 +2258,12 @@ InvokeTclMethod(
Tcl_Obj *argTwoObj, /* NULL'able */
Tcl_Obj **resultObjPtr) /* NULL'able */
{
- int cmdc; /* #words in constructed command */
Tcl_Obj *methObj = NULL; /* Method name in object form */
Tcl_InterpState sr; /* State of handler interp */
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
+ Tcl_Obj *cmd;
+ int len;
if (rcPtr->dead) {
/*
@@ -2380,13 +2292,14 @@ InvokeTclMethod(
*/
/*
- * Insert method into the pre-allocated area, after the command prefix,
+ * Insert method into the callback command, after the command prefix,
* before the channel id.
*/
methObj = Tcl_NewStringObj(method, -1);
- Tcl_IncrRefCount(methObj);
- rcPtr->argv[rcPtr->argc - 2] = methObj;
+ cmd = TclListObjCopy(NULL, rcPtr->cmd);
+ ListObjLength(cmd, len);
+ Tcl_ListObjReplace(NULL, cmd, len - 2, 1, 1, &methObj);
/*
* Append the additional argument containing method specific details
@@ -2396,13 +2309,10 @@ InvokeTclMethod(
* The objects will survive the Tcl_EvalObjv without change.
*/
- cmdc = rcPtr->argc;
if (argOneObj) {
- rcPtr->argv[cmdc] = argOneObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
if (argTwoObj) {
- rcPtr->argv[cmdc] = argTwoObj;
- cmdc++;
+ Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
}
}
@@ -2411,9 +2321,10 @@ InvokeTclMethod(
* existing state intact.
*/
+ Tcl_IncrRefCount(cmd);
sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
Tcl_Preserve(rcPtr->interp);
- result = Tcl_EvalObjv(rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+ result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
/*
* We do not try to extract the result information if the caller has no
@@ -2439,7 +2350,6 @@ InvokeTclMethod(
*/
if (result != TCL_ERROR) {
- Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rcPtr->argv);
int cmdLen;
const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
@@ -2458,20 +2368,11 @@ InvokeTclMethod(
}
Tcl_IncrRefCount(resObj);
}
+ Tcl_DecrRefCount(cmd);
Tcl_RestoreInterpState(rcPtr->interp, sr);
Tcl_Release(rcPtr->interp);
/*
- * Cleanup of the dynamic parts of the command.
- *
- * The detail objects survived the Tcl_EvalObjv without change because of
- * the contract. Therefore there is no need to decrement the refcounts. Only
- * the internal method object has to be disposed of.
- */
-
- Tcl_DecrRefCount(methObj);
-
- /*
* The resObj has a ref count of 1 at this location. This means that the
* caller of InvokeTclMethod has to dispose of it (but only if it was
* returned to it).
@@ -2702,7 +2603,6 @@ DeleteReflectedChannelMap(
}
rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
#endif
@@ -2842,7 +2742,6 @@ DeleteThreadReflectedChannelMap(
ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
ckfree(rcmPtr);
@@ -3030,7 +2929,7 @@ ForwardProc(
}
/*
- * Freeing is done here, in the origin thread, because the argv[]
+ * Freeing is done here, in the origin thread, callback command
* objects belong to this thread. Deallocating them in a different
* thread is not allowed
*
@@ -3049,7 +2948,6 @@ ForwardProc(
Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
- FreeReflectedChannelArgs(rcPtr);
break;
case ForwardedInput: {
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 31c8379..1d630b2 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -1045,14 +1045,16 @@ declare 0 win {
#declare 1 win {
# void TclWinConvertWSAError(DWORD errCode)
#}
-declare 2 win {
- struct servent *TclWinGetServByName(const char *nm,
- const char *proto)
-}
-declare 3 win {
- int TclWinGetSockOpt(SOCKET s, int level, int optname,
- char *optval, int *optlen)
-}
+# Removed in Tcl 9.0
+#declare 2 win {
+# struct servent *TclWinGetServByName(const char *nm,
+# const char *proto)
+#}
+# Removed in Tcl 9.0
+#declare 3 win {
+# int TclWinGetSockOpt(SOCKET s, int level, int optname,
+# char *optval, int *optlen)
+#}
declare 4 win {
HINSTANCE TclWinGetTclInstance(void)
}
@@ -1068,10 +1070,11 @@ declare 5 win {
#declare 6 win {
# unsigned short TclWinNToHS(unsigned short ns)
#}
-declare 7 win {
- int TclWinSetSockOpt(SOCKET s, int level, int optname,
- const char *optval, int optlen)
-}
+# Removed in Tcl 9.0
+#declare 7 win {
+# int TclWinSetSockOpt(SOCKET s, int level, int optname,
+# const char *optval, int optlen)
+#}
declare 8 win {
int TclpGetPid(Tcl_Pid pid)
}
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index bcf3e44..c700837 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -88,20 +88,14 @@ TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
/* 0 */
TCLAPI void TclWinConvertError(DWORD errCode);
/* Slot 1 is reserved */
-/* 2 */
-TCLAPI struct servent * TclWinGetServByName(const char *nm,
- const char *proto);
-/* 3 */
-TCLAPI int TclWinGetSockOpt(SOCKET s, int level, int optname,
- char *optval, int *optlen);
+/* Slot 2 is reserved */
+/* Slot 3 is reserved */
/* 4 */
TCLAPI HINSTANCE TclWinGetTclInstance(void);
/* 5 */
TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */
-/* 7 */
-TCLAPI int TclWinSetSockOpt(SOCKET s, int level, int optname,
- const char *optval, int optlen);
+/* Slot 7 is reserved */
/* 8 */
TCLAPI int TclpGetPid(Tcl_Pid pid);
/* 9 */
@@ -266,12 +260,12 @@ typedef struct TclIntPlatStubs {
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
void (*tclWinConvertError) (DWORD errCode); /* 0 */
void (*reserved1)(void);
- struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
- int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
+ void (*reserved2)(void);
+ void (*reserved3)(void);
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
void (*reserved6)(void);
- int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
+ void (*reserved7)(void);
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
void (*reserved10)(void);
@@ -392,17 +386,14 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclWinConvertError \
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
/* Slot 1 is reserved */
-#define TclWinGetServByName \
- (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
-#define TclWinGetSockOpt \
- (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
+/* Slot 2 is reserved */
+/* Slot 3 is reserved */
#define TclWinGetTclInstance \
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
/* Slot 6 is reserved */
-#define TclWinSetSockOpt \
- (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
+/* Slot 7 is reserved */
#define TclpGetPid \
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclWinGetPlatformId \
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 4057523..09550b5 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -106,26 +106,6 @@ void *TclWinGetTclInstance()
return hInstance;
}
-int
-TclWinSetSockOpt(SOCKET s, int level, int optname,
- const char *optval, int optlen)
-{
- return setsockopt((int) s, level, optname, optval, optlen);
-}
-
-int
-TclWinGetSockOpt(SOCKET s, int level, int optname,
- char *optval, int *optlen)
-{
- return getsockopt((int) s, level, optname, optval, optlen);
-}
-
-struct servent *
-TclWinGetServByName(const char *name, const char *proto)
-{
- return getservbyname(name, proto);
-}
-
char *
TclWinNoBackslash(char *path)
{
@@ -553,12 +533,12 @@ static const TclIntPlatStubs tclIntPlatStubs = {
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TclWinConvertError, /* 0 */
0, /* 1 */
- TclWinGetServByName, /* 2 */
- TclWinGetSockOpt, /* 3 */
+ 0, /* 2 */
+ 0, /* 3 */
TclWinGetTclInstance, /* 4 */
TclUnixWaitForFile, /* 5 */
0, /* 6 */
- TclWinSetSockOpt, /* 7 */
+ 0, /* 7 */
TclpGetPid, /* 8 */
TclWinGetPlatformId, /* 9 */
0, /* 10 */
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index a150d59..0a61252 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -793,6 +793,25 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g
rename foo {}
set res
} -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+ proc foo {method chan args} {
+ switch -- $method blocking {
+ chan configure $chan -blocking [lindex $args 0]
+ return
+ } initialize {
+ return {initialize finalize watch blocking read write
+ configure cget cgetall}
+ } finalize {
+ return
+ }
+ }
+ set ch [chan create {read write} foo]
+} -body {
+ list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+ close $ch
+ rename foo {}
+} -match glob -result {1 {*nested eval*}}
# --- --- --- --------- --------- ---------
# Helper commands to record the arguments to handler methods.
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 2c21d38..d90d57a 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -113,8 +113,8 @@ static int ToUtf(const WCHAR *wSrc, char *dst);
*
* TclpInitPlatform --
*
- * Initialize all the platform-dependant things like signals and
- * floating-point error handling.
+ * Initialize all the platform-dependant things like signals,
+ * floating-point error handling and sockets.
*
* Called at process initialization time.
*
@@ -130,20 +130,16 @@ static int ToUtf(const WCHAR *wSrc, char *dst);
void
TclpInitPlatform(void)
{
- tclPlatform = TCL_PLATFORM_WINDOWS;
+ WSADATA wsaData;
+ WORD wVersionRequested = MAKEWORD(2, 2);
- /*
- * The following code stops Windows 3.X and Windows NT 3.51 from
- * automatically putting up Sharing Violation dialogs, e.g, when someone
- * tries to access a file that is locked or a drive with no disk in it.
- * Tcl already returns the appropriate error to the caller, and they can
- * decide to put up their own dialog in response to that failure.
- *
- * Under 95 and NT 4.0, this is a NOOP because the system doesn't
- * automatically put up dialogs when the above operations fail.
- */
+ tclPlatform = TCL_PLATFORM_WINDOWS;
- SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+ /*
+ * Initialize the winsock library. On Windows XP and higher this
+ * can never fail.
+ */
+ WSAStartup(wVersionRequested, &wsaData);
#ifdef STATIC_BUILD
/*
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index c418b3b..84e94fe 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -526,15 +526,6 @@ typedef DWORD_PTR * PDWORD_PTR;
#define TclpSysRealloc(ptr, size) ((void*)HeapReAlloc(GetProcessHeap(), \
(DWORD)0, (LPVOID)ptr, (DWORD)size))
-/*
- * The following defines map from standard socket names to our internal
- * wrappers that redirect through the winSock function table (see the
- * file tclWinSock.c).
- */
-
-#define getservbyname TclWinGetServByName
-#define getsockopt TclWinGetSockOpt
-#define setsockopt TclWinSetSockOpt
/* This type is not defined in the Windows headers */
#define socklen_t int
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 4b50914..857a2b3 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -47,13 +47,6 @@
#include "tclWinInt.h"
-/*
- * Which version of the winsock API do we want?
- */
-
-#define WSA_VERSION_MAJOR 1
-#define WSA_VERSION_MINOR 1
-
#ifdef _MSC_VER
# pragma comment (lib, "ws2_32")
#endif
@@ -287,8 +280,7 @@ static const Tcl_ChannelType tcpChannelType = {
static void
InitSockets(void)
{
- DWORD id, err;
- WSADATA wsaData;
+ DWORD id;
ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
if (!initialized) {
@@ -317,32 +309,6 @@ InitSockets(void)
TclWinConvertError(GetLastError());
goto initFailure;
}
-
- /*
- * Initialize the winsock library and check the interface version
- * actually loaded. We only ask for the 1.1 interface and do require
- * that it not be less than 1.1.
- */
-
- err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR),
- &wsaData);
- if (err != 0) {
- TclWinConvertError(err);
- goto initFailure;
- }
-
- /*
- * Note the byte positions ae swapped for the comparison, so that
- * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). We
- * want the comparison to be 0x0200 < 0x0101.
- */
-
- if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
- < MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
- TclWinConvertError(WSAVERNOTSUPPORTED);
- WSACleanup();
- goto initFailure;
- }
}
/*
@@ -459,7 +425,6 @@ SocketExitHandler(
TclpFinalizeSockets();
UnregisterClass(classname, TclWinGetTclInstance());
- WSACleanup();
initialized = 0;
Tcl_MutexUnlock(&socketMutex);
}
@@ -2114,7 +2079,7 @@ TcpGetOptionProc(
int ret;
optlen = sizeof(int);
- ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
+ ret = getsockopt(sock, SOL_SOCKET, SO_ERROR,
(char *)&err, &optlen);
if (ret == SOCKET_ERROR) {
err = WSAGetLastError();
@@ -2678,85 +2643,6 @@ InitializeHostName(
/*
*----------------------------------------------------------------------
*
- * TclWinGetSockOpt, et al. --
- *
- * These functions are wrappers that let us bind the WinSock API
- * dynamically so we can run on systems that don't have the wsock32.dll.
- * We need wrappers for these interfaces because they are called from the
- * generic Tcl code.
- *
- * Results:
- * As defined for each function.
- *
- * Side effects:
- * As defined for each function.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclWinGetSockOpt(
- SOCKET s,
- int level,
- int optname,
- char *optval,
- int *optlen)
-{
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return SOCKET_ERROR;
- }
-
- return getsockopt(s, level, optname, optval, optlen);
-}
-
-int
-TclWinSetSockOpt(
- SOCKET s,
- int level,
- int optname,
- const char *optval,
- int optlen)
-{
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return SOCKET_ERROR;
- }
-
- return setsockopt(s, level, optname, optval, optlen);
-}
-
-struct servent *
-TclWinGetServByName(
- const char *name,
- const char *proto)
-{
- /*
- * Check that WinSock is initialized; do not call it if not, to prevent
- * system crashes. This can happen at exit time if the exit handler for
- * WinSock ran before other exit handlers that want to use sockets.
- */
-
- if (!SocketsEnabled()) {
- return NULL;
- }
-
- return getservbyname(name, proto);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TcpThreadActionProc --
*
* Insert or remove any thread local refs to this channel.
generated by cgit v0.12 at 2024-11-21 14:20:17 (GMT)