summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclClock.c36
-rw-r--r--generic/tclExecute.c25
-rw-r--r--generic/tclIO.c51
-rw-r--r--generic/tclIORChan.c140
-rw-r--r--generic/tclIntPlatDecls.h8
-rw-r--r--generic/tclStubInit.c18
-rw-r--r--tests/clock.test9
-rw-r--r--tests/cmdAH.test3
-rw-r--r--tests/ioCmd.test33
-rw-r--r--tests/ioTrans.test19
-rw-r--r--tests/iogt.test35
-rw-r--r--tests/obj.test4
-rw-r--r--unix/tcl.pc.in8
-rw-r--r--unix/tclUnixFCmd.c184
-rw-r--r--unix/tclUnixFile.c6
-rw-r--r--unix/tclUnixPort.h3
-rw-r--r--win/tclWinFCmd.c12
-rw-r--r--win/tclWinFile.c27
-rw-r--r--win/tclWinInit.c20
-rw-r--r--win/tclWinPort.h9
-rw-r--r--win/tclWinSock.c82
21 files changed, 450 insertions, 282 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 50d480c..15f29e5 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -548,18 +548,21 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
&era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &fields.year) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &fields.month) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH],
- &fieldPtr) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| TclGetIntFromObj(interp, fieldPtr, &fields.dayOfMonth)!=TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
@@ -638,18 +641,21 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
}
dict = objv[1];
if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
|| Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
&era) != TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Year)!=TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Week)!=TCL_OK
- || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK],
- &fieldPtr) != TCL_OK
- || TclGetIntFromObj(interp, fieldPtr, &fields.dayOfWeek) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
+ || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
+ || fieldPtr == NULL
+ || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
|| TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
+ if (fieldPtr == NULL)
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
return TCL_ERROR;
}
fields.era = era;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 41730d3..2c136d7 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5989,6 +5989,31 @@ TEBCresume(
case INST_NUM_TYPE:
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
type1 = 0;
+ } else if (type1 == TCL_NUMBER_LONG) {
+ /* value is between LONG_MIN and LONG_MAX */
+ /* [string is integer] is -UINT_MAX to UINT_MAX range */
+ int i;
+
+ if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
+ type1 = TCL_NUMBER_WIDE;
+ }
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (type1 == TCL_NUMBER_WIDE) {
+ /* value is between WIDE_MIN and WIDE_MAX */
+ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ int i;
+ if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
+ type1 = TCL_NUMBER_LONG;
+ }
+#endif
+ } else if (type1 == TCL_NUMBER_BIG) {
+ /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
+ /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ Tcl_WideInt w;
+
+ if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
+ type1 = TCL_NUMBER_WIDE;
+ }
}
TclNewIntObj(objResultPtr, type1);
TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
diff --git a/generic/tclIO.c b/generic/tclIO.c
index be17a07..e4f82be 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3271,7 +3271,17 @@ Tcl_Close(
Tcl_SetObjResult(interp,
Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
- flushcode = -1;
+ return TCL_ERROR;
+ }
+ /*
+ * Bug 97069ea11a: set error message if a flush code is set and no error
+ * message set up to now.
+ */
+ if (flushcode != 0 && interp != NULL
+ && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
+ Tcl_SetErrno(flushcode);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(Tcl_PosixError(interp), -1));
}
if ((flushcode != 0) || (result != 0)) {
return TCL_ERROR;
@@ -4260,6 +4270,7 @@ Tcl_GetsObj(
*/
chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
encoding = statePtr->encoding;
@@ -4492,8 +4503,9 @@ Tcl_GetsObj(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
+ /*
chanPtr = statePtr->topChanPtr;
+ */
bufPtr = gs.bufPtr;
if (bufPtr == NULL) {
@@ -4527,9 +4539,9 @@ Tcl_GetsObj(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
+ /*
chanPtr = statePtr->topChanPtr;
-
+ */
bufPtr = statePtr->inQueueHead;
if (bufPtr == NULL) {
Tcl_Panic("Tcl_GetsObj: restore reached with bufPtr==NULL");
@@ -4569,10 +4581,11 @@ Tcl_GetsObj(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
+ /*
chanPtr = statePtr->topChanPtr;
-
+ */
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
@@ -4618,6 +4631,7 @@ TclGetsObjBinary(
*/
chanPtr = statePtr->topChanPtr;
+ Tcl_Preserve(chanPtr);
bufPtr = statePtr->inQueueHead;
@@ -4821,6 +4835,7 @@ TclGetsObjBinary(
done:
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copiedTotal;
}
@@ -5292,6 +5307,7 @@ Tcl_ReadRaw(
* requests more bytes.
*/
+ Tcl_Preserve(chanPtr);
for (copied = 0; copied < bytesToRead; copied += copiedNow) {
copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
bytesToRead - copied);
@@ -5342,7 +5358,7 @@ Tcl_ReadRaw(
* over EAGAIN/WOULDBLOCK handling.
*/
- return copied;
+ goto done;
}
SetFlag(statePtr, CHANNEL_BLOCKED);
@@ -5350,14 +5366,17 @@ Tcl_ReadRaw(
}
Tcl_SetErrno(result);
- return -1;
+ copied = -1;
+ goto done;
}
- return copied + nread;
+ copied += nread;
+ goto done;
}
}
done:
+ Tcl_Release(chanPtr);
return copied;
}
@@ -5466,6 +5485,7 @@ DoReadChars(
chanPtr = statePtr->topChanPtr;
encoding = statePtr->encoding;
factor = UTF_EXPANSION_FACTOR;
+ Tcl_Preserve(chanPtr);
binaryMode = (encoding == NULL)
&& (statePtr->inputTranslation == TCL_TRANSLATE_LF)
@@ -5550,10 +5570,11 @@ DoReadChars(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
-
+ /*
chanPtr = statePtr->topChanPtr;
-
+ */
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return copied;
}
@@ -8001,6 +8022,11 @@ UpdateInterest(
/* State info for channel */
int mask = statePtr->interestMask;
+ if (chanPtr->typePtr == NULL) {
+ /* Do not update interest on a closed channel */
+ return;
+ }
+
/*
* If there are flushed buffers waiting to be written, then we need to
* watch for the channel to become writable.
@@ -9083,6 +9109,7 @@ DoRead(
ChannelState *statePtr = chanPtr->state;
char *p = dst;
+ Tcl_Preserve(chanPtr);
while (bytesToRead) {
/*
* Each pass through the loop is intended to process up to
@@ -9122,6 +9149,7 @@ DoRead(
if (code) {
/* Read error */
UpdateInterest(chanPtr);
+ Tcl_Release(chanPtr);
return -1;
}
@@ -9216,6 +9244,7 @@ DoRead(
}
}
+ Tcl_Release(chanPtr);
return (int)(p - dst);
}
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index cb0282a..29819b6 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);
@@ -586,6 +567,7 @@ TclChanCreateObjCmd(
chan = Tcl_CreateChannel(&tclRChannelType, TclGetString(rcId), rcPtr,
mode);
rcPtr->chan = chan;
+ Tcl_Preserve(chan);
chanPtr = (Channel *) chan;
/*
@@ -2159,8 +2141,6 @@ NewReflectedChannel(
Tcl_Obj *handleObj)
{
ReflectedChannel *rcPtr;
- int i, listc;
- Tcl_Obj **listv;
rcPtr = ckalloc(sizeof(ReflectedChannel));
@@ -2177,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;
}
@@ -2271,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)
{
@@ -2306,10 +2221,8 @@ FreeReflectedChannel(
ckfree(chanPtr->typePtr);
chanPtr->typePtr = NULL;
}
-
- FreeReflectedChannelArgs(rcPtr);
-
- ckfree(rcPtr->argv);
+ Tcl_Release(chanPtr);
+ Tcl_DecrRefCount(rcPtr->cmd);
ckfree(rcPtr);
}
@@ -2345,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) {
/*
@@ -2378,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
@@ -2394,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);
}
}
@@ -2409,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
@@ -2437,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);
@@ -2456,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).
@@ -2700,7 +2603,6 @@ DeleteReflectedChannelMap(
}
rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
#endif
@@ -2840,7 +2742,6 @@ DeleteThreadReflectedChannelMap(
ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
rcPtr->dead = 1;
- FreeReflectedChannelArgs(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
ckfree(rcmPtr);
@@ -3028,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
*
@@ -3047,7 +2948,6 @@ ForwardProc(
Tcl_GetChannelName(rcPtr->chan));
Tcl_DeleteHashEntry(hPtr);
- FreeReflectedChannelArgs(rcPtr);
break;
case ForwardedInput: {
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 2c74b5a..ac06787 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -550,9 +550,15 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa
-#if defined(_WIN32) || defined(__CYGWIN__)
+#if defined(_WIN32)
# undef TclWinNToHS
+# undef TclWinGetServByName
+# undef TclWinGetSockOpt
+# undef TclWinSetSockOpt
# define TclWinNToHS ntohs
+# define TclWinGetServByName getservbyname
+# define TclWinGetSockOpt getsockopt
+# define TclWinSetSockOpt setsockopt
#else
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 097269f..7a84cba 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -44,6 +44,9 @@
#define TclBackgroundException Tcl_BackgroundException
#undef Tcl_SetIntObj
#undef TclpInetNtoa
+#undef TclWinGetServByName
+#undef TclWinGetSockOpt
+#undef TclWinSetSockOpt
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#ifdef _WIN64
@@ -111,7 +114,8 @@ TclpIsAtty(int fd)
return isatty(fd);
}
-int
+#define TclWinGetPlatformId winGetPlatformId
+static int
TclWinGetPlatformId()
{
/* Don't bother to determine the real platform on cygwin,
@@ -127,27 +131,31 @@ void *TclWinGetTclInstance()
return hInstance;
}
-int
+#define TclWinSetSockOpt winSetSockOpt
+static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
const char *optval, int optlen)
{
return setsockopt((int) s, level, optname, optval, optlen);
}
-int
+#define TclWinGetSockOpt winGetSockOpt
+static int
TclWinGetSockOpt(SOCKET s, int level, int optname,
char *optval, int *optlen)
{
return getsockopt((int) s, level, optname, optval, optlen);
}
-struct servent *
+#define TclWinGetServByName winGetServByName
+static struct servent *
TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
-char *
+#define TclWinNoBackslash winNoBackslash
+static char *
TclWinNoBackslash(char *path)
{
char *p;
diff --git a/tests/clock.test b/tests/clock.test
index 0202fc7..8debba1 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36927,6 +36927,15 @@ test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
clock format [clock seconds] -format %%r
} %r
+test clock-67.2 {Bug d19a30db57} -body {
+ # error, not segfault
+ tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+test clock-67.3 {Bug d19a30db57} -body {
+ # error, not segfault
+ tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
+} -returnCodes error -match glob -result *
+
# cleanup
namespace delete ::testClock
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 39e9ece..04a86fa 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -141,6 +141,9 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
} -cleanup {
cd $dir
} -result {/}
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+ cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 03242be..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.
@@ -1051,6 +1070,20 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo
rename foo {}
unset res
} -result {{read rc* 4096} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+ set res {}
+ proc foo {args} {
+ oninit; onfinal; track
+ set args [lassign $args sub id]
+ if {$sub ne "read"} {return}
+ close $id
+ return {}
+ }
+ set c [chan create {r} foo]
+ note [read $c]
+ rename foo {}
+ set res
+} -result {{read rc* 4096} {}}
# --- === *** ###########################
# method write
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 5a8874c..b21d894 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -540,6 +540,25 @@ test iortrans-4.8 {chan read, read, bug 2921116} -setup {
rename foo {}
} -result {{read rt* {test data
}} file*}
+test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
+ set res {}
+} -match glob -body {
+ proc foo {fd args} {
+ handle.initialize
+ handle.finalize
+ lappend ::res $args
+ # Kill and recreate transform while it is operating
+ chan pop $fd
+ chan push $fd [list foo $fd]
+ }
+ set c [chan push [set c [tempchan]] [list foo $c]]
+ chan configure $c -buffersize 2
+ lappend res [read $c]
+} -cleanup {
+ tempdone
+ rename foo {}
+} -result {{read rt* {test data
+}} file*}
test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
set res {}
} -match glob -body {
diff --git a/tests/iogt.test b/tests/iogt.test
index d4c31d2..bd3c67b 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -220,6 +220,26 @@ proc id_fulltrail {var op data} {
return $res
}
+proc id_torture {chan op data} {
+ switch -- $op {
+ create/write -
+ create/read -
+ delete/write -
+ delete/read -
+ clear_read {;#ignore}
+ flush/write -
+ flush/read -
+ write -
+ read {
+ testchannel unstack $chan
+ testchannel transform $chan \
+ -command [namespace code [list id_torture $chan]]
+ return $data
+ }
+ query/maxRead {return -1}
+ }
+}
+
proc counter {var op data} {
namespace upvar [namespace current] $var n
@@ -326,6 +346,11 @@ proc audit_ops {var -attach channel} {
proc audit_flow {var -attach channel} {
testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
}
+
+proc torture {-attach channel} {
+ testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
proc stopafter {var n -attach channel} {
namespace upvar [namespace current] $var vn
set vn $n
@@ -546,6 +571,16 @@ delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+ set fh [open $path(dummy) r]
+ torture -attach $fh
+ chan configure $fh -buffersize 2
+ set x [read $fh]
+ testchannel unstack $fh
+ close $fh
+ set x
+} {}
+
test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
proc DoneCopy {n {err {}}} {
variable copy 1
diff --git a/tests/obj.test b/tests/obj.test
index 71a39b4..151abfb 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -605,7 +605,7 @@ test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
set x 0xffff; append x ffff
list [string is integer $x] [expr { wide($x) }]
} {1 4294967295}
-test obj-33.3 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.3 {integer overflow on input} {
set x 0x10000; append x 0000
list [string is integer $x] [expr { wide($x) }]
} {0 4294967296}
@@ -621,7 +621,7 @@ test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
set x -0xffff; append x ffff
list [string is integer $x] [expr { wide($x) }]
} {1 -4294967295}
-test obj-33.7 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.7 {integer overflow on input} {
set x -0x10000; append x 0000
list [string is integer $x] [expr { wide($x) }]
} {0 -4294967296}
diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
index 8bf67cd..846cb11 100644
--- a/unix/tcl.pc.in
+++ b/unix/tcl.pc.in
@@ -8,8 +8,8 @@ includedir=@includedir@
Name: Tool Command Language
Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
URL: http://www.tcl.tk/
-Version: @TCL_VERSION@
-Requires:
-Conflicts:
-Libs: -L${libdir} @TCL_LIBS@
+Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
+Requires.private: zlib >= 1.2.3
+Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@
+Libs.private: @TCL_LIBS@
Cflags: -I${includedir}
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index e270b6a..3b1b6ca 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -91,10 +91,10 @@ static int SetPermissionsAttribute(Tcl_Interp *interp,
Tcl_Obj *attributePtr);
static int GetModeFromPermString(Tcl_Interp *interp,
const char *modeStringPtr, mode_t *modePtr);
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
-static int GetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
+static int GetUnixFileAttributes(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
-static int SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
+static int SetUnixFileAttributes(Tcl_Interp *interp, int objIndex,
Tcl_Obj *fileName, Tcl_Obj *attributePtr);
#endif
@@ -124,10 +124,20 @@ extern const char *const tclpFileAttrStrings[];
#else /* !DJGPP */
enum {
- UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+ UNIX_ARCHIVE_ATTRIBUTE,
+#endif
+ UNIX_GROUP_ATTRIBUTE,
+#if defined(__CYGWIN__)
+ UNIX_HIDDEN_ATTRIBUTE,
+#endif
+ UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
UNIX_READONLY_ATTRIBUTE,
#endif
+#if defined(__CYGWIN__)
+ UNIX_SYSTEM_ATTRIBUTE,
+#endif
#ifdef MAC_OSX_TCL
MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE,
MACOSX_RSRCLENGTH_ATTRIBUTE,
@@ -137,10 +147,20 @@ enum {
MODULE_SCOPE const char *const tclpFileAttrStrings[];
const char *const tclpFileAttrStrings[] = {
- "-group", "-owner", "-permissions",
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+ "-archive",
+#endif
+ "-group",
+#if defined(__CYGWIN__)
+ "-hidden",
+#endif
+ "-owner", "-permissions",
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
"-readonly",
#endif
+#if defined(__CYGWIN__)
+ "-system",
+#endif
#ifdef MAC_OSX_TCL
"-creator", "-type", "-hidden", "-rsrclength",
#endif
@@ -149,11 +169,20 @@ const char *const tclpFileAttrStrings[] = {
MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
const TclFileAttrProcs tclpFileAttrProcs[] = {
+#if defined(__CYGWIN__)
+ {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
{GetGroupAttribute, SetGroupAttribute},
+#if defined(__CYGWIN__)
+ {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
{GetOwnerAttribute, SetOwnerAttribute},
{GetPermissionsAttribute, SetPermissionsAttribute},
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
- {GetReadOnlyAttribute, SetReadOnlyAttribute},
+#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
+ {GetUnixFileAttributes, SetUnixFileAttributes},
+#endif
+#if defined(__CYGWIN__)
+ {GetUnixFileAttributes, SetUnixFileAttributes},
#endif
#ifdef MAC_OSX_TCL
{TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
@@ -2246,11 +2275,138 @@ DefaultTempDir(void)
return TCL_TEMPORARY_FILE_DIRECTORY;
}
-#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
+#if defined(__CYGWIN__)
+
+static void
+StatError(
+ Tcl_Interp *interp, /* The interp that has the error */
+ Tcl_Obj *fileName) /* The name of the file which caused the
+ * error. */
+{
+ TclWinConvertError(GetLastError());
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
+}
+
+static WCHAR *
+winPathFromObj(
+ Tcl_Obj *fileName)
+{
+ int size;
+ const char *native = Tcl_FSGetNativePath(fileName);
+ WCHAR *winPath;
+
+ size = cygwin_conv_path(1, native, NULL, 0);
+ winPath = ckalloc(size);
+ cygwin_conv_path(1, native, winPath, size);
+
+ return winPath;
+}
+
+static const int attributeArray[] = {
+ 0x20, 0, 2, 0, 0, 1, 4};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetUnixFileAttributes
+ *
+ * Gets the readonly attribute of a file.
+ *
+ * Results:
+ * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there
+ * is no error. The object will have ref count 0.
+ *
+ * Side effects:
+ * A new object is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetUnixFileAttributes(
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ Tcl_Obj *fileName, /* The name of the file (UTF-8). */
+ Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
+{
+ int fileAttributes;
+ WCHAR *winPath = winPathFromObj(fileName);
+
+ fileAttributes = GetFileAttributesW(winPath);
+ ckfree(winPath);
+
+ if (fileAttributes == -1) {
+ StatError(interp, fileName);
+ return TCL_ERROR;
+ }
+
+ *attributePtrPtr = Tcl_NewIntObj((fileAttributes&attributeArray[objIndex])!=0);
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetUnixFileAttributes
+ *
+ * Sets the readonly attribute of a file.
+ *
+ * Results:
+ * Standard TCL result.
+ *
+ * Side effects:
+ * The readonly attribute of the file is changed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetUnixFileAttributes(
+ Tcl_Interp *interp, /* The interp we are using for errors. */
+ int objIndex, /* The index of the attribute. */
+ Tcl_Obj *fileName, /* The name of the file (UTF-8). */
+ Tcl_Obj *attributePtr) /* The attribute to set. */
+{
+ int yesNo, fileAttributes, old;
+ WCHAR *winPath;
+
+ if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ winPath = winPathFromObj(fileName);
+
+ fileAttributes = old = GetFileAttributesW(winPath);
+
+ if (fileAttributes == -1) {
+ ckfree(winPath);
+ StatError(interp, fileName);
+ return TCL_ERROR;
+ }
+
+ if (yesNo) {
+ fileAttributes |= attributeArray[objIndex];
+ } else {
+ fileAttributes &= ~attributeArray[objIndex];
+ }
+
+ if ((fileAttributes != old)
+ && !SetFileAttributesW(winPath, fileAttributes)) {
+ ckfree(winPath);
+ StatError(interp, fileName);
+ return TCL_ERROR;
+ }
+
+ ckfree(winPath);
+ return TCL_OK;
+}
+#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
*----------------------------------------------------------------------
*
- * GetReadOnlyAttribute
+ * GetUnixFileAttributes
*
* Gets the readonly attribute (user immutable flag) of a file.
*
@@ -2265,7 +2421,7 @@ DefaultTempDir(void)
*/
static int
-GetReadOnlyAttribute(
+GetUnixFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file (UTF-8). */
@@ -2293,7 +2449,7 @@ GetReadOnlyAttribute(
/*
*---------------------------------------------------------------------------
*
- * SetReadOnlyAttribute
+ * SetUnixFileAttributes
*
* Sets the readonly attribute (user immutable flag) of a file.
*
@@ -2307,7 +2463,7 @@ GetReadOnlyAttribute(
*/
static int
-SetReadOnlyAttribute(
+SetUnixFileAttributes(
Tcl_Interp *interp, /* The interp we are using for errors. */
int objIndex, /* The index of the attribute. */
Tcl_Obj *fileName, /* The name of the file (UTF-8). */
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 5bfe5d9..2cb0027 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1105,6 +1105,12 @@ TclNativeCreateNativeRep(
str = Tcl_GetStringFromObj(validPathPtr, &len);
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
+ if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
+ /* See bug [3118489]: NUL in filenames */
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
Tcl_DecrRefCount(validPathPtr);
nativePathPtr = ckalloc(len);
memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 2ade1c0..f64d453 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -93,6 +93,9 @@ typedef off_t Tcl_SeekOffset;
WCHAR *, int);
__declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *);
__declspec(dllimport) extern __stdcall int IsDebuggerPresent();
+ __declspec(dllimport) extern __stdcall int GetLastError();
+ __declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *);
+ __declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int);
__declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int);
__declspec(dllimport) extern int cygwin_conv_path_list(int, const void *, void *, int);
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 2700cb3..52ea8c6 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -1108,7 +1108,12 @@ DoRemoveJustDirectory(
end:
if (errorPtr != NULL) {
+ char *p;
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
+ p = Tcl_DStringValue(errorPtr);
+ for (; *p; ++p) {
+ if (*p == '\\') *p = '/';
+ }
}
return TCL_ERROR;
@@ -1825,12 +1830,12 @@ SetWinFileAttributes(
Tcl_Obj *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The new value of the attribute. */
{
- DWORD fileAttributes;
+ DWORD fileAttributes, old;
int yesNo, result;
const TCHAR *nativeName;
nativeName = Tcl_FSGetNativePath(fileName);
- fileAttributes = GetFileAttributes(nativeName);
+ fileAttributes = old = GetFileAttributes(nativeName);
if (fileAttributes == 0xffffffff) {
StatError(interp, fileName);
@@ -1848,7 +1853,8 @@ SetWinFileAttributes(
fileAttributes &= ~(attributeArray[objIndex]);
}
- if (!SetFileAttributes(nativeName, fileAttributes)) {
+ if ((fileAttributes != old)
+ && !SetFileAttributes(nativeName, fileAttributes)) {
StatError(interp, fileName);
return TCL_ERROR;
}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index f69ad23..fc0ac9e 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1816,6 +1816,9 @@ TclpObjChdir(
nativePath = Tcl_FSGetNativePath(pathPtr);
+ if (!nativePath) {
+ return -1;
+ }
result = SetCurrentDirectory(nativePath);
if (result == 0) {
@@ -2897,7 +2900,8 @@ TclNativeCreateNativeRep(
char *nativePathPtr, *str;
Tcl_DString ds;
Tcl_Obj *validPathPtr;
- int len;
+ int len, i = 2;
+ WCHAR *wp;
if (TclFSCwdIsNative()) {
/*
@@ -2923,17 +2927,22 @@ TclNativeCreateNativeRep(
}
str = Tcl_GetStringFromObj(validPathPtr, &len);
- if (str[0] == '/' && str[1] == '/' && str[2] == '?' && str[3] == '/') {
- char *p;
-
- for (p = str; p && *p; ++p) {
- if (*p == '/') {
- *p = '\\';
+ Tcl_WinUtfToTChar(str, len, &ds);
+ len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
+ wp = (WCHAR *) Tcl_DStringValue(&ds);
+ for (i=sizeof(WCHAR); i<len; ++wp,i+=sizeof(WCHAR)) {
+ if ( (*wp < ' ') || wcschr(L"\"*<>|", *wp) ){
+ if (!*wp){
+ /* See bug [3118489]: NUL in filenames */
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
}
+ *wp |= 0xF000;
+ }else if (*wp=='/') {
+ *wp = '\\';
}
}
- Tcl_WinUtfToTChar(str, len, &ds);
- len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
Tcl_DecrRefCount(validPathPtr);
nativePathPtr = ckalloc(len);
memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 2c21d38..8b600f6 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)
{
+ WSADATA wsaData;
+ WORD wVersionRequested = MAKEWORD(2, 2);
+
tclPlatform = TCL_PLATFORM_WINDOWS;
/*
- * 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.
+ * Initialize the winsock library. On Windows XP and higher this
+ * can never fail.
*/
-
- SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
+ WSAStartup(wVersionRequested, &wsaData);
#ifdef STATIC_BUILD
/*
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 61f149b..652cd06 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -528,15 +528,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 11b4162..3990111 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);
}
@@ -2449,7 +2414,7 @@ SocketThread(
*
* Side effects:
* The flags for the given socket are updated to reflect the event that
- * occured.
+ * occurred.
*
*----------------------------------------------------------------------
*/
@@ -2694,6 +2659,7 @@ InitializeHostName(
*----------------------------------------------------------------------
*/
+#undef TclWinGetSockOpt
int
TclWinGetSockOpt(
SOCKET s,
@@ -2702,19 +2668,10 @@ TclWinGetSockOpt(
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);
}
+#undef TclWinSetSockOpt
int
TclWinSetSockOpt(
SOCKET s,
@@ -2723,16 +2680,6 @@ TclWinSetSockOpt(
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);
}
@@ -2741,34 +2688,15 @@ char *
TclpInetNtoa(
struct in_addr addr)
{
- /*
- * 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 inet_ntoa(addr);
}
+#undef TclWinGetServByName
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);
}
generated by cgit v0.12 at 2024-11-12 22:47:44 (GMT)