From a31a6d94b9e9430c76fdc460fae32a9f1290d733 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 7 May 2012 07:50:59 +0000 Subject: proposal from jmphilippe --- win/tclWinDde.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 1fa922b..aa51689 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -550,7 +550,7 @@ DdeServerProc ( } if (convPtr != NULL) { - BYTE *returnString; + char *returnString; len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); @@ -561,19 +561,25 @@ DdeServerProc ( (DWORD) len + 1, CP_WINANSI); if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) { returnString = - (BYTE *)Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + Tcl_DStringInit (&dString); + returnString = + Tcl_UtfToExternalDString (NULL, returnString, -1, &dString); ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT, + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); } else { Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( convPtr->riPtr->interp, utilString, NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = (BYTE *)Tcl_GetStringFromObj(variableObjPtr, + returnString = Tcl_GetStringFromObj(variableObjPtr, &len); + Tcl_DStringInit (&dString); + returnString = + Tcl_UtfToExternalDString (NULL, returnString, -1, &dString); ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); } else { ddeReturn = NULL; -- cgit v0.12 From abdeb8de335b3ad784fed7e0338bcfc9cbd3d99e Mon Sep 17 00:00:00 2001 From: ferrieux Date: Mon, 7 May 2012 16:36:43 +0000 Subject: Properly close nonblocking channels even when not flushing them. --- ChangeLog | 5 +++++ generic/tclIO.c | 6 +++--- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index fc7c245..7099611 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-04-28 Alexandre Ferrieux + + * generic/tclIO.c: Properly close nonblocking channels even when + not flushing them. + 2012-05-03 Jan Nijtmans * compat/zlib/*: Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5, diff --git a/generic/tclIO.c b/generic/tclIO.c index b06c14d..86ee6ed 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -428,14 +428,15 @@ TclFinalizeIOSubsystem(void) statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD) - || (doflushnb && GotFlag(statePtr, BG_FLUSH_SCHEDULED))) { + || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; } } /* - * We've found a live channel. Close it. + * We've found a live (or bg-closing) channel. Close it. */ if (active) { @@ -479,7 +480,6 @@ TclFinalizeIOSubsystem(void) * The refcount is greater than zero, so flush the channel. */ - ResetFlag(statePtr, BG_FLUSH_SCHEDULED); Tcl_Flush((Tcl_Channel) chanPtr); /* -- cgit v0.12 From 3d51560e948b0600d4f3990406bca9167099c16b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 9 May 2012 08:47:19 +0000 Subject: [Bug 473946]: special characters not correctly sent --- ChangeLog | 4 ++++ win/tclWinDde.c | 57 +++++++++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 51 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index 263d2c9..d7c07c2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2012-05-09 Jan Nijtmans + + * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent + 2012-05-02 Jan Nijtmans * generic/configure.in: Better detection and implementation for cpuid diff --git a/win/tclWinDde.c b/win/tclWinDde.c index aa51689..8dc8af4 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -100,6 +100,27 @@ int Tcl_DdeObjCmd(ClientData clientData, /* Used only for deletion */ Tcl_Obj *CONST objv[]); /* The arguments */ EXTERN int Dde_Init(Tcl_Interp *interp); + +/* + * The following structures allow us to select between the Unicode and ASCII + * interfaces at run time based on whether Unicode APIs are available. The + * Unicode APIs are preferable because they will handle characters outside + * of the current code page. + */ + +typedef struct DdeWinProcs { + int uFmt; +} DdeWinProcs; + +static DdeWinProcs *ddeWinProcs; + +static DdeWinProcs asciiProcs = { + CF_TEXT +}; + +static DdeWinProcs unicodeProcs = { + CF_UNICODETEXT +}; /* *---------------------------------------------------------------------- @@ -124,6 +145,16 @@ Dde_Init( if (!Tcl_InitStubs(interp, "8.0", 0)) { return TCL_ERROR; } + /* + * Determine if the unicode interfaces are available and select the + * appropriate dde function table. + */ + + if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { + ddeWinProcs = &unicodeProcs; + } else { + ddeWinProcs = &asciiProcs; + } Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL); @@ -537,7 +568,7 @@ DdeServerProc ( * last execute. */ - if (uFmt != CF_TEXT) { + if ((uFmt != CF_TEXT) && (uFmt != ddeWinProcs->uFmt)) { return (HDDEDATA) FALSE; } @@ -562,11 +593,14 @@ DdeServerProc ( if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) { returnString = Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - Tcl_DStringInit (&dString); - returnString = - Tcl_UtfToExternalDString (NULL, returnString, -1, &dString); + if (uFmt == CF_UNICODETEXT) { + Tcl_DStringFree(&dString); + returnString = + Tcl_WinUtfToTChar(returnString, len, &dString); + len = Tcl_DStringLength(&dString) + 1; + } ddeReturn = DdeCreateDataHandle(ddeInstance, - (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT, + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( @@ -575,12 +609,15 @@ DdeServerProc ( if (variableObjPtr != NULL) { returnString = Tcl_GetStringFromObj(variableObjPtr, &len); - Tcl_DStringInit (&dString); - returnString = - Tcl_UtfToExternalDString (NULL, returnString, -1, &dString); + if (uFmt == CF_UNICODETEXT) { + Tcl_DStringFree(&dString); + returnString = + Tcl_WinUtfToTChar(returnString, len, &dString); + len = Tcl_DStringLength(&dString) + 1; + } ddeReturn = DdeCreateDataHandle(ddeInstance, - (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, - CF_TEXT, 0); + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, + uFmt, 0); } else { ddeReturn = NULL; } -- cgit v0.12 From b085bdf17a65111cfda61a55fbe5aeedd61b5954 Mon Sep 17 00:00:00 2001 From: andreask Date: Wed, 9 May 2012 19:03:42 +0000 Subject: * tests/ioCmd.test [Bug 3522560]: Added a test which crashes the core if it were not disabled as knownBug. For a reflected channel transfered to a different thread the [chan postevent] run in the handler thread tries to execute the owner threads's fileevent scripts by itself, wrongly reaching across thread boundaries. --- ChangeLog | 8 ++++ tests/ioCmd.test | 114 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 122 insertions(+) diff --git a/ChangeLog b/ChangeLog index 7099611..e8d6c50 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-05-09 Andreas Kupries + + * tests/ioCmd.test [Bug 3522560]: Added a test which crashes the + core if it were not disabled as knownBug. For a reflected channel + transfered to a different thread the [chan postevent] run in the + handler thread tries to execute the owner threads's fileevent + scripts by itself, wrongly reaching across thread boundaries. + 2012-04-28 Alexandre Ferrieux * generic/tclIO.c: Properly close nonblocking channels even when diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 1d34861..17c4952 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2616,6 +2616,120 @@ test iocmd.tf-24.16 {chan write, note the background flush setup by close due to } -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \ -constraints {testchannel thread knownBug} +test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \ + -constraints {testchannel thread knownBug} -setup { + # This test exposes how the execution of postevent in the handler thread causes + # a crash if we are not properly injecting the events into the owning thread instead. + # With the injection the test will simply complete without crash. + + set beat 10000 + set drive 999 + set data ...---... + + proc LOG {text} { + #puts stderr "[thread::id]: $text" + return + } + + proc POST {hi} { + LOG "-> [info level 0]" + chan postevent $hi read + LOG "<- [info level 0]" + + set ::timer [after $::drive [info level 0]] + return + } + + proc HANDLER {op ch args} { + lappend ::res [lrange [info level 0] 1 end] + LOG "-> [info level 0]" + set ret {} + switch -glob -- $op { + init* {set ret {initialize finalize watch read}} + watch { + set l [lindex $args 0] + if {[llength $l]} { + set ::timer [after $::drive [list POST $ch]] + } else { + after cancel $::timer + } + } + finalize { + catch { after cancel $::timer } + after 500 {set ::forever now} + } + read { + set ret $::data + set ::data {} ; # Next is EOF. + } + } + LOG "<- [info level 0] : $ret" + return $ret + } +} -body { + LOG BEGIN + set ch [chan create {read} HANDLER] + + set tid [thread::create { + proc LOG {text} { + #puts stderr "\t\t\t\t\t\t[thread::id]: $text" + return + } + LOG THREAD-STARTED + load {} Tcltest + proc bgerror s { + LOG BGERROR:$s + } + vwait forever + LOG THREAD-DONE + }] + + testchannel cut $ch + thread::send $tid [list set thech $ch] + thread::send $tid [list set beat $beat] + thread::send -async $tid { + LOG SPLICE-BEG + testchannel splice $thech + LOG SPLICE-END + proc PROCESS {ch} { + LOG "-> [info level 0]" + if {[eof $ch]} { + close $ch + set ::done 1 + set c <> + } else { + set c [read $ch 1] + } + LOG "GOTCHAR: $c" + LOG "<- [info level 0]" + } + LOG THREAD-FILEEVENT + fconfigure $thech -translation binary -blocking 0 + fileevent $thech readable [list PROCESS $thech] + LOG THREAD-NOEVENT-LOOP + set done 0 + while {!$done} { + after $beat + LOG THREAD-HEARTBEAT + update + } + LOG THREAD-LOOP-DONE + thread::exit + } + + LOG MAIN_WAITING + vwait forever + LOG MAIN_DONE + + set res +} -cleanup { + rename LOG {} + rename POST {} + rename HANDLER {} + unset beat drive data forever res tid ch +} -match glob \ + -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}} + # --- === *** ########################### # method cgetall -- cgit v0.12 From e20f1abdc32a0550e6c840dcb99c848b39d33537 Mon Sep 17 00:00:00 2001 From: andreask Date: Wed, 9 May 2012 19:09:51 +0000 Subject: * generic/tclIORChan.c [Bug 3522560]: Fixed the crash, enabled the test case. Modified [chan postevent] to properly inject the event(s) into the owner thread's event queue for execution in the correct context. Renamed the ForwardOpTo...Thread() function to match with our terminology. --- ChangeLog | 6 ++ generic/tclIO.c | 2 +- generic/tclIORChan.c | 174 ++++++++++++++++++++++++++++++++++++++++++++++----- tests/ioCmd.test | 2 +- 4 files changed, 167 insertions(+), 17 deletions(-) diff --git a/ChangeLog b/ChangeLog index e8d6c50..6b02b23 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,11 @@ 2012-05-09 Andreas Kupries + * generic/tclIORChan.c [Bug 3522560]: Fixed the crash, enabled the + test case. Modified [chan postevent] to properly inject the + event(s) into the owner thread's event queue for execution in the + correct context. Renamed the ForwardOpTo...Thread() function to + match with our terminology. + * tests/ioCmd.test [Bug 3522560]: Added a test which crashes the core if it were not disabled as knownBug. For a reflected channel transfered to a different thread the [chan postevent] run in the diff --git a/generic/tclIO.c b/generic/tclIO.c index 86ee6ed..9e729c4 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8760,7 +8760,7 @@ CreateScriptRecord( /* * Initialize the structure before calling Tcl_CreateChannelHandler, - * because a reflected channel caling 'chan postevent' aka + * because a reflected channel calling 'chan postevent' aka * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to * see uninitialized memory and crash. See [Bug 2918110]. diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 49e2930..76002f6 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -39,6 +39,9 @@ static int ReflectOutput(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr); static void ReflectWatch(ClientData clientData, int mask); static int ReflectBlock(ClientData clientData, int mode); +#ifdef TCL_THREADS +static void ReflectThread(ClientData clientData, int action); +#endif static Tcl_WideInt ReflectSeekWide(ClientData clientData, Tcl_WideInt offset, int mode, int *errorCodePtr); static int ReflectSeek(ClientData clientData, long offset, @@ -71,7 +74,11 @@ static const Tcl_ChannelType tclRChannelType = { NULL, /* Flush channel. Not used by core. NULL'able */ NULL, /* Handle events. NULL'able */ ReflectSeekWide, /* Move access point (64 bit). NULL'able */ +#ifdef TCL_THREADS + ReflectThread, /* thread action, tracking owner */ +#else NULL, /* thread action */ +#endif NULL /* truncate */ }; @@ -89,7 +96,8 @@ typedef struct { * command is gone. */ #ifdef TCL_THREADS - Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ + Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ + Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif /* See [==] as well. @@ -390,7 +398,7 @@ TCL_DECLARE_MUTEX(rcForwardMutex) * leak resources when threads go away. */ -static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr, +static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr, ForwardedOperation op, const void *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); @@ -765,6 +773,48 @@ TclChanCreateObjCmd( *---------------------------------------------------------------------- */ +typedef struct ReflectEvent { + Tcl_Event header; + ReflectedChannel* rcPtr; + int events; +} ReflectEvent; + +static int +ReflectEventRun (Tcl_Event* ev, int flags) +{ + /* OWNER thread + * + * Note: When the channel is closed any pending events of this type are + * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls + * accomplishing that. + */ + + ReflectEvent* e = (ReflectEvent*) ev; + + Tcl_NotifyChannel (e->rcPtr->chan, e->events); + return 1; +} + +static int +ReflectEventDelete (Tcl_Event* ev, ClientData cd) +{ + /* OWNER thread + * + * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The + * latter ensures that no pending events of this type are run on an + * invalid channel. + */ + + ReflectEvent* e = (ReflectEvent*) ev; + + if ((ev->proc != ReflectEventRun) || + ((cd != NULL) && + (cd != e->rcPtr))) { + return 0; + } + return 1; +} + int TclChanPostEventObjCmd( ClientData clientData, @@ -773,6 +823,8 @@ TclChanPostEventObjCmd( Tcl_Obj *const *objv) { /* + * Ensure -> HANDLER thread + * * Syntax: chan postevent CHANNEL EVENTSPEC * [0] [1] [2] [3] * @@ -882,7 +934,38 @@ TclChanPostEventObjCmd( * We have the channel and the events to post. */ - Tcl_NotifyChannel(chan, events); + { + ReflectEvent* ev = ckalloc (sizeof (ReflectEvent)); + ev->header.proc = ReflectEventRun; + ev->events = events; + ev->rcPtr = rcPtr; + + /* + * We are not preserving the structure here. When the channel is + * closed any pending events are deleted, see ReflectClose(), and + * ReflectEventDelete(). Trying to preserve and later release when the + * event is run may generate a situation where the channel structure + * is deleted but not our structure, crashing in + * FreeReflectedChannel(). + */ + + /* Force creation of the RCM, for proper cleanup on thread teardown */ + /* The teardown of unprocessed events is currently coupled to the thread reflected channel map */ + (void) GetThreadReflectedChannelMap (); + + if (rcPtr->owner == rcPtr->thread) { + Tcl_QueueEvent ((Tcl_Event*) ev, TCL_QUEUE_TAIL); + } else { + /* XXX Race condition !! + * XXX The destination thread may not exist anymore already. + * XXX (Delayed postevent executed after channel got removed). + * XXX Can we detect this ? (check the validity of the owner threadid ?) + * XXX Actually, in that case the channel should be dead also ! + */ + Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL); + Tcl_ThreadAlert (rcPtr->owner); + } + } /* * Squash interp results left by the event script. @@ -1067,9 +1150,12 @@ ReflectClose( if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; + /* Now squash the pending reflection events for this channel. */ + Tcl_DeleteEvents (ReflectEventDelete, rcPtr); + if (result != TCL_OK) { FreeReceivedError(&p); } @@ -1100,9 +1186,12 @@ ReflectClose( if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; - ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; + /* Now squash the pending reflection events for this channel. */ + Tcl_DeleteEvents (ReflectEventDelete, rcPtr); + Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel); if (result != TCL_OK) { @@ -1207,7 +1296,7 @@ ReflectInput( p.input.buf = buf; p.input.toRead = toRead; - ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { @@ -1322,7 +1411,7 @@ ReflectOutput( p.output.buf = buf; p.output.toWrite = toWrite; - ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p); if (p.base.code != TCL_OK) { if (p.base.code < 0) { @@ -1438,7 +1527,7 @@ ReflectSeekWide( p.seek.seekMode = seekMode; p.seek.offset = offset; - ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); @@ -1562,7 +1651,7 @@ ReflectWatch( ForwardParam p; p.watch.mask = mask; - ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p); /* * Any failure from the forward is ignored. We have no place to put @@ -1620,7 +1709,7 @@ ReflectBlock( p.block.nonblocking = nonblocking; - ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p); if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); @@ -1650,6 +1739,42 @@ ReflectBlock( return errorNum; } +#ifdef TCL_THREADS +/* + *---------------------------------------------------------------------- + * + * ReflectThread -- + * + * This function is invoked to tell the channel about thread movements. + * + * Results: + * None. + * + * Side effects: + * Allocates memory. Arbitrary, as it calls upon a script. + * + *---------------------------------------------------------------------- + */ + +static void +ReflectThread(ClientData clientData, int action) +{ + ReflectedChannel *rcPtr = clientData; + + switch (action) { + case TCL_CHANNEL_THREAD_INSERT: + rcPtr->owner = Tcl_GetCurrentThread(); + break; + case TCL_CHANNEL_THREAD_REMOVE: + rcPtr->owner = NULL; + break; + default: + Tcl_Panic ("Unknown thread action code."); + break; + } +} + +#endif /* *---------------------------------------------------------------------- * @@ -1689,7 +1814,7 @@ ReflectSetOption( p.setOpt.name = optionName; p.setOpt.value = newValue; - ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p); + ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); @@ -1775,7 +1900,7 @@ ReflectGetOption( opcode = ForwardedGetOpt; } - ForwardOpToOwnerThread(rcPtr, opcode, &p); + ForwardOpToHandlerThread(rcPtr, opcode, &p); if (p.base.code != TCL_OK) { Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1); @@ -2673,6 +2798,15 @@ DeleteThreadReflectedChannelMap( Tcl_MutexUnlock(&rcForwardMutex); /* + * Run over the event queue of this thread and remove all ReflectEvent's + * still pending. These are inbound events for reflected channels this + * thread owns but doesn't handle. The inverse of the channel map + * actually. + */ + + Tcl_DeleteEvents (ReflectEventDelete, NULL); + + /* * Get the map of all channels handled by the current thread. This is a * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go * through the channels, remove all, mark them as dead. @@ -2693,11 +2827,16 @@ DeleteThreadReflectedChannelMap( } static void -ForwardOpToOwnerThread( +ForwardOpToHandlerThread( ReflectedChannel *rcPtr, /* Channel instance */ ForwardedOperation op, /* Forwarded driver operation */ const void *param) /* Arguments */ { + /* + * Core of the communication from OWNER to HANDLER thread. + * The receiver is ForwardProc() below. + */ + Tcl_ThreadId dst = rcPtr->thread; ForwardingEvent *evPtr; ForwardingResult *resultPtr; @@ -2750,7 +2889,7 @@ ForwardOpToOwnerThread( /* * Ensure cleanup of the event if the origin thread exits while this event * is pending or in progress. Exit of the destination thread is handled by - * DeleteThreadReflectionChannelMap(), this is set up by + * DeleteThreadReflectedChannelMap(), this is set up by * GetThreadReflectedChannelMap(). This is what we use the 'forwardList' * (see above) for. */ @@ -2765,7 +2904,7 @@ ForwardOpToOwnerThread( Tcl_ThreadAlert(dst); /* - * (*) Block until the other thread has either processed the transfer or + * (*) Block until the handler thread has either processed the transfer or * rejected it. */ @@ -2813,6 +2952,11 @@ ForwardProc( int mask) { /* + * HANDLER thread. + + * The receiver part for the operations coming from the OWNER thread. + * See ForwardOpToHandlerThread() for the transmitter. + * * Notes regarding access to the referenced data. * * In principle the data belongs to the originating thread (see diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 17c4952..fc47bbf 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2617,7 +2617,7 @@ test iocmd.tf-24.16 {chan write, note the background flush setup by close due to -constraints {testchannel thread knownBug} test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \ - -constraints {testchannel thread knownBug} -setup { + -constraints {testchannel thread} -setup { # This test exposes how the execution of postevent in the handler thread causes # a crash if we are not properly injecting the events into the owning thread instead. # With the injection the test will simply complete without crash. -- cgit v0.12 From 4d737ad3cb8cace53eb446a55b1674a967b6b164 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 9 May 2012 19:18:55 +0000 Subject: Increase version to 1.2.5 Now should work on Win95 as well Use Tcl_GetUnicodeFromObj in stead of Tcl_Win* functions, so we no longer have to detect whether we are on WinNT+ --- ChangeLog | 3 +- library/dde/pkgIndex.tcl | 4 +- win/tclWinDde.c | 265 ++++++++++++++++++++--------------------------- 3 files changed, 119 insertions(+), 153 deletions(-) diff --git a/ChangeLog b/ChangeLog index d7c07c2..98b77c9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,7 @@ -2012-05-09 Jan Nijtmans +2012-05-?? Jan Nijtmans * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent + * library/dde/pkgIndex.tcl Increase version to 1.2.5 2012-05-02 Jan Nijtmans diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index e414051..db67e98 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,7 +1,7 @@ if {![package vsatisfies [package provide Tcl] 8]} return if {[string compare [info sharedlibextension] .dll]} return if {[info exists ::tcl_platform(debug)]} { - package ifneeded dde 1.2.4 [list load [file join $dir tcldde12g.dll] dde] + package ifneeded dde 1.2.5 [list load [file join $dir tcldde12g.dll] dde] } else { - package ifneeded dde 1.2.4 [list load [file join $dir tcldde12.dll] dde] + package ifneeded dde 1.2.5 [list load [file join $dir tcldde12.dll] dde] } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 8dc8af4..4e4d500 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1,4 +1,4 @@ -/* +/* * tclWinDde.c -- * * This file provides procedures that implement the "send" @@ -24,7 +24,7 @@ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT -/* +/* * The following structure is used to keep track of the interpreters * registered by this process. */ @@ -68,9 +68,10 @@ static DWORD ddeInstance; /* The application instance handle given * to us by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.2.4" -#define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME "TclEval" +#define TCL_DDE_VERSION "1.2.5" +#define TCL_DDE_PACKAGE_NAME "dde" +#define TCL_DDE_SERVICE_NAME "TclEval" +#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" TCL_DECLARE_MUTEX(ddeMutex) @@ -78,49 +79,27 @@ TCL_DECLARE_MUTEX(ddeMutex) * Forward declarations for procedures defined later in this file. */ -static void DdeExitProc _ANSI_ARGS_((ClientData clientData)); -static void DeleteProc _ANSI_ARGS_((ClientData clientData)); -static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_(( - RegisteredInterp *riPtr, - Tcl_Obj *ddeObjectPtr)); -static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp, - char *name, HCONV *ddeConvPtr)); -static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType, +static void DdeExitProc(ClientData clientData); +static void DeleteProc(ClientData clientData); +static Tcl_Obj * ExecuteRemoteObject( + RegisteredInterp *riPtr, + Tcl_Obj *ddeObjectPtr); +static int MakeDdeConnection(Tcl_Interp *interp, + const char *name, HCONV *ddeConvPtr); +static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, - HSZ ddeItem, HDDEDATA hData, DWORD dwData1, - DWORD dwData2)); -static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp)); -static int DdeGetServicesList _ANSI_ARGS_(( + HSZ ddeItem, HDDEDATA hData, DWORD dwData1, + DWORD dwData2); +static void SetDdeError(Tcl_Interp *interp); +static int DdeGetServicesList( Tcl_Interp *interp, - char *serviceName, - char *topicName)); -int Tcl_DdeObjCmd(ClientData clientData, /* Used only for deletion */ - Tcl_Interp *interp, /* The interp we are sending from */ - int objc, /* Number of arguments */ - Tcl_Obj *CONST objv[]); /* The arguments */ - -EXTERN int Dde_Init(Tcl_Interp *interp); - -/* - * The following structures allow us to select between the Unicode and ASCII - * interfaces at run time based on whether Unicode APIs are available. The - * Unicode APIs are preferable because they will handle characters outside - * of the current code page. - */ - -typedef struct DdeWinProcs { - int uFmt; -} DdeWinProcs; + const char *serviceName, + const char *topicName); +static int DdeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); -static DdeWinProcs *ddeWinProcs; - -static DdeWinProcs asciiProcs = { - CF_TEXT -}; - -static DdeWinProcs unicodeProcs = { - CF_UNICODETEXT -}; +EXTERN int Dde_Init(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -142,24 +121,12 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.0", 0)) { + if (!Tcl_InitStubs(interp, "8.1", 0)) { return TCL_ERROR; } - /* - * Determine if the unicode interfaces are available and select the - * appropriate dde function table. - */ - - if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { - ddeWinProcs = &unicodeProcs; - } else { - ddeWinProcs = &asciiProcs; - } - - Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); } @@ -184,7 +151,7 @@ Initialize(void) { int nameFound = 0; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - + /* * See if the application is already registered; if so, remove its * current name from the registry. The deletion of the command @@ -206,7 +173,7 @@ Initialize(void) if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS - | CBF_FAIL_POKES, 0) + | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; } @@ -226,7 +193,7 @@ Initialize(void) } Tcl_MutexUnlock(&ddeMutex); } -} +} /* *-------------------------------------------------------------- @@ -256,7 +223,7 @@ Initialize(void) static char * DdeSetServerName( Tcl_Interp *interp, - char *name /* The name that will be used to + const char *name /* The name that will be used to * refer to the interpreter in later * "send" commands. Must be globally * unique. */ @@ -272,7 +239,7 @@ DdeSetServerName( * will take care of disposing of this entry. */ - for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; + for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; prevPtr = riPtr, riPtr = riPtr->nextPtr) { if (riPtr->interp == interp) { if (name != NULL) { @@ -302,7 +269,7 @@ DdeSetServerName( return ""; } - + /* * Pick a name to use for the application. Use "name" if it's not * already in use. Otherwise add a suffix such as " #2", trying @@ -323,7 +290,7 @@ DdeSetServerName( tsdPtr->interpListPtr = riPtr; strcpy(riPtr->name, name); - Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, (ClientData) riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); @@ -334,7 +301,7 @@ DdeSetServerName( * re-initialize with the new name */ Initialize(); - + return riPtr->name; } @@ -459,11 +426,11 @@ DdeServerProc ( * are performing. */ UINT uFmt, /* The format that data is sent or * received. */ - HCONV hConv, /* The conversation associated with the + HCONV hConv, /* The conversation associated with the * current transaction. */ - HSZ ddeTopic, /* A string handle. Transaction-type + HSZ ddeTopic, /* A string handle. Transaction-type * dependent. */ - HSZ ddeItem, /* A string handle. Transaction-type + HSZ ddeItem, /* A string handle. Transaction-type * dependent. */ HDDEDATA hData, /* DDE data. Transaction-type dependent. */ DWORD dwData1, /* Transaction-dependent data. */ @@ -508,7 +475,7 @@ DdeServerProc ( case XTYP_CONNECT_CONFIRM: /* - * Dde has decided that we can connect, so it gives us a + * Dde has decided that we can connect, so it gives us a * conversation handle. We need to keep track of it * so we know which execution result to return in an * XTYP_REQUEST. @@ -518,9 +485,9 @@ DdeServerProc ( Tcl_DStringInit(&dString); Tcl_DStringSetLength(&dString, len); utilString = Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, CP_WINANSI); - for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (stricmp(riPtr->name, utilString) == 0) { convPtr = (Conversation *) ckalloc(sizeof(Conversation)); @@ -543,7 +510,7 @@ DdeServerProc ( */ for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL; - convPtr != NULL; + convPtr != NULL; prevConvPtr = convPtr, convPtr = convPtr->nextPtr) { if (hConv == convPtr->hConv) { if (prevConvPtr == NULL) { @@ -568,7 +535,7 @@ DdeServerProc ( * last execute. */ - if ((uFmt != CF_TEXT) && (uFmt != ddeWinProcs->uFmt)) { + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { return (HDDEDATA) FALSE; } @@ -588,36 +555,34 @@ DdeServerProc ( Tcl_DStringInit(&dString); Tcl_DStringSetLength(&dString, len); utilString = Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, ddeItem, utilString, + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, CP_WINANSI); - if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) { - returnString = - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - if (uFmt == CF_UNICODETEXT) { - Tcl_DStringFree(&dString); + if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + if (uFmt == CF_TEXT) { returnString = - Tcl_WinUtfToTChar(returnString, len, &dString); - len = Tcl_DStringLength(&dString) + 1; + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + } else { + returnString = (char *) + Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); + len = 2 * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, - (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, - 0); + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( - convPtr->riPtr->interp, utilString, NULL, + convPtr->riPtr->interp, utilString, NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = Tcl_GetStringFromObj(variableObjPtr, - &len); - if (uFmt == CF_UNICODETEXT) { - Tcl_DStringFree(&dString); + if (uFmt == CF_TEXT) { returnString = - Tcl_WinUtfToTChar(returnString, len, &dString); - len = Tcl_DStringLength(&dString) + 1; + Tcl_GetStringFromObj(variableObjPtr, &len); + } else { + returnString = (char *) + Tcl_GetUnicodeFromObj(variableObjPtr, &len); + len = 2 * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, - (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, - uFmt, 0); + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { ddeReturn = NULL; } @@ -657,7 +622,7 @@ DdeServerProc ( Tcl_DecrRefCount(convPtr->returnPackagePtr); } convPtr->returnPackagePtr = NULL; - returnPackagePtr = + returnPackagePtr = ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr); Tcl_IncrRefCount(returnPackagePtr); for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) @@ -679,7 +644,7 @@ DdeServerProc ( return (HDDEDATA) DDE_FACK; } } - + case XTYP_WILDCONNECT: { /* @@ -703,10 +668,10 @@ DdeServerProc ( (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); len = dlen; - for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; + for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { returnPtr[i].hszSvc = DdeCreateStringHandle( - ddeInstance, "TclEval", CP_WINANSI); + ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINANSI); returnPtr[i].hszTopic = DdeCreateStringHandle( ddeInstance, riPtr->name, CP_WINANSI); } @@ -755,7 +720,7 @@ DdeExitProc( * * Results: * A standard Tcl result. - * + * * * Side effects: * Passes back a conversation through ddeConvPtr @@ -766,13 +731,13 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - char *name, /* The connection to use. */ + const char *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; - - ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0); + + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); @@ -818,7 +783,7 @@ typedef struct ddeEnumServices { HWND hwnd; } ddeEnumServices; -LRESULT CALLBACK +static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); @@ -845,7 +810,7 @@ DdeCreateClient(ddeEnumServices *es) return TCL_OK; } -LRESULT CALLBACK +static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) { LRESULT lr = 0L; @@ -926,7 +891,7 @@ DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam) } static int -DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName) +DdeGetServicesList(Tcl_Interp *interp, const char *serviceName, const char *topicName) { ddeEnumServices es; es.interp = interp; @@ -935,11 +900,11 @@ DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName) ? (ATOM)0 : GlobalAddAtom(serviceName); es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName); - + Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es); - + if (IsWindow(es.hwnd)) DestroyWindow(es.hwnd); if (es.service != (ATOM)0) @@ -959,7 +924,7 @@ DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName) * * Results: * None. - * + * * * Side effects: * The interp's result object is changed. @@ -988,7 +953,7 @@ SetDdeError( break; case DMLERR_NOTPROCESSED: - Tcl_SetStringObj(resultPtr, + Tcl_SetStringObj(resultPtr, "remote server cannot handle this command", -1); break; @@ -1000,7 +965,7 @@ SetDdeError( /* *-------------------------------------------------------------- * - * Tcl_DdeObjCmd -- + * DdeObjCmd -- * * This procedure is invoked to process the "dde" Tcl command. * See the user documentation for details on what it does. @@ -1014,12 +979,12 @@ SetDdeError( *-------------------------------------------------------------- */ -int -Tcl_DdeObjCmd( +static int +DdeObjCmd( ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ - Tcl_Obj *CONST *objv) /* The arguments */ + Tcl_Obj *const *objv) /* The arguments */ { enum { DDE_SERVERNAME, @@ -1030,11 +995,11 @@ Tcl_DdeObjCmd( DDE_EVAL }; - static CONST char *ddeCommands[] = {"servername", "execute", "poke", - "request", "services", "eval", + static const char *ddeCommands[] = {"servername", "execute", "poke", + "request", "services", "eval", (char *) NULL}; - static CONST char *ddeOptions[] = {"-async", (char *) NULL}; - static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL}; + static const char *ddeOptions[] = {"-async", (char *) NULL}; + static const char *ddeReqOptions[] = {"-binary", (char *) NULL}; int index, argIndex; int async = 0, binary = 0; int result = TCL_OK; @@ -1045,7 +1010,7 @@ Tcl_DdeObjCmd( HDDEDATA ddeItemData = NULL; HCONV hConv = NULL; HSZ ddeCookie = 0; - char *serviceName, *topicName = NULL, *itemString; + const char *serviceName, *topicName = NULL, *itemString; char *string; int firstArg = 0, length, dataLength; DWORD ddeResult; @@ -1058,9 +1023,9 @@ Tcl_DdeObjCmd( /* * Initialize DDE server/client */ - + if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, + Tcl_WrongNumArgs(interp, 1, objv, "?-async? serviceName topicName value"); return TCL_ERROR; } @@ -1080,7 +1045,7 @@ Tcl_DdeObjCmd( break; case DDE_EXECUTE: if ((objc < 5) || (objc > 6)) { - Tcl_WrongNumArgs(interp, 1, objv, + Tcl_WrongNumArgs(interp, 1, objv, "execute ?-async? serviceName topicName value"); return TCL_ERROR; } @@ -1113,7 +1078,7 @@ Tcl_DdeObjCmd( break; case DDE_REQUEST: if ((objc < 5) || (objc > 6)) { - Tcl_WrongNumArgs(interp, 1, objv, + Tcl_WrongNumArgs(interp, 1, objv, "request ?-binary? serviceName topicName value"); return TCL_ERROR; } @@ -1146,7 +1111,7 @@ Tcl_DdeObjCmd( break; case DDE_EVAL: if (objc < 4) { - Tcl_WrongNumArgs(interp, 1, objv, + Tcl_WrongNumArgs(interp, 1, objv, "eval ?-async? serviceName args"); return TCL_ERROR; } @@ -1191,7 +1156,7 @@ Tcl_DdeObjCmd( if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandle(ddeInstance, + ddeTopic = DdeCreateStringHandle(ddeInstance, topicName, CP_WINANSI); } } @@ -1230,9 +1195,9 @@ Tcl_DdeObjCmd( (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); if (ddeData != NULL) { if (async) { - DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, + DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); - DdeAbandonTransaction(ddeInstance, hConv, + DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, @@ -1259,13 +1224,13 @@ Tcl_DdeObjCmd( hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); - + if (hConv == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandle(ddeInstance, + ddeItem = DdeCreateStringHandle(ddeInstance, itemString, CP_WINANSI); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, @@ -1304,7 +1269,7 @@ Tcl_DdeObjCmd( goto errorNoResult; } dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3], &length); - + hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); DdeFreeStringHandle(ddeInstance, ddeTopic); @@ -1348,12 +1313,12 @@ Tcl_DdeObjCmd( * See if the target interpreter is local. If so, execute * the command directly without going through the DDE server. * Don't exchange objects between interps. The target interp could - * compile an object, producing a bytecode structure that refers to - * other objects owned by the target interp. If the target interp - * is then deleted, the bytecode structure would be referring to + * compile an object, producing a bytecode structure that refers to + * other objects owned by the target interp. If the target interp + * is then deleted, the bytecode structure would be referring to * deallocated objects. */ - + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (stricmp(serviceName, riPtr->name) == 0) { @@ -1366,11 +1331,11 @@ Tcl_DdeObjCmd( * This command is to a local interp. No need to go through * the server. */ - + Tcl_Preserve((ClientData) riPtr); sendInterp = riPtr->interp; Tcl_Preserve((ClientData) sendInterp); - + /* * Don't exchange objects between interps. The target interp * would compile an object, producing a bytecode structure that @@ -1396,13 +1361,13 @@ Tcl_DdeObjCmd( * from the destination interpreter back to our * interpreter. */ - + Tcl_ResetResult(interp); - objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, + objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, TCL_GLOBAL_ONLY); string = Tcl_GetStringFromObj(objPtr, &length); Tcl_AddObjErrorInfo(interp, string, length); - + objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, TCL_GLOBAL_ONLY); Tcl_SetObjErrorCode(interp, objPtr); @@ -1416,16 +1381,16 @@ Tcl_DdeObjCmd( * This is a non-local request. Send the script to the server * and poll it for a result. */ - + if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { goto error; } - + objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetStringFromObj(objPtr, &length); ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); - + if (async) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, @@ -1436,24 +1401,24 @@ Tcl_DdeObjCmd( 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { - - ddeCookie = DdeCreateStringHandle(ddeInstance, - "$TCLEVAL$EXECUTE$RESULT", CP_WINANSI); + + ddeCookie = DdeCreateStringHandle(ddeInstance, + TCL_DDE_EXECUTE_RESULT, CP_WINANSI); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL); } } Tcl_DecrRefCount(objPtr); - + if (ddeData == 0) { SetDdeError(interp); goto errorNoResult; } - + if (async == 0) { Tcl_Obj *resultPtr; - + /* * The return handle has a two or four element list in * it. The first element is the return code (TCL_OK, @@ -1462,14 +1427,14 @@ Tcl_DdeObjCmd( * element is the value of the variable "errorCode", and * the fourth is the value of the variable "errorInfo". */ - + resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); Tcl_SetObjLength(resultPtr, length); string = Tcl_GetString(resultPtr); DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0); Tcl_SetObjLength(resultPtr, (int) strlen(string)); - + if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); @@ -1490,7 +1455,7 @@ Tcl_DdeObjCmd( length = -1; string = Tcl_GetStringFromObj(objPtr, &length); Tcl_AddObjErrorInfo(interp, string, length); - + Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); Tcl_SetObjErrorCode(interp, objPtr); } -- cgit v0.12 From 2454e655e137710903fe501014aa0de7550297cc Mon Sep 17 00:00:00 2001 From: andreask Date: Wed, 9 May 2012 22:28:42 +0000 Subject: Undone part of change [32d93a8414], keeping [chan postevent] synchronous for owner == handler. --- generic/tclIORChan.c | 31 +++++++++++++++---------------- tests/ioCmd.test | 2 +- 2 files changed, 16 insertions(+), 17 deletions(-) diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 76002f6..2d31da3 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -934,7 +934,9 @@ TclChanPostEventObjCmd( * We have the channel and the events to post. */ - { + if (rcPtr->owner == rcPtr->thread) { + Tcl_NotifyChannel (chan, events); + } else { ReflectEvent* ev = ckalloc (sizeof (ReflectEvent)); ev->header.proc = ReflectEventRun; ev->events = events; @@ -947,24 +949,21 @@ TclChanPostEventObjCmd( * event is run may generate a situation where the channel structure * is deleted but not our structure, crashing in * FreeReflectedChannel(). + * + * Force creation of the RCM, for proper cleanup on thread teardown. + * The teardown of unprocessed events is currently coupled to the + * thread reflected channel map */ - - /* Force creation of the RCM, for proper cleanup on thread teardown */ - /* The teardown of unprocessed events is currently coupled to the thread reflected channel map */ (void) GetThreadReflectedChannelMap (); - if (rcPtr->owner == rcPtr->thread) { - Tcl_QueueEvent ((Tcl_Event*) ev, TCL_QUEUE_TAIL); - } else { - /* XXX Race condition !! - * XXX The destination thread may not exist anymore already. - * XXX (Delayed postevent executed after channel got removed). - * XXX Can we detect this ? (check the validity of the owner threadid ?) - * XXX Actually, in that case the channel should be dead also ! - */ - Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL); - Tcl_ThreadAlert (rcPtr->owner); - } + /* XXX Race condition !! + * XXX The destination thread may not exist anymore already. + * XXX (Delayed postevent executed after channel got removed). + * XXX Can we detect this ? (check the validity of the owner threadid ?) + * XXX Actually, in that case the channel should be dead also ! + */ + Tcl_ThreadQueueEvent (rcPtr->owner, (Tcl_Event*) ev, TCL_QUEUE_TAIL); + Tcl_ThreadAlert (rcPtr->owner); } /* diff --git a/tests/ioCmd.test b/tests/ioCmd.test index fc47bbf..cf913ff 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2614,7 +2614,7 @@ test iocmd.tf-24.16 {chan write, note the background flush setup by close due to rename foo {} unset res } -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \ - -constraints {testchannel thread knownBug} + -constraints {testchannel thread} test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \ -constraints {testchannel thread} -setup { -- cgit v0.12 From 25566ea94ed5e5ecc53df06bd7e0f8f1349f001c Mon Sep 17 00:00:00 2001 From: ferrieux Date: Thu, 10 May 2012 21:43:30 +0000 Subject: [Bug 2812981]: Clean up bundled packages' build directory from within Tcl's ./configure, to avoid stale configuration. --- ChangeLog | 6 ++++++ unix/configure | 5 +++++ unix/configure.in | 5 +++++ win/configure | 5 +++++ win/configure.in | 5 +++++ 5 files changed, 26 insertions(+) diff --git a/ChangeLog b/ChangeLog index 6b02b23..bd13cb1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-05-10 Alexandre Ferrieux + + * {win,unix}/configure{,.in} [Bug 2812981]: Clean up bundled + packages' build directory from within Tcl's ./configure, to avoid + stale configuration. + 2012-05-09 Andreas Kupries * generic/tclIORChan.c [Bug 3522560]: Fixed the crash, enabled the diff --git a/unix/configure b/unix/configure index 8f25c08..1151497 100755 --- a/unix/configure +++ b/unix/configure @@ -1353,6 +1353,11 @@ if test -r "$cache_file" -a -f "$cache_file"; then fi #------------------------------------------------------------------------ +# Empty slate for bundled packages, to avoid stale configuration +#------------------------------------------------------------------------ +rm -Rf pkgs + +#------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ diff --git a/unix/configure.in b/unix/configure.in index 066a84f..4fc93dd 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -43,6 +43,11 @@ if test -r "$cache_file" -a -f "$cache_file"; then fi #------------------------------------------------------------------------ +# Empty slate for bundled packages, to avoid stale configuration +#------------------------------------------------------------------------ +rm -Rf pkgs + +#------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ diff --git a/win/configure b/win/configure index f3bd0d9..6673ecb 100755 --- a/win/configure +++ b/win/configure @@ -1329,6 +1329,11 @@ REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ #------------------------------------------------------------------------ +# Empty slate for bundled packages, to avoid stale configuration +#------------------------------------------------------------------------ +rm -Rf pkgs + +#------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ diff --git a/win/configure.in b/win/configure.in index 0ed8f89..1bab810 100644 --- a/win/configure.in +++ b/win/configure.in @@ -32,6 +32,11 @@ REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION PKG_CFG_ARGS=$@ #------------------------------------------------------------------------ +# Empty slate for bundled packages, to avoid stale configuration +#------------------------------------------------------------------------ +rm -Rf pkgs + +#------------------------------------------------------------------------ # Handle the --prefix=... option #------------------------------------------------------------------------ -- cgit v0.12 From 8084e168af0746710f165ebb4a157b45dc3b3756 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 May 2012 21:57:51 +0000 Subject: first shot at internationalization of dde --- win/tclWinDde.c | 101 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 53 insertions(+), 48 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 629af10..48bb53d 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -19,6 +19,11 @@ #include #include +#ifndef UNICODE +# undef CP_WINUNICODE +# define CP_WINUNICODE CP_WINANSI +#endif + /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init * declaration is in the source file itself, which is only accessed when we @@ -38,7 +43,7 @@ typedef struct RegisteredInterp { struct RegisteredInterp *nextPtr; /* The next interp this application knows * about. */ - char *name; /* Interpreter's name (malloc-ed). */ + TCHAR *name; /* Interpreter's name (malloc-ed). */ Tcl_Obj *handlerPtr; /* The server handler command */ Tcl_Interp *interp; /* The interpreter attached to this name. */ } RegisteredInterp; @@ -85,8 +90,8 @@ static int ddeIsServer = 0; #define TCL_DDE_VERSION "1.3.3" #define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME "TclEval" -#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" +#define TCL_DDE_SERVICE_NAME TEXT("TclEval") +#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") TCL_DECLARE_MUTEX(ddeMutex) @@ -101,7 +106,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(ClientData clientData); static int DdeGetServicesList(Tcl_Interp *interp, - const char *serviceName, const char *topicName); + const TCHAR *serviceName, const TCHAR *topicName); static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2); @@ -111,7 +116,7 @@ static void DeleteProc(ClientData clientData); static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, Tcl_Obj *ddeObjectPtr); static int MakeDdeConnection(Tcl_Interp *interp, - const char *name, HCONV *ddeConvPtr); + const TCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, @@ -264,10 +269,10 @@ Initialize(void) *---------------------------------------------------------------------- */ -static const char * +static const TCHAR * DdeSetServerName( Tcl_Interp *interp, - const char *name, /* The name that will be used to refer to the + const TCHAR *name, /* The name that will be used to refer to the * interpreter in later "send" commands. Must * be globally unique. */ int exactName, /* Should we make a unique name? 0 = unique */ @@ -277,7 +282,7 @@ DdeSetServerName( int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - const char *actualName; + const TCHAR *actualName; Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -315,15 +320,16 @@ DdeSetServerName( * current interp, but it doesn't have a name. */ - return ""; + return TEXT(""); } + Tcl_DStringInit(&dString); + /* * Get the list of currently registered Tcl interpreters by calling the * internal implementation of the 'dde services' command. */ - Tcl_DStringInit(&dString); actualName = name; if (!exactName) { @@ -370,7 +376,7 @@ DdeSetServerName( Tcl_Obj* namePtr; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { + if (_tcscmp(actualName, Tcl_GetString(namePtr)) == 0) { suffix++; break; } @@ -386,14 +392,14 @@ DdeSetServerName( riPtr = ckalloc(sizeof(RegisteredInterp)); riPtr->interp = interp; - riPtr->name = ckalloc(strlen(actualName) + 1); + riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR)); riPtr->nextPtr = tsdPtr->interpListPtr; riPtr->handlerPtr = handlerPtr; if (riPtr->handlerPtr != NULL) { Tcl_IncrRefCount(riPtr->handlerPtr); } tsdPtr->interpListPtr = riPtr; - strcpy(riPtr->name, actualName); + _tcscpy(riPtr->name, actualName); if (Tcl_IsSafe(interp)) { Tcl_ExposeCommand(interp, "dde", "dde"); @@ -609,7 +615,7 @@ DdeServerProc( Tcl_DString dString; int len; DWORD dlen; - char *utilString; + TCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -625,14 +631,14 @@ DdeServerProc( len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(utilString, riPtr->name) == 0) { + if (_tcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -650,13 +656,13 @@ DdeServerProc( len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(riPtr->name, utilString) == 0) { + if (_tcsicmp(riPtr->name, utilString) == 0) { convPtr = ckalloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; @@ -715,13 +721,13 @@ DdeServerProc( if (convPtr != NULL) { char *returnString; - len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, - CP_WINANSI); - if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + CP_WINUNICODE); + if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { if (uFmt == CF_TEXT) { returnString = Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); @@ -779,7 +785,7 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (char *) DdeAccessData(hData, &dlen); + utilString = (TCHAR *) DdeAccessData(hData, &dlen); len = dlen; ddeObjectPtr = Tcl_NewStringObj(utilString, -1); Tcl_IncrRefCount(ddeObjectPtr); @@ -833,9 +839,9 @@ DdeServerProc( for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINANSI); + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, - riPtr->name, CP_WINANSI); + riPtr->name, CP_WINUNICODE); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; @@ -893,7 +899,7 @@ DdeExitProc( static int MakeDdeConnection( Tcl_Interp *interp, /* Used to report errors. */ - const char *name, /* The connection to use. */ + const TCHAR *name, /* The connection to use. */ HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; @@ -944,8 +950,8 @@ DdeCreateClient( struct DdeEnumServices *es) { WNDCLASSEX wc; - static const char *szDdeClientClassName = "TclEval client class"; - static const char *szDdeClientWindowName = "TclEval client window"; + static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); + static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window"); memset(&wc, 0, sizeof(wc)); wc.cbSize = sizeof(wc); @@ -970,7 +976,6 @@ DdeClientWindowProc( WPARAM wParam, LPARAM lParam) /* (Potentially) our local handle */ { - switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; @@ -986,7 +991,6 @@ DdeClientWindowProc( } case WM_DDE_ACK: return DdeServicesOnAck(hwnd, wParam, lParam); - break; default: return DefWindowProc(hwnd, uMsg, wParam, lParam); } @@ -1002,7 +1006,7 @@ DdeServicesOnAck( ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); struct DdeEnumServices *es; - char sz[255]; + TCHAR sz[255]; #ifdef _WIN64 es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); @@ -1065,8 +1069,8 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const char *serviceName, - const char *topicName) + const TCHAR *serviceName, + const TCHAR *topicName) { struct DdeEnumServices es; @@ -1189,7 +1193,8 @@ DdeObjCmd( HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - const char *serviceName = NULL, *topicName = NULL, *string; + const TCHAR *serviceName = NULL, *topicName = NULL; + const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; @@ -1339,7 +1344,7 @@ DdeObjCmd( serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, - CP_WINANSI); + CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { @@ -1348,7 +1353,7 @@ DdeObjCmd( topicName = NULL; } else { ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, - CP_WINANSI); + CP_WINUNICODE); } } @@ -1428,7 +1433,7 @@ DdeObjCmd( } else { Tcl_Obj *returnObjPtr; ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, - CP_WINANSI); + CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, CF_TEXT, XTYP_REQUEST, 5000, NULL); @@ -1481,7 +1486,7 @@ DdeObjCmd( result = TCL_ERROR; } else { ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, - CP_WINANSI); + CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(dataString, (DWORD) length+1, hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); @@ -1527,7 +1532,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(serviceName, riPtr->name) == 0) { + if (_tcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1620,8 +1625,7 @@ DdeObjCmd( if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { invalidServerResponse: Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid data returned from server", - -1)); + Tcl_NewStringObj("invalid data returned from server", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL); result = TCL_ERROR; goto cleanup; @@ -1643,7 +1647,7 @@ DdeObjCmd( CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { ddeCookie = DdeCreateStringHandle(ddeInstance, - TCL_DDE_EXECUTE_RESULT, CP_WINANSI); + TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL); } @@ -1654,6 +1658,7 @@ DdeObjCmd( if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; + goto cleanup; } if (async == 0) { @@ -1670,7 +1675,7 @@ DdeObjCmd( resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); - Tcl_SetObjLength(resultPtr, length); + Tcl_SetObjLength(resultPtr, (length + 1) * sizeof(TCHAR) - 1); string = Tcl_GetString(resultPtr); DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0); Tcl_SetObjLength(resultPtr, (int) strlen(string)); -- cgit v0.12