diff options
Diffstat (limited to 'win')
-rw-r--r-- | win/Makefile.in | 30 | ||||
-rw-r--r-- | win/coffbase.txt | 2 | ||||
-rw-r--r-- | win/makefile.vc | 54 | ||||
-rw-r--r-- | win/tclWinChan.c | 16 | ||||
-rw-r--r-- | win/tclWinDde.c | 90 | ||||
-rw-r--r-- | win/tclWinFCmd.c | 16 | ||||
-rw-r--r-- | win/tclWinFile.c | 12 | ||||
-rw-r--r-- | win/tclWinLoad.c | 34 | ||||
-rw-r--r-- | win/tclWinPipe.c | 58 | ||||
-rw-r--r-- | win/tclWinPort.h | 4 | ||||
-rw-r--r-- | win/tclWinReg.c | 86 | ||||
-rw-r--r-- | win/tclWinSerial.c | 143 | ||||
-rw-r--r-- | win/tclWinSock.c | 42 |
13 files changed, 318 insertions, 269 deletions
diff --git a/win/Makefile.in b/win/Makefile.in index bb9a830..84dcaf7 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -137,7 +137,7 @@ TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX} ZLIB_DLL_FILE = zlib1.dll SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ -STATIC_LIBRARIES = $(TCL_LIB_FILE) $(REG_LIB_FILE) $(DDE_LIB_FILE) +STATIC_LIBRARIES = $(TCL_LIB_FILE) TCLSH = tclsh$(VER)${EXESUFFIX} CAT32 = cat32$(EXEEXT) @@ -434,9 +434,9 @@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) @VC_MANIFEST_EMBED_DLL@ -${TCL_LIB_FILE}: ${TCL_OBJS} +${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} - @MAKE_LIB@ ${TCL_OBJS} + @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ # assume GNU make @@ -445,31 +445,11 @@ ${TCL_LIB_FILE}: ${TCL_OBJS} # targets have to depend on tcl<x>.lib, this ensures that linking of tcl<x>.dll # does not execute concurrently with the renaming and recompiling of tcl<x>.lib -${DDE_DLL_FILE}: ${DDE_OBJS} ${DDE_LIB_FILE} ${TCL_STUB_LIB_FILE} - @-$(RM) ${DDE_DLL_FILE} ${DDE_LIB_FILE}.sav - @-$(COPY) ${DDE_LIB_FILE} ${DDE_LIB_FILE}.sav +${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - @-$(RM) ${DDE_LIB_FILE} - @-$(COPY) ${DDE_LIB_FILE}.sav ${DDE_LIB_FILE} - @-$(RM) ${DDE_LIB_FILE}.sav -${DDE_LIB_FILE}: ${DDE_OBJS} - @$(RM) ${DDE_LIB_FILE} - @MAKE_LIB@ ${DDE_OBJS} - @POST_MAKE_LIB@ - -${REG_DLL_FILE}: ${REG_OBJS} ${REG_LIB_FILE} ${TCL_STUB_LIB_FILE} - @-$(RM) ${REG_DLL_FILE} ${REG_LIB_FILE}.sav - @-$(COPY) ${REG_LIB_FILE} ${REG_LIB_FILE}.sav +${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) - @-$(RM) ${REG_LIB_FILE} - @-$(COPY) ${REG_LIB_FILE}.sav ${REG_LIB_FILE} - @-$(RM) ${REG_LIB_FILE}.sav - -${REG_LIB_FILE}: ${REG_OBJS} - @$(RM) ${REG_LIB_FILE} - @MAKE_LIB@ ${REG_OBJS} - @POST_MAKE_LIB@ ${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} diff --git a/win/coffbase.txt b/win/coffbase.txt index 7d19420..bdf5506 100644 --- a/win/coffbase.txt +++ b/win/coffbase.txt @@ -24,6 +24,7 @@ blt 0x10680000 0x00080000 iocpsock 0x10700000 0x00080000 tls 0x10780000 0x00100000 winico 0x10880000 0x00010000 +sample 0x108B0000 0x00010000 tile 0x10900000 0x00080000 memchan 0x109D0000 0x00010000 tdom 0x109E0000 0x00080000 @@ -32,6 +33,7 @@ tkvideo 0x10B00000 0x00010000 tclsdl 0x10B20000 0x00080000 vqtcl 0x10C00000 0x00010000 tdbc 0x10C40000 0x00010000 +thread 0x10C80000 0x00020000 ; ; insert new packages here ; diff --git a/win/makefile.vc b/win/makefile.vc index 6c8a5e3..ba5b710 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -71,53 +71,57 @@ the build instructions. # Sets where to install Tcl from the built binaries. # C:\Progra~1\Tcl is assumed when not specified. # -# OPTS=static,msvcrt,staticpkg,nothreads,symbols,profile,loimpact,unchecked,pdbs,none +# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none # Sets special options for the core. The default is for none. # Any combination of the above may be used (comma separated). # 'none' will over-ride everything to nothing. # -# static = Builds a static library of the core instead of a -# dll. The shell will be static (and large), as well. -# msvcrt = Affects the static option only to switch it from +# loimpact = Adds a flag for how NT treats the heap to keep memory +# in use, low. This is said to impact alloc performance. +# msvcrt = Affects the static option only to switch it from # using libcmt(d) as the C runtime [by default] to # msvcrt(d). This is useful for static embedding # support. +# nothreads= Turns off full multithreading support. +# pdbs = Build detached symbols for release builds. +# profile = Adds profiling hooks. Map file is assumed. +# static = Builds a static library of the core instead of a +# dll. The static library will contain the dde and reg +# extensions. External applications who want to use +# this, need to link with the stub library as well as +# the static Tcl library.The shell will be static (and +# large), as well. # staticpkg = Affects the static option only to switch # tclshXX.exe to have the dde and reg extension linked # inside it. -# nothreads = Turns off full multithreading support. +# symbols = Debug build. Links to the debug C runtime, disables +# optimizations and creates pdb symbols files. # thrdalloc = Use the thread allocator (shared global free pool) # This is the default on threaded builds. # tclalloc = Use the old non-thread allocator -# symbols = Debug build. Links to the debug C runtime, disables -# optimizations and creates pdb symbols files. -# pdbs = Build detached symbols for release builds. -# profile = Adds profiling hooks. Map file is assumed. -# loimpact = Adds a flag for how NT treats the heap to keep memory -# in use, low. This is said to impact alloc performance. -# unchecked = Allows a symbols build to not use the debug +# unchecked= Allows a symbols build to not use the debug # enabled runtime (msvcrt.dll not msvcrtd.dll # or libcmt.lib not libcmtd.lib). # -# STATS=memdbg,compdbg,none +# STATS=compdbg,memdbg,none # Sets optional memory and bytecode compiler debugging code added # to the core. The default is for none. Any combination of the # above may be used (comma separated). 'none' will over-ride # everything to nothing. # -# memdbg = Enables the debugging memory allocator. # compdbg = Enables byte compilation logging. +# memdbg = Enables the debugging memory allocator. # -# CHECKS=nodep,fullwarn,64bit,none +# CHECKS=64bit,fullwarn,nodep,none # Sets special macros for checking compatability. # -# nodep = Turns off compatability macros to ensure the core -# isn't being built with deprecated functions. +# 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. -# 64bit = Enable 64bit portability warnings (if available) +# nodep = Turns off compatability macros to ensure the core +# isn't being built with deprecated functions. # -# MACHINE=(IX86|IA64|AMD64|ALPHA) +# MACHINE=(ALPHA|AMD64|IA64|IX86) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default @@ -179,7 +183,7 @@ Please `cd` to its location first. !error $(MSG) !endif -PROJECT = tcl +PROJECT = tcl !include "rules.vc" STUBPREFIX = $(PROJECT)stub @@ -232,10 +236,12 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include TCLSHOBJS = \ $(TMP_DIR)\tclAppInit.obj \ +!if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif +!endif $(TMP_DIR)\tclsh.res TCLTESTOBJS = \ @@ -244,10 +250,12 @@ TCLTESTOBJS = \ $(TMP_DIR)\tclTestProcBodyObj.obj \ $(TMP_DIR)\tclThreadTest.obj \ $(TMP_DIR)\tclWinTest.obj \ +!if !$(STATIC_BUILD) !if $(TCL_USE_STATIC_PACKAGES) $(TMP_DIR)\tclWinReg.obj \ $(TMP_DIR)\tclWinDde.obj \ !endif +!endif $(TMP_DIR)\testMain.obj COREOBJS = \ @@ -429,11 +437,13 @@ PLATFORMOBJS = \ $(TMP_DIR)\tclWinSock.obj \ $(TMP_DIR)\tclWinThrd.obj \ $(TMP_DIR)\tclWinTime.obj \ -!if !$(STATIC_BUILD) +!if $(STATIC_BUILD) + $(TMP_DIR)\tclWinReg.obj \ + $(TMP_DIR)\tclWinDde.obj \ +!else $(TMP_DIR)\tcl.res !endif - TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 517aa20..52b9e32 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -940,8 +940,9 @@ TclpOpenFileChannel( } TclWinConvertError(err); if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), - "\": ", Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open \"%s\": %s", + TclGetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } @@ -959,9 +960,9 @@ TclpOpenFileChannel( if (handle == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't reopen serial \"", - TclGetString(pathPtr), "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't reopen serial \"%s\": %s", + TclGetString(pathPtr), Tcl_PosixError(interp))); } return NULL; } @@ -995,8 +996,9 @@ TclpOpenFileChannel( */ channel = NULL; - Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), - "\": bad file type", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open \"%s\": bad file type", + TclGetString(pathPtr))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE", NULL); break; diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 183fe02..23b3a8e 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -17,7 +17,13 @@ #include <dde.h> #include <ddeml.h> -#ifndef UNICODE +#ifdef UNICODE +# if !defined(NDEBUG) + /* test POKE server Implemented for UNICODE in debug mode only */ +# undef CBF_FAIL_POKES +# define CBF_FAIL_POKES 0 +# endif +#else # undef CP_WINUNICODE # define CP_WINUNICODE CP_WINANSI # undef Tcl_WinTCharToUtf @@ -157,7 +163,8 @@ Dde_Init( #ifdef UNICODE if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) { - Tcl_AppendResult(interp, "Win32s and Windows 9x are not supported platforms", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Win32s and Windows 9x are not supported platforms", -1)); return TCL_ERROR; } #endif @@ -785,6 +792,53 @@ DdeServerProc( } return ddeReturn; +#if !CBF_FAIL_POKES + case XTYP_POKE: + /* + * This is a poke for a Tcl variable, only implemented in + * debug/UNICODE mode. + */ + ddeReturn = DDE_FNOTPROCESSED; + + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { + return ddeReturn; + } + + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { + /* + * Empty loop body. + */ + } + + if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) { + Tcl_DString ds; + Tcl_Obj *variableObjPtr; + + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + Tcl_DStringInit(&dString); + Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1); + utilString = (TCHAR *) Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + CP_WINUNICODE); + Tcl_WinTCharToUtf(utilString, -1, &ds); + utilString = (TCHAR *) DdeAccessData(hData, &dlen); + if (uFmt == CF_TEXT) { + variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); + } else { + variableObjPtr = Tcl_NewUnicodeObj(utilString, -1); + } + + Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, + variableObjPtr, TCL_GLOBAL_ONLY); + + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dString); + ddeReturn = (HDDEDATA) DDE_FACK; + } + return ddeReturn; + +#endif case XTYP_EXECUTE: { /* * Execute this script. The results will be saved into a list object @@ -947,8 +1001,12 @@ MakeDdeConnection( if (ddeConv == (HCONV) NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "no registered server named \"", - name, "\"", NULL); + Tcl_DString dString; + + Tcl_WinTCharToUtf(name, -1, &dString); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no registered server named \"%s\"", Tcl_DStringValue(&dString))); + Tcl_DStringFree(&dString); Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); } return TCL_ERROR; @@ -1424,7 +1482,11 @@ DdeObjCmd( serviceName = DdeSetServerName(interp, serviceName, flags, handlerPtr); if (serviceName != NULL) { +#ifdef UNICODE Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1)); +#else + Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); +#endif } else { Tcl_ResetResult(interp); } @@ -1483,8 +1545,13 @@ DdeObjCmd( break; } case DDE_REQUEST: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], + &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); +#endif if (length == 0) { Tcl_SetObjResult(interp, @@ -1537,8 +1604,13 @@ DdeObjCmd( break; } case DDE_POKE: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); +#endif BYTE *dataString; if (length == 0) { @@ -1638,9 +1710,9 @@ DdeObjCmd( */ if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { - Tcl_SetResult(riPtr->interp, "permission denied: " - "a handler procedure must be defined for use in " - "a safe interp", TCL_STATIC); + Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( + "permission denied: a handler procedure must be" + " defined for use in a safe interp", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", NULL); result = TCL_ERROR; diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 77a5b82..80fad3e 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1530,8 +1530,8 @@ StatError( * error. */ { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName), - "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", + TclGetString(fileName), Tcl_PosixError(interp))); } /* @@ -1649,9 +1649,9 @@ ConvertFileNameFormat( if (splitPath == NULL || pathc == 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(fileName), "\": no such file or directory", - (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not read \"%s\": no such file or directory", + Tcl_GetString(fileName))); errno = ENOENT; Tcl_PosixError(interp); } @@ -1941,9 +1941,9 @@ CannotSetAttribute( Tcl_Obj *fileName, /* The name of the file. */ Tcl_Obj *attributePtr) /* The new value of the attribute. */ { - Tcl_AppendResult(interp, "cannot set attribute \"", - tclpFileAttrStrings[objIndex], "\" for file \"", - Tcl_GetString(fileName), "\": attribute is readonly", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", + tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); errno = EINVAL; Tcl_PosixError(interp); return TCL_ERROR; diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 1f56060..a44a257 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1048,10 +1048,9 @@ TclpMatchInDirectory( TclWinConvertError(err); if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't read directory \"", - Tcl_DStringValue(&dsOrig), "\": ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read directory \"%s\": %s", + Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp))); } Tcl_DStringFree(&dsOrig); return TCL_ERROR; @@ -1866,8 +1865,9 @@ TclpGetCwd( if (GetCurrentDirectory(MAX_PATH, buffer) == 0) { TclWinConvertError(GetLastError()); if (interp != NULL) { - Tcl_AppendResult(interp, "error getting working directory name: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error getting working directory name: %s", + Tcl_PosixError(interp))); } return NULL; } diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index b59ccba..6294086 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -91,9 +91,8 @@ TclpDlopen( if (hInstance == NULL) { DWORD lastError = GetLastError(); - - Tcl_AppendResult(interp, "couldn't load library \"", - Tcl_GetString(pathPtr), "\": ", NULL); + Tcl_Obj *errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", + Tcl_GetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, @@ -109,29 +108,30 @@ TclpDlopen( case ERROR_DLL_NOT_FOUND: Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL); notFoundMsg: - Tcl_AppendResult(interp, "this library or a dependent library" - " could not be found in library path", NULL); + Tcl_AppendToObj(errMsg, "this library or a dependent library" + " could not be found in library path", -1); break; case ERROR_PROC_NOT_FOUND: Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL); - Tcl_AppendResult(interp, "A function specified in the import" - " table could not be resolved by the system. Windows" - " is not telling which one, I'm sorry.", NULL); + Tcl_AppendToObj(errMsg, "A function specified in the import" + " table could not be resolved by the system. Windows" + " is not telling which one, I'm sorry.", -1); break; case ERROR_INVALID_DLL: Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL); - Tcl_AppendResult(interp, "this library or a dependent library" - " is damaged", NULL); + Tcl_AppendToObj(errMsg, "this library or a dependent library" + " is damaged", -1); break; case ERROR_DLL_INIT_FAILED: Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL); - Tcl_AppendResult(interp, "the library initialization" - " routine failed", NULL); + Tcl_AppendToObj(errMsg, "the library initialization" + " routine failed", -1); break; default: TclWinConvertError(lastError); - Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); + Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1); } + Tcl_SetObjResult(interp, errMsg); return TCL_ERROR; } @@ -190,7 +190,8 @@ FindSymbol( Tcl_DStringFree(&ds); } if (proc == NULL && interp != NULL) { - Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot find symbol \"%s\"", symbol)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL); } return proc; @@ -286,8 +287,9 @@ TclpTempFileNameForLibrary( Tcl_MutexLock(&dllDirectoryNameMutex); if (dllDirectoryName == NULL) { if (InitDLLDirectoryName() == TCL_ERROR) { - Tcl_AppendResult(interp, "couldn't create temporary directory: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't create temporary directory: %s", + Tcl_PosixError(interp))); Tcl_MutexUnlock(&dllDirectoryNameMutex); return NULL; } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index f36f797..36ae58a 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1030,8 +1030,9 @@ TclpCreateProcess( } if (startInfo.hStdInput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't duplicate input handle: ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't duplicate input handle: %s", + Tcl_PosixError(interp))); goto end; } @@ -1065,8 +1066,9 @@ TclpCreateProcess( } if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't duplicate output handle: ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't duplicate output handle: %s", + Tcl_PosixError(interp))); goto end; } @@ -1084,8 +1086,9 @@ TclpCreateProcess( } if (startInfo.hStdError == INVALID_HANDLE_VALUE) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't duplicate error handle: ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't duplicate error handle: %s", + Tcl_PosixError(interp))); goto end; } @@ -1129,9 +1132,9 @@ TclpCreateProcess( } if (applType == APPL_DOS) { - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "DOS application process not supported on this platform", - (char *) NULL); + -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP", NULL); goto end; @@ -1158,12 +1161,12 @@ TclpCreateProcess( BuildCommandLine(execPath, argc, argv, &cmdLine); - if (CreateProcess(NULL, - (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, - (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) { + if (CreateProcess(NULL, (TCHAR *) Tcl_DStringValue(&cmdLine), + NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo, + &procInfo) == 0) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't execute \"", argv[0], - "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", + argv[0], Tcl_PosixError(interp))); goto end; } @@ -1409,8 +1412,8 @@ ApplicationType( if (applType == APPL_NONE) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "couldn't execute \"", originalName, - "\": ", Tcl_PosixError(interp), (char *) NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s", + originalName, Tcl_PosixError(interp))); return APPL_NONE; } @@ -1673,8 +1676,8 @@ Tcl_CreatePipe( if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "pipe creation failed: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "pipe creation failed: %s", Tcl_PosixError(interp))); return TCL_ERROR; } @@ -1711,8 +1714,8 @@ TclGetAndDetachPids( { PipeInfo *pipePtr; const Tcl_ChannelType *chanTypePtr; + Tcl_Obj *pidsObj; int i; - char buf[TCL_INTEGER_SPACE]; /* * Punt if the channel is not a command channel. @@ -1723,12 +1726,15 @@ TclGetAndDetachPids( return; } - pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); + pipePtr = Tcl_GetChannelInstanceData(chan); + TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { - wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); - Tcl_AppendElement(interp, buf); - Tcl_DetachPids(1, &(pipePtr->pidPtr[i])); + Tcl_ListObjAppendElement(NULL, pidsObj, + Tcl_NewWideIntObj((unsigned) + TclpGetPid(pipePtr->pidPtr[i]))); + Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } + Tcl_SetObjResult(interp, pidsObj); if (pipePtr->numPids > 0) { ckfree(pipePtr->pidPtr); pipePtr->numPids = 0; @@ -2642,15 +2648,13 @@ Tcl_PidObjCmd( PipeInfo *pipePtr; int i; Tcl_Obj *resultPtr; - char buf[TCL_INTEGER_SPACE]; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); return TCL_ERROR; } if (objc == 1) { - wsprintfA(buf, "%lu", (unsigned long) getpid()); - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid())); } else { chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); @@ -2665,9 +2669,9 @@ Tcl_PidObjCmd( pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan); resultPtr = Tcl_NewObj(); for (i = 0; i < pipePtr->numPids; i++) { - wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i])); Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr, - Tcl_NewStringObj(buf, -1)); + Tcl_NewWideIntObj((unsigned) + TclpGetPid(pipePtr->pidPtr[i]))); } Tcl_SetObjResult(interp, resultPtr); } diff --git a/win/tclWinPort.h b/win/tclWinPort.h index c262671..c6ac2b7 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -14,8 +14,8 @@ #ifndef _TCLWINPORT #define _TCLWINPORT -#ifndef _WIN64 -/* See [Bug 2935503]: file mtime sets wrong time */ +#if !defined(_WIN64) && defined(BUILD_tcl) +/* See [Bug 3354324]: file mtime sets wrong time */ # define _USE_32BIT_TIME_T #endif diff --git a/win/tclWinReg.c b/win/tclWinReg.c index d2f233e..6ac5caf 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -13,9 +13,9 @@ */ #undef STATIC_BUILD -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif +#undef USE_TCL_STUBS +#define USE_TCL_STUBS + #include "tclInt.h" #ifdef _MSC_VER # pragma comment (lib, "advapi32.lib") @@ -24,20 +24,20 @@ #ifndef UNICODE # undef Tcl_WinTCharToUtf -# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) # undef Tcl_WinUtfToTChar -# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) -#endif +# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +#endif /* !UNICODE */ /* * Ensure that we can say which registry is being accessed. */ #ifndef KEY_WOW64_64KEY -#define KEY_WOW64_64KEY (0x0100) +# define KEY_WOW64_64KEY (0x0100) #endif #ifndef KEY_WOW64_32KEY -#define KEY_WOW64_32KEY (0x0200) +# define KEY_WOW64_32KEY (0x0200) #endif /* @@ -45,7 +45,7 @@ */ #ifndef MAX_KEY_LENGTH -#define MAX_KEY_LENGTH 256 +# define MAX_KEY_LENGTH 256 #endif /* @@ -58,14 +58,6 @@ #define TCL_STORAGE_CLASS DLLEXPORT /* - * The maximum length of a sub-key name. - */ - -#ifndef MAX_KEY_LENGTH -#define MAX_KEY_LENGTH 256 -#endif - -/* * The following macros convert between different endian ints. */ @@ -173,7 +165,7 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } @@ -535,9 +527,9 @@ DeleteValue( result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to delete value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to delete value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -575,7 +567,8 @@ GetKeyNames( { const char *pattern; /* Pattern being matched against subkeys */ HKEY key; /* Handle to the key being examined */ - TCHAR buffer[MAX_KEY_LENGTH]; /* Buffer to hold the subkey name */ + TCHAR buffer[MAX_KEY_LENGTH]; + /* Buffer to hold the subkey name */ DWORD bufSize; /* Size of the buffer */ DWORD index; /* Position of the current subkey */ char *name; /* Subkey name */ @@ -611,9 +604,9 @@ GetKeyNames( if (result == ERROR_NO_MORE_ITEMS) { result = TCL_OK; } else { - Tcl_SetObjResult(interp, Tcl_NewObj()); - Tcl_AppendResult(interp, "unable to enumerate subkeys of \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to enumerate subkeys of \"%s\": ", + Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); result = TCL_ERROR; } @@ -694,9 +687,9 @@ GetType( RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to get type of value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to get type of value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); return TCL_ERROR; } @@ -788,9 +781,9 @@ GetValue( Tcl_DStringFree(&buf); RegCloseKey(key); if (result != ERROR_SUCCESS) { - Tcl_AppendResult(interp, "unable to get value \"", - Tcl_GetString(valueNameObj), "\" from key \"", - Tcl_GetString(keyNameObj), "\": ", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to get value \"%s\" from key \"%s\": ", + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -817,16 +810,16 @@ GetValue( * we get bogus data. */ - while ((p < end) - && (*((Tcl_UniChar *) p)) != 0) { + while ((p < end) && *((Tcl_UniChar *) p) != 0) { Tcl_UniChar *up; + Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); up = (Tcl_UniChar *) p; - while (*up++ != 0) {} + while (*up++ != 0) {/* empty body */} p = (char *) up; Tcl_DStringFree(&buf); } @@ -1111,8 +1104,8 @@ ParseKeyName( rootName = name; } if (!rootName) { - Tcl_AppendResult(interp, "bad key \"", name, - "\": must start with a valid root", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad key \"%s\": must start with a valid root", name)); Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL); return TCL_ERROR; } @@ -1226,8 +1219,8 @@ RecursiveDeleteKey( } break; } else if (result == ERROR_SUCCESS) { - result = RecursiveDeleteKey(hKey, (const TCHAR *) Tcl_DStringValue(&subkey), - mode); + result = RecursiveDeleteKey(hKey, + (const TCHAR *) Tcl_DStringValue(&subkey), mode); } } Tcl_DStringFree(&subkey); @@ -1294,8 +1287,8 @@ SetValue( return TCL_ERROR; } - value = ConvertDWORD((DWORD)type, (DWORD)value); - result = RegSetValueEx(key, (TCHAR *)valueName, 0, + value = ConvertDWORD((DWORD) type, (DWORD) value); + result = RegSetValueEx(key, (TCHAR *) valueName, 0, (DWORD) type, (BYTE *) &value, sizeof(DWORD)); } else if (type == REG_MULTI_SZ) { Tcl_DString data, buf; @@ -1329,7 +1322,7 @@ SetValue( Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); - result = RegSetValueEx(key, (TCHAR *)valueName, 0, + result = RegSetValueEx(key, (TCHAR *) valueName, 0, (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); @@ -1338,7 +1331,7 @@ SetValue( Tcl_DString buf; const char *data = Tcl_GetStringFromObj(dataObj, &length); - data = (char *)Tcl_WinUtfToTChar(data, length, &buf); + data = (char *) Tcl_WinUtfToTChar(data, length, &buf); /* * Include the null in the length, padding if needed for Unicode. @@ -1347,7 +1340,7 @@ SetValue( Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); length = Tcl_DStringLength(&buf) + 1; - result = RegSetValueEx(key, (TCHAR *)valueName, 0, + result = RegSetValueEx(key, (TCHAR *) valueName, 0, (DWORD) type, (BYTE *) data, (DWORD) length); Tcl_DStringFree(&buf); } else { @@ -1358,7 +1351,7 @@ SetValue( */ data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); - result = RegSetValueEx(key, (TCHAR *)valueName, 0, + result = RegSetValueEx(key, (TCHAR *) valueName, 0, (DWORD) type, data, (DWORD) length); } @@ -1529,14 +1522,15 @@ ConvertDWORD( DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */ DWORD value) /* The value to be converted. */ { - DWORD order = 1; + const DWORD order = 1; DWORD localType; /* * Check to see if the low bit is in the first byte. */ - localType = (*((char *) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; + localType = (*((const char *) &order) == 1) + ? REG_DWORD : REG_DWORD_BIG_ENDIAN; return (type != localType) ? (DWORD) SWAPLONG(value) : value; } diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 58a9eb4..9e9d1af 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1673,12 +1673,7 @@ SerialSetOptionProc( if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't get comm state: ", - Tcl_PosixError(interp), NULL); - } - return TCL_ERROR; + goto getStateFailed; } native = Tcl_WinUtfToTChar(value, -1, &ds); result = BuildCommDCB(native, &dcb); @@ -1686,8 +1681,9 @@ SerialSetOptionProc( if (result == FALSE) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad value \"", value, - "\" for -mode: should be baud,parity,data,stop", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad value \"%s\" for -mode: should be baud,parity,data,stop", + value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); } return TCL_ERROR; @@ -1703,12 +1699,7 @@ SerialSetOptionProc( dcb.fAbortOnError = FALSE; if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't set comm state: ", - Tcl_PosixError(interp), NULL); - } - return TCL_ERROR; + goto setStateFailed; } return TCL_OK; } @@ -1719,12 +1710,7 @@ SerialSetOptionProc( if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't get comm state: ", - Tcl_PosixError(interp), NULL); - } - return TCL_ERROR; + goto getStateFailed; } /* @@ -1759,21 +1745,16 @@ SerialSetOptionProc( dcb.fDtrControl = DTR_CONTROL_HANDSHAKE; } else { if (interp != NULL) { - Tcl_AppendResult(interp, "bad value \"", value, - "\" for -handshake: must be one of xonxoff, rtscts, " - "dtrdsr or none", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad value \"%s\" for -handshake: must be one of" + " xonxoff, rtscts, dtrdsr or none", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL); } return TCL_ERROR; } if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't set comm state: ", - Tcl_PosixError(interp), NULL); - } - return TCL_ERROR; + goto setStateFailed; } return TCL_OK; } @@ -1784,12 +1765,7 @@ SerialSetOptionProc( if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) { if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't get comm state: ", - Tcl_PosixError(interp), NULL); - } - return TCL_ERROR; + goto getStateFailed; } if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) { @@ -1798,9 +1774,9 @@ SerialSetOptionProc( if (argc != 2) { badXchar: if (interp != NULL) { - Tcl_AppendResult(interp, "bad value for -xchar: should be " - "a list of two elements with each a single character", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "bad value for -xchar: should be a list of" + " two elements with each a single character", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL); } ckfree(argv); @@ -1837,12 +1813,7 @@ SerialSetOptionProc( ckfree(argv); if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't set comm state: ", - Tcl_PosixError(interp), NULL); - } - return TCL_ERROR; + goto setStateFailed; } return TCL_OK; } @@ -1859,9 +1830,9 @@ SerialSetOptionProc( } if ((argc % 2) == 1) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad value \"", value, - "\" for -ttycontrol: should be a list of " - "signal,value pairs", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad value \"%s\" for -ttycontrol: should be " + "a list of signal,value pairs", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL); } ckfree(argv); @@ -1877,7 +1848,8 @@ SerialSetOptionProc( if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETDTR : CLRDTR))) { if (interp != NULL) { - Tcl_AppendResult(interp, "can't set DTR signal", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't set DTR signal", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", NULL); } @@ -1888,7 +1860,8 @@ SerialSetOptionProc( if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETRTS : CLRRTS))) { if (interp != NULL) { - Tcl_AppendResult(interp, "can't set RTS signal", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't set RTS signal", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", NULL); } @@ -1899,7 +1872,8 @@ SerialSetOptionProc( if (!EscapeCommFunction(infoPtr->handle, (DWORD) (flag ? SETBREAK : CLRBREAK))) { if (interp != NULL) { - Tcl_AppendResult(interp,"can't set BREAK signal",NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't set BREAK signal", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "TTY_SIGNAL", NULL); } @@ -1908,9 +1882,9 @@ SerialSetOptionProc( } } else { if (interp != NULL) { - Tcl_AppendResult(interp, "bad signal name \"", argv[i], - "\" for -ttycontrol: must be DTR, RTS or BREAK", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad signal name \"%s\" for -ttycontrol: must be" + " DTR, RTS or BREAK", argv[i])); Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL", NULL); } @@ -1949,9 +1923,9 @@ SerialSetOptionProc( if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) { if (interp != NULL) { - Tcl_AppendResult(interp, "bad value \"", value, - "\" for -sysbuffer: should be a list of one or two " - "integers > 0", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad value \"%s\" for -sysbuffer: should be " + "a list of one or two integers > 0", value)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL); } return TCL_ERROR; @@ -1960,8 +1934,9 @@ SerialSetOptionProc( if (!SetupComm(infoPtr->handle, inSize, outSize)) { if (interp != NULL) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't setup comm buffers: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't setup comm buffers: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -1974,22 +1949,12 @@ SerialSetOptionProc( */ if (!GetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't get comm state: ", - Tcl_PosixError(interp), NULL); - } - return TCL_ERROR; + goto getStateFailed; } dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2); dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4); if (!SetCommState(infoPtr->handle, &dcb)) { - if (interp != NULL) { - TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't set comm state: ", - Tcl_PosixError(interp), NULL); - } - return TCL_ERROR; + goto setStateFailed; } return TCL_OK; } @@ -2020,8 +1985,9 @@ SerialSetOptionProc( if (!SetCommTimeouts(infoPtr->handle, &tout)) { if (interp != NULL) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't set comm timeouts: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set comm timeouts: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2031,6 +1997,22 @@ SerialSetOptionProc( return Tcl_BadChannelOption(interp, optionName, "mode handshake pollinterval sysbuffer timeout ttycontrol xchar"); + + getStateFailed: + if (interp != NULL) { + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get comm state: %s", Tcl_PosixError(interp))); + } + return TCL_ERROR; + + setStateFailed: + if (interp != NULL) { + TclWinConvertError(GetLastError()); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't set comm state: %s", Tcl_PosixError(interp))); + } + return TCL_ERROR; } /* @@ -2089,8 +2071,8 @@ SerialGetOptionProc( if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't get comm state: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get comm state: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2159,8 +2141,8 @@ SerialGetOptionProc( if (!GetCommState(infoPtr->handle, &dcb)) { if (interp != NULL) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't get comm state: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get comm state: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2237,8 +2219,8 @@ SerialGetOptionProc( if (!GetCommModemStatus(infoPtr->handle, &status)) { if (interp != NULL) { TclWinConvertError(GetLastError()); - Tcl_AppendResult(interp, "can't get tty status: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get tty status: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2248,10 +2230,9 @@ SerialGetOptionProc( if (valid) { return TCL_OK; - } else { - return Tcl_BadChannelOption(interp, optionName, - "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } + return Tcl_BadChannelOption(interp, optionName, + "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); } /* diff --git a/win/tclWinSock.c b/win/tclWinSock.c index c651deb..9f7caee 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -558,8 +558,8 @@ TclpHasSockets( return TCL_OK; } if (interp != NULL) { - Tcl_AppendResult(interp, "sockets are not available on this system", - NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "sockets are not available on this system", -1)); } return TCL_ERROR; } @@ -991,8 +991,8 @@ TcpClose2Proc( break; default: if (interp) { - Tcl_AppendResult(interp, - "Socket close2proc called bidirectionally", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "Socket close2proc called bidirectionally", -1)); } return TCL_ERROR; } @@ -1380,12 +1380,9 @@ CreateSocket( } if (interp != NULL) { - Tcl_AppendResult(interp, "couldn't open socket: ", NULL); - if (errorMsg == NULL) { - Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL); - } else { - Tcl_AppendResult(interp, errorMsg, NULL); - } + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", + (errorMsg ? errorMsg : Tcl_PosixError(interp)))); } if (sock != INVALID_SOCKET) { @@ -1992,7 +1989,8 @@ TcpSetOptionProc( if (!SocketsEnabled()) { if (interp) { - Tcl_AppendResult(interp, "winsock is not initialized", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "winsock is not initialized", -1)); } return TCL_ERROR; } @@ -2016,8 +2014,9 @@ TcpSetOptionProc( if (rtn != 0) { TclWinConvertError(WSAGetLastError()); if (interp) { - Tcl_AppendResult(interp, "couldn't set socket option: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't set socket option: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2037,8 +2036,9 @@ TcpSetOptionProc( if (rtn != 0) { TclWinConvertError(WSAGetLastError()); if (interp) { - Tcl_AppendResult(interp, "couldn't set socket option: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't set socket option: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2096,7 +2096,8 @@ TcpGetOptionProc( if (!SocketsEnabled()) { if (interp) { - Tcl_AppendResult(interp, "winsock is not initialized", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "winsock is not initialized", -1)); } return TCL_ERROR; } @@ -2163,8 +2164,9 @@ TcpGetOptionProc( if (len) { TclWinConvertError((DWORD) WSAGetLastError()); if (interp) { - Tcl_AppendResult(interp, "can't get peername: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get peername: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } @@ -2228,8 +2230,8 @@ TcpGetOptionProc( } else { if (interp) { TclWinConvertError((DWORD) WSAGetLastError()); - Tcl_AppendResult(interp, "can't get sockname: ", - Tcl_PosixError(interp), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't get sockname: %s", Tcl_PosixError(interp))); } return TCL_ERROR; } |