diff options
| -rw-r--r-- | ChangeLog | 30 | ||||
| -rw-r--r-- | generic/tclIO.c | 8 | ||||
| -rw-r--r-- | generic/tclIORChan.c | 173 | ||||
| -rw-r--r-- | library/dde/pkgIndex.tcl | 4 | ||||
| -rw-r--r-- | tests/ioCmd.test | 116 | ||||
| -rwxr-xr-x | unix/configure | 5 | ||||
| -rw-r--r-- | unix/configure.in | 5 | ||||
| -rwxr-xr-x | win/configure | 5 | ||||
| -rw-r--r-- | win/configure.in | 5 | ||||
| -rw-r--r-- | win/tclWinDde.c | 223 |
10 files changed, 449 insertions, 125 deletions
@@ -1,3 +1,33 @@ +2012-05-10 Jan Nijtmans <nijtmans@users.sf.net> + + * win/tclWinDde.c: [Bug 473946]: special characters not correctly sent + * library/dde/pkgIndex.tcl Increase version to 1.3.3 + +2012-05-10 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + + * {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 <andreask@activestate.com> + + * 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 + handler thread tries to execute the owner threads's fileevent + scripts by itself, wrongly reaching across thread boundaries. + +2012-04-28 Alexandre Ferrieux <ferrieux@users.sourceforge.net> + + * generic/tclIO.c: Properly close nonblocking channels even when + not flushing them. + 2012-05-03 Jan Nijtmans <nijtmans@users.sf.net> * 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..9e729c4 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); /* @@ -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..2d31da3 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,37 @@ TclChanPostEventObjCmd( * We have the channel and the events to post. */ - Tcl_NotifyChannel(chan, events); + if (rcPtr->owner == rcPtr->thread) { + Tcl_NotifyChannel (chan, events); + } else { + 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 (); + + /* 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 +1149,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 +1185,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 +1295,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 +1410,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 +1526,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 +1650,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 +1708,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 +1738,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 +1813,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 +1899,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 +2797,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 +2826,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 +2888,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 +2903,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 +2951,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/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl index 9e62ac8..ce92028 100644 --- a/library/dde/pkgIndex.tcl +++ b/library/dde/pkgIndex.tcl @@ -1,7 +1,7 @@ if {![package vsatisfies [package provide Tcl] 8.5]} return if {[string compare [info sharedlibextension] .dll]} return if {[::tcl::pkgconfig get debug]} { - package ifneeded dde 1.3.2 [list load [file join $dir tcldde13g.dll] dde] + package ifneeded dde 1.3.3 [list load [file join $dir tcldde13g.dll] dde] } else { - package ifneeded dde 1.3.2 [list load [file join $dir tcldde13.dll] dde] + package ifneeded dde 1.3.3 [list load [file join $dir tcldde13.dll] dde] } diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 1d34861..cf913ff 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -2614,7 +2614,121 @@ 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 { + # 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 <<EOF>> + } 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 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 #------------------------------------------------------------------------ diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 71b03a9..48bb53d 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -11,13 +11,19 @@ */ #undef STATIC_BUILD -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif +#undef USE_TCL_STUBS +#define USE_TCL_STUBS +#undef UNICODE +#undef _UNICODE #include "tclInt.h" #include <dde.h> #include <ddeml.h> +#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 @@ -37,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; @@ -51,7 +57,7 @@ typedef struct Conversation { /* The next conversation in the list. */ RegisteredInterp *riPtr; /* The info we know about the conversation. */ HCONV hConv; /* The DDE handle for this conversation. */ - Tcl_Obj *returnPackagePtr; /* The result package for this conversation */ + Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; typedef struct DdeEnumServices { @@ -79,13 +85,13 @@ static Tcl_ThreadDataKey dataKey; static HSZ ddeServiceGlobal = 0; static DWORD ddeInstance; /* The application instance handle given to us - * by DdeInitializeA. */ + * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.3.2" +#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) @@ -100,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); @@ -110,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, @@ -215,7 +221,7 @@ Initialize(void) if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { - if (DdeInitializeA(&ddeInstance, (PFNCALLBACK) DdeServerProc, + if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; @@ -228,7 +234,7 @@ Initialize(void) if ((ddeServiceGlobal == 0) && (nameFound != 0)) { ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); - ddeServiceGlobal = DdeCreateStringHandleA(ddeInstance, + ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { @@ -263,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 */ @@ -276,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); @@ -314,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) { @@ -335,7 +342,7 @@ DdeSetServerName( &srvPtrPtr); } if (r != TCL_OK) { - OutputDebugStringA(Tcl_GetStringResult(interp)); + OutputDebugString(Tcl_GetStringResult(interp)); return NULL; } @@ -355,7 +362,7 @@ DdeSetServerName( Tcl_DStringAppend(&dString, name, -1); Tcl_DStringAppend(&dString, " #", 2); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE); + Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE); actualName = Tcl_DStringValue(&dString); } sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); @@ -369,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; } @@ -385,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"); @@ -472,7 +479,7 @@ DeleteProc( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL; - searchPtr != NULL && searchPtr != riPtr; + (searchPtr != NULL) && (searchPtr != riPtr); prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) { /* * Empty loop body. @@ -552,7 +559,8 @@ ExecuteRemoteObject( returnPackagePtr = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result)); + Tcl_ListObjAppendElement(NULL, returnPackagePtr, + Tcl_NewIntObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); @@ -607,7 +615,7 @@ DdeServerProc( Tcl_DString dString; int len; DWORD dlen; - char *utilString; + TCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -621,16 +629,16 @@ DdeServerProc( * sure we have a valid topic. */ - len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); - DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (strcasecmp(utilString, riPtr->name) == 0) { + if (_tcsicmp(utilString, riPtr->name) == 0) { Tcl_DStringFree(&dString); return (HDDEDATA) TRUE; } @@ -646,15 +654,15 @@ DdeServerProc( * result to return in an XTYP_REQUEST. */ - len = DdeQueryStringA(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); Tcl_DStringInit(&dString); - Tcl_DStringSetLength(&dString, len); - utilString = Tcl_DStringValue(&dString); - DdeQueryStringA(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, - CP_WINANSI); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, + CP_WINUNICODE); for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (strcasecmp(riPtr->name, utilString) == 0) { + if (_tcsicmp(riPtr->name, utilString) == 0) { convPtr = ckalloc(sizeof(Conversation)); convPtr->nextPtr = tsdPtr->currentConversations; convPtr->returnPackagePtr = NULL; @@ -698,7 +706,7 @@ DdeServerProc( * execute. */ - if (uFmt != CF_TEXT) { + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { return (HDDEDATA) FALSE; } @@ -711,19 +719,25 @@ DdeServerProc( } if (convPtr != NULL) { - BYTE *returnString; + char *returnString; - len = DdeQueryStringA(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); - DdeQueryStringA(ddeInstance, ddeItem, utilString, (DWORD) len + 1, - CP_WINANSI); - if (strcasecmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { - returnString = (BYTE *) - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - ddeReturn = DdeCreateDataHandle(ddeInstance, returnString, - (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + CP_WINUNICODE); + if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + if (uFmt == CF_TEXT) { + returnString = + 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); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; @@ -732,11 +746,17 @@ DdeServerProc( convPtr->riPtr->interp, utilString, NULL, TCL_GLOBAL_ONLY); if (variableObjPtr != NULL) { - returnString = (BYTE *) Tcl_GetStringFromObj( - variableObjPtr, &len); + if (uFmt == CF_TEXT) { + returnString = Tcl_GetStringFromObj( + variableObjPtr, &len); + } else { + returnString = (char *) Tcl_GetUnicodeFromObj( + variableObjPtr, &len); + len = 2 * len + 1; + } ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, - CF_TEXT, 0); + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, + uFmt, 0); } else { ddeReturn = NULL; } @@ -765,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); @@ -818,10 +838,10 @@ DdeServerProc( len = dlen; for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; i++, riPtr = riPtr->nextPtr) { - returnPtr[i].hszSvc = DdeCreateStringHandleA(ddeInstance, - TCL_DDE_SERVICE_NAME, CP_WINANSI); - returnPtr[i].hszTopic = DdeCreateStringHandleA(ddeInstance, - riPtr->name, CP_WINANSI); + returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, + riPtr->name, CP_WINUNICODE); } returnPtr[i].hszSvc = NULL; returnPtr[i].hszTopic = NULL; @@ -879,14 +899,14 @@ 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; HCONV ddeConv; - ddeService = DdeCreateStringHandleA(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) name, 0); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -929,9 +949,9 @@ static int DdeCreateClient( struct DdeEnumServices *es) { - WNDCLASSEXA wc; - static const char *szDdeClientClassName = "TclEval client class"; - static const char *szDdeClientWindowName = "TclEval client window"; + WNDCLASSEX wc; + 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); @@ -943,8 +963,8 @@ DdeCreateClient( * Register and create the callback window. */ - RegisterClassExA(&wc); - es->hwnd = CreateWindowExA(0, szDdeClientClassName, szDdeClientWindowName, + RegisterClassEx(&wc); + es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName, WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } @@ -956,7 +976,6 @@ DdeClientWindowProc( WPARAM wParam, LPARAM lParam) /* (Potentially) our local handle */ { - switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; @@ -964,17 +983,16 @@ DdeClientWindowProc( (struct DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)es); + SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else - SetWindowLongA(hwnd, GWL_USERDATA, (long)es); + SetWindowLong(hwnd, GWL_USERDATA, (LONG) es); #endif return (LRESULT) 0L; } case WM_DDE_ACK: return DdeServicesOnAck(hwnd, wParam, lParam); - break; default: - return DefWindowProcA(hwnd, uMsg, wParam, lParam); + return DefWindowProc(hwnd, uMsg, wParam, lParam); } } @@ -988,12 +1006,12 @@ 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); #else - es = (struct DdeEnumServices *) GetWindowLongA(hwnd, GWL_USERDATA); + es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif if ((es->service == (ATOM)0 || es->service == service) @@ -1001,9 +1019,9 @@ DdeServicesOnAck( Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); - GlobalGetAtomNameA(service, sz, 255); + GlobalGetAtomName(service, sz, 255); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); - GlobalGetAtomNameA(topic, sz, 255); + GlobalGetAtomName(topic, sz, 255); Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); /* @@ -1030,7 +1048,7 @@ DdeServicesOnAck( * Tell the server we are no longer interested. */ - PostMessageA(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); + PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); return 0L; } @@ -1042,7 +1060,7 @@ DdeEnumWindowsCallback( DWORD_PTR dwResult = 0; struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; - SendMessageTimeoutA(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, + SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, &dwResult); return TRUE; @@ -1051,16 +1069,16 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const char *serviceName, - const char *topicName) + const TCHAR *serviceName, + const TCHAR *topicName) { struct DdeEnumServices es; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) - ? (ATOM)0 : GlobalAddAtomA(serviceName); - es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtomA(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); @@ -1147,12 +1165,11 @@ 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 */ { static const char *const ddeCommands[] = { "servername", "execute", "poke", "request", "services", "eval", - (char *) NULL - }; + (char *) NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL @@ -1176,8 +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; - char *string; + const TCHAR *serviceName = NULL, *topicName = NULL; + const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; @@ -1326,8 +1343,8 @@ DdeObjCmd( if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandleA(ddeInstance, (void *) serviceName, - CP_WINANSI); + ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, + CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { @@ -1335,8 +1352,8 @@ DdeObjCmd( if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandleA(ddeInstance, (void *) topicName, - CP_WINANSI); + ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, + CP_WINUNICODE); } } @@ -1415,8 +1432,8 @@ DdeObjCmd( result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString, - CP_WINANSI); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem, CF_TEXT, XTYP_REQUEST, 5000, NULL); @@ -1431,7 +1448,7 @@ DdeObjCmd( returnObjPtr = Tcl_NewByteArrayObj(dataString, (int) tmp); } else { - returnObjPtr = Tcl_NewStringObj((char*)dataString,-1); + returnObjPtr = Tcl_NewStringObj((char *)dataString, -1); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); @@ -1468,8 +1485,8 @@ DdeObjCmd( SetDdeError(interp); result = TCL_ERROR; } else { - ddeItem = DdeCreateStringHandleA(ddeInstance, (void *) itemString, - CP_WINANSI); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINUNICODE); if (ddeItem != NULL) { ddeData = DdeClientTransaction(dataString, (DWORD) length+1, hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); @@ -1515,7 +1532,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (strcasecmp(serviceName, riPtr->name) == 0) { + if (_tcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1608,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; @@ -1618,7 +1634,7 @@ DdeObjCmd( objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetStringFromObj(objPtr, &length); ddeItemData = DdeCreateDataHandle(ddeInstance, - (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); + (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); if (async) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, @@ -1630,8 +1646,8 @@ DdeObjCmd( 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { - ddeCookie = DdeCreateStringHandleA(ddeInstance, - TCL_DDE_EXECUTE_RESULT, CP_WINANSI); + ddeCookie = DdeCreateStringHandle(ddeInstance, + TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE); ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL); } @@ -1642,6 +1658,7 @@ DdeObjCmd( if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; + goto cleanup; } if (async == 0) { @@ -1658,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)); |