diff options
| -rw-r--r-- | generic/tclCmdIL.c | 11 | ||||
| -rw-r--r-- | generic/tclEncoding.c | 13 | ||||
| -rw-r--r-- | generic/tclEvent.c | 7 | ||||
| -rw-r--r-- | generic/tclInt.decls | 11 | ||||
| -rw-r--r-- | generic/tclInt.h | 7 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 33 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 5 | ||||
| -rw-r--r-- | generic/tclUtil.c | 163 | ||||
| -rw-r--r-- | unix/tclUnixFile.c | 42 | ||||
| -rw-r--r-- | unix/tclUnixTest.c | 27 | ||||
| -rw-r--r-- | win/tclWinFile.c | 29 | ||||
| -rw-r--r-- | win/tclWinPipe.c | 8 |
12 files changed, 163 insertions, 193 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 660ceb5..cfff082 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.69 2004/11/24 19:28:41 dgp Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.70 2004/12/01 23:18:49 dgp Exp $ */ #include "tclInt.h" @@ -1499,18 +1499,11 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - CONST char *nameOfExecutable; - if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - - nameOfExecutable = Tcl_GetNameOfExecutable(); - - if (nameOfExecutable != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(nameOfExecutable, -1)); - } + Tcl_SetObjResult(interp, TclGetObjNameOfExecutable()); return TCL_OK; } diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 6932301..1d2c0b8 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEncoding.c,v 1.28 2004/12/01 21:58:59 dgp Exp $ + * RCS: @(#) $Id: tclEncoding.c,v 1.29 2004/12/01 23:18:50 dgp Exp $ */ #include "tclInt.h" @@ -301,7 +301,7 @@ TclSetEncodingSearchPath(searchPath) if (TCL_ERROR == Tcl_ListObjLength(NULL, searchPath, &dummy)) { return TCL_ERROR; } - TclSetProcessGlobalValue(&encodingSearchPath, searchPath); + TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL); FillEncodingFileMap(); return TCL_OK; } @@ -349,7 +349,7 @@ TclSetLibraryPath(path) if (TCL_ERROR == Tcl_ListObjLength(NULL, path, &dummy)) { return; } - TclSetProcessGlobalValue(&libraryPath, path); + TclSetProcessGlobalValue(&libraryPath, path, NULL); } /* @@ -446,7 +446,7 @@ void FillEncodingFileMap() { Tcl_Obj *map = MakeFileMap(); - TclSetProcessGlobalValue(&encodingFileMap, map); + TclSetProcessGlobalValue(&encodingFileMap, map, NULL); Tcl_DecrRefCount(map); } @@ -1291,9 +1291,8 @@ Tcl_UtfToExternal(interp, encoding, src, srcLen, flags, statePtr, dst, * None. * * Side effects: - * The variable tclNativeExecutableName gets filled in with the file - * name for the application, if we figured it out. If we couldn't - * figure it out, tclNativeExecutableName is set to NULL. + * The absolute pathname for the application is computed and stored + * to be returned later be [info nameofexecutable]. * *--------------------------------------------------------------------------- */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index f180f26..62a2f3b 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.53 2004/11/30 19:34:47 dgp Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.54 2004/12/01 23:18:50 dgp Exp $ */ #include "tclInt.h" @@ -898,11 +898,6 @@ Tcl_Finalize() */ TclFinalizeEncodingSubsystem(); - if (tclNativeExecutableName != NULL) { - ckfree(tclNativeExecutableName); - tclNativeExecutableName = NULL; - } - Tcl_SetPanicProc(NULL); /* diff --git a/generic/tclInt.decls b/generic/tclInt.decls index d6cdd1f..e497298 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.83 2004/11/30 19:34:48 dgp Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.84 2004/12/01 23:18:50 dgp Exp $ library tcl @@ -850,6 +850,15 @@ declare 210 generic { declare 211 generic { CONST char * TclpGetEncodingNameFromEnvironment(Tcl_DString *bufPtr) } +declare 212 generic { + void TclpFindExecutable(CONST char *argv0) +} +declare 213 generic { + Tcl_Obj * TclGetObjNameOfExecutable(void) +} +declare 214 generic { + void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding) +} ############################################################################## diff --git a/generic/tclInt.h b/generic/tclInt.h index 4510239..dbfe454 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.201 2004/11/30 19:34:48 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.202 2004/12/01 23:18:51 dgp Exp $ */ #ifndef _TCLINT @@ -1913,8 +1913,6 @@ MODULE_SCOPE int TclpThreadCreate _ANSI_ARGS_(( int stackSize, int flags)); MODULE_SCOPE void TclpFinalizeThreadDataKey _ANSI_ARGS_(( Tcl_ThreadDataKey *keyPtr)); -MODULE_SCOPE void TclpFindExecutable _ANSI_ARGS_(( - CONST char *argv0)); MODULE_SCOPE int TclpFindVariable _ANSI_ARGS_((CONST char *name, int *lengthPtr)); MODULE_SCOPE void TclpInitLibraryPath _ANSI_ARGS_((char **valuePtr, @@ -1987,7 +1985,8 @@ MODULE_SCOPE void TclRemoveScriptLimitCallbacks _ANSI_ARGS_(( MODULE_SCOPE void TclSetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *cmdPrefix)); MODULE_SCOPE void TclSetProcessGlobalValue _ANSI_ARGS_ (( - ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue)); + ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, + Tcl_Encoding encoding)); MODULE_SCOPE VOID TclSignalExitThread _ANSI_ARGS_((Tcl_ThreadId id, int result)); MODULE_SCOPE int TclSubstTokens _ANSI_ARGS_((Tcl_Interp *interp, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 69ddc6a..ed4b443 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.74 2004/11/30 19:34:49 dgp Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.75 2004/12/01 23:18:52 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -1102,6 +1102,22 @@ EXTERN int TclSetEncodingSearchPath _ANSI_ARGS_(( EXTERN CONST char * TclpGetEncodingNameFromEnvironment _ANSI_ARGS_(( Tcl_DString * bufPtr)); #endif +#ifndef TclpFindExecutable_TCL_DECLARED +#define TclpFindExecutable_TCL_DECLARED +/* 212 */ +EXTERN void TclpFindExecutable _ANSI_ARGS_((CONST char * argv0)); +#endif +#ifndef TclGetObjNameOfExecutable_TCL_DECLARED +#define TclGetObjNameOfExecutable_TCL_DECLARED +/* 213 */ +EXTERN Tcl_Obj * TclGetObjNameOfExecutable _ANSI_ARGS_((void)); +#endif +#ifndef TclSetObjNameOfExecutable_TCL_DECLARED +#define TclSetObjNameOfExecutable_TCL_DECLARED +/* 214 */ +EXTERN void TclSetObjNameOfExecutable _ANSI_ARGS_(( + Tcl_Obj * name, Tcl_Encoding encoding)); +#endif typedef struct TclIntStubs { int magic; @@ -1334,6 +1350,9 @@ typedef struct TclIntStubs { Tcl_Obj * (*tclGetEncodingSearchPath) _ANSI_ARGS_((void)); /* 209 */ int (*tclSetEncodingSearchPath) _ANSI_ARGS_((Tcl_Obj * searchPath)); /* 210 */ CONST char * (*tclpGetEncodingNameFromEnvironment) _ANSI_ARGS_((Tcl_DString * bufPtr)); /* 211 */ + void (*tclpFindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 212 */ + Tcl_Obj * (*tclGetObjNameOfExecutable) _ANSI_ARGS_((void)); /* 213 */ + void (*tclSetObjNameOfExecutable) _ANSI_ARGS_((Tcl_Obj * name, Tcl_Encoding encoding)); /* 214 */ } TclIntStubs; #ifdef __cplusplus @@ -2069,6 +2088,18 @@ extern TclIntStubs *tclIntStubsPtr; #define TclpGetEncodingNameFromEnvironment \ (tclIntStubsPtr->tclpGetEncodingNameFromEnvironment) /* 211 */ #endif +#ifndef TclpFindExecutable +#define TclpFindExecutable \ + (tclIntStubsPtr->tclpFindExecutable) /* 212 */ +#endif +#ifndef TclGetObjNameOfExecutable +#define TclGetObjNameOfExecutable \ + (tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */ +#endif +#ifndef TclSetObjNameOfExecutable +#define TclSetObjNameOfExecutable \ + (tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index c1c2dd0..83218f9 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.108 2004/11/30 19:34:49 dgp Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.109 2004/12/01 23:18:53 dgp Exp $ */ #include "tclInt.h" @@ -296,6 +296,9 @@ TclIntStubs tclIntStubs = { TclGetEncodingSearchPath, /* 209 */ TclSetEncodingSearchPath, /* 210 */ TclpGetEncodingNameFromEnvironment, /* 211 */ + TclpFindExecutable, /* 212 */ + TclGetObjNameOfExecutable, /* 213 */ + TclSetObjNameOfExecutable, /* 214 */ }; TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 9737c4a..7bf4b41 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,37 +11,16 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.49 2004/11/30 19:34:50 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.50 2004/12/01 23:18:54 dgp Exp $ */ #include "tclInt.h" /* - * The following variables hold the full path name of the binary - * from which this application was executed, or NULL if it isn't - * know. The values are set by the procedure Tcl_FindExecutable. - * Only the first call to Tcl_FindExecutable sets the value. That - * call also sets the "searchDone" flag, so that subsequent calls - * are no-ops. With that logic in place, no mutex protection is - * required. The storage space is dynamically allocated. The value - * is kept in the system encoding. + * The absolute pathname of the executable in which this Tcl library + * is running. */ - -char *tclNativeExecutableName = NULL; -int tclFindExecutableSearchDone = 0; - -/* - * A copy of the executable path name, converted to Tcl's internal - * encoding, UTF-8. Also keep a copy of what the system encoding - * was believed to be when the conversion was done, just in case - * it's changed on us. Because Tcl_GetNameOfExecutable() is in - * the public API, it might be called from any thread, so we need - * mutex protection here. - */ - -TCL_DECLARE_MUTEX(executableNameMutex) -static char *executableName = NULL; -static Tcl_Encoding conversionEncoding = NULL; +static ProcessGlobalValue executableName = {0, 0, NULL, NULL, NULL, NULL, NULL}; /* * The following values are used in the flags returned by Tcl_ScanElement @@ -90,7 +69,6 @@ TCL_DECLARE_MUTEX(precisionMutex) */ static void ClearHash _ANSI_ARGS_((Tcl_HashTable *tablePtr)); -static void FreeExecutableName _ANSI_ARGS_((ClientData)); static void FreeProcessGlobalValue _ANSI_ARGS_(( ClientData clientData)); static void FreeThreadHash _ANSI_ARGS_ ((ClientData clientData)); @@ -98,7 +76,6 @@ static Tcl_HashTable * GetThreadHash _ANSI_ARGS_ ((Tcl_ThreadDataKey *keyPtr)); static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* objPtr)); static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr)); -static Tcl_Obj * Tcl_GetObjNameOfExecutable(); /* * The following is the Tcl object type definition for an object @@ -2700,9 +2677,10 @@ FreeProcessGlobalValue(clientData) *---------------------------------------------------------------------- */ void -TclSetProcessGlobalValue(pgvPtr, newValue) +TclSetProcessGlobalValue(pgvPtr, newValue, encoding) ProcessGlobalValue *pgvPtr; Tcl_Obj *newValue; + Tcl_Encoding encoding; { CONST char *bytes; Tcl_HashTable *cacheMap; @@ -2722,8 +2700,8 @@ TclSetProcessGlobalValue(pgvPtr, newValue) strcpy(pgvPtr->value, bytes); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); - pgvPtr->encoding = NULL; } + pgvPtr->encoding = encoding; /* * Fill the local thread copy directly with the Tcl_Obj @@ -2820,88 +2798,91 @@ TclGetProcessGlobalValue(pgvPtr) /* *---------------------------------------------------------------------- * - * Tcl_GetNameOfExecutable -- - * - * This procedure simply returns a pointer to the internal full - * path name of the executable file as computed by - * Tcl_FindExecutable. This procedure call is the C API - * equivalent to the "info nameofexecutable" command. + * TclSetObjNameOfExecutable -- * - * TODO: Rework these routines to use a ProcessGlobalValue. + * This procedure stores the absolute pathname of + * the executable file (normally as computed by + * TclpFindExecutable). * * Results: - * A pointer to the internal string or NULL if the internal full - * path name has not been computed or unknown. + * None. * * Side effects: - * The object referenced by "objPtr" might be converted to an - * integer object. + * Stores the executable name. * *---------------------------------------------------------------------- */ -static void -FreeExecutableName(clientData) - ClientData clientData; +void +TclSetObjNameOfExecutable(name, encoding) + Tcl_Obj *name; + Tcl_Encoding encoding; { - Tcl_FreeEncoding(conversionEncoding); - conversionEncoding = NULL; - if (NULL != executableName) { - ckfree(executableName); - } - executableName = NULL; + TclSetProcessGlobalValue(&executableName, name, encoding); } + +/* + *---------------------------------------------------------------------- + * + * TclGetObjNameOfExecutable -- + * + * This procedure retrieves the absolute pathname of the + * application in which the Tcl library is running, usually + * as previously stored by TclpFindExecutable(). + * This procedure call is the C API equivalent to the + * "info nameofexecutable" command. + * + * Results: + * A pointer to an "fsPath" Tcl_Obj, or to an empty Tcl_Obj if + * the pathname of the application is unknown. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ -static Tcl_Obj * -Tcl_GetObjNameOfExecutable() +Tcl_Obj * +TclGetObjNameOfExecutable() { - Tcl_Obj *result; - - Tcl_MutexLock(&executableNameMutex); - if (NULL == conversionEncoding) { - /* First call (after free) */ - conversionEncoding = Tcl_GetEncoding(NULL, NULL); - Tcl_CreateExitHandler(FreeExecutableName, NULL); - } else { - /* Later call... */ - Tcl_Encoding systemEncoding = Tcl_GetEncoding(NULL, NULL); - if (systemEncoding != conversionEncoding) { - /* ...with system encoding changed */ - FreeExecutableName(NULL); - conversionEncoding = systemEncoding; - } else { - Tcl_FreeEncoding(systemEncoding); - } - } - if (NULL == tclNativeExecutableName) { - FreeExecutableName(NULL); - } else if (NULL == executableName) { - Tcl_DString ds; - Tcl_ExternalToUtfDString(conversionEncoding, - tclNativeExecutableName, -1, &ds); - executableName = (char *) - ckalloc ((unsigned) Tcl_DStringLength(&ds) + 1); - strcpy(executableName, Tcl_DStringValue(&ds)); - Tcl_DStringFree(&ds); - } - - if (NULL == executableName) { - result = Tcl_NewObj(); - } else { - result = Tcl_NewStringObj(executableName, -1); - } - Tcl_MutexUnlock(&executableNameMutex); - return result; + return TclGetProcessGlobalValue(&executableName); } + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetNameOfExecutable -- + * + * This procedure retrieves the absolute pathname of the + * application in which the Tcl library is running, and + * returns it in string form. + * + * The returned string belongs to Tcl and should be copied + * if the caller plans to keep it, to guard against it + * becoming invalid. + * + * Results: + * A pointer to the internal string or NULL if the internal full + * path name has not been computed or unknown. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ CONST char * Tcl_GetNameOfExecutable() { - Tcl_DecrRefCount(Tcl_GetObjNameOfExecutable()); - return executableName; + int numBytes; + CONST char * bytes = + Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes); + if (numBytes == 0) { + return NULL; + } + return bytes; } - /* *---------------------------------------------------------------------- * diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 421ea16..9ae8129 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFile.c,v 1.43 2004/11/30 19:34:51 dgp Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.44 2004/12/01 23:18:55 dgp Exp $ */ #include "tclInt.h" @@ -27,17 +27,10 @@ static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types); * application, given its argv[0] value. * * Results: - * A dirty UTF string that is the path to the executable. At this - * point we may not know the system encoding. Convert the native - * string value to UTF using the default encoding. The assumption - * is that we will still be able to parse the path given the path - * name contains ASCII string and '/' chars do not conflict with - * other UTF chars. + * None. * * Side effects: - * The variable tclNativeExecutableName gets filled in with the file - * name for the application, if we figured it out. If we couldn't - * figure it out, tclNativeExecutableName is set to NULL. + * The computed path name is stored as a ProcessGlobalValue. * *--------------------------------------------------------------------------- */ @@ -49,17 +42,12 @@ TclpFindExecutable(argv0) { CONST char *name, *p; Tcl_StatBuf statBuf; - int length; - Tcl_DString buffer, nameString, cwd; + Tcl_DString buffer, nameString, cwd, utfName; + Tcl_Encoding encoding; if (argv0 == NULL) { return; } - if (tclFindExecutableSearchDone) { - return; - } - tclFindExecutableSearchDone = 1; - Tcl_DStringInit(&buffer); name = argv0; @@ -132,10 +120,11 @@ TclpFindExecutable(argv0) p++; } } + TclSetObjNameOfExecutable(Tcl_NewObj(), NULL); goto done; /* - * If the name starts with "/" then just copy it to tclNativeExecutableName. + * If the name starts with "/" then just store it */ gotName: @@ -144,9 +133,11 @@ gotName: #else if (name[0] == '/') { #endif - tclNativeExecutableName = (char *) - ckalloc((unsigned int) strlen(name) + 1); - strcpy(tclNativeExecutableName, name); + encoding = Tcl_GetEncoding(NULL, NULL); + Tcl_ExternalToUtfDString(encoding, name, -1, &utfName); + TclSetObjNameOfExecutable( + Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); + Tcl_DStringFree(&utfName); goto done; } @@ -176,13 +167,14 @@ gotName: Tcl_DStringLength(&nameString)); Tcl_DStringFree(&nameString); - length = Tcl_DStringLength(&buffer) + 1; - tclNativeExecutableName = (char *) ckalloc((unsigned) length); - strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer)); + encoding = Tcl_GetEncoding(NULL, NULL); + Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1, &utfName); + TclSetObjNameOfExecutable( + Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding); + Tcl_DStringFree(&utfName); done: Tcl_DStringFree(&buffer); - Tcl_GetNameOfExecutable(); } /* diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 9b5c717..8cdf7c7 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixTest.c,v 1.19 2004/11/30 19:34:51 dgp Exp $ + * RCS: @(#) $Id: tclUnixTest.c,v 1.20 2004/12/01 23:18:55 dgp Exp $ */ #include "tclInt.h" @@ -426,7 +426,7 @@ TestfilewaitCmd(clientData, interp, argc, argv) * TestfindexecutableCmd -- * * This procedure implements the "testfindexecutable" command. It is - * used to test Tcl_FindExecutable. + * used to test TclpFindExecutable. * * Results: * A standard Tcl result. @@ -444,8 +444,7 @@ TestfindexecutableCmd(clientData, interp, argc, argv) int argc; /* Number of arguments. */ CONST char **argv; /* Argument strings. */ { - char *oldNativeName; - int oldDone; + Tcl_Obj *saveName; if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], @@ -453,22 +452,14 @@ TestfindexecutableCmd(clientData, interp, argc, argv) return TCL_ERROR; } - oldNativeName = tclNativeExecutableName; - oldDone = tclFindExecutableSearchDone; + saveName = TclGetObjNameOfExecutable(); + Tcl_IncrRefCount(saveName); - tclNativeExecutableName = NULL; - tclFindExecutableSearchDone = 0; - - Tcl_GetNameOfExecutable(); - Tcl_FindExecutable(argv[1]); - Tcl_SetResult(interp, (char *) Tcl_GetNameOfExecutable(), TCL_VOLATILE); - if (tclNativeExecutableName != NULL) { - ckfree(tclNativeExecutableName); - } - - tclNativeExecutableName = oldNativeName; - tclFindExecutableSearchDone = oldDone; + TclpFindExecutable(argv[1]); + Tcl_SetObjResult(interp, TclGetObjNameOfExecutable()); + TclSetObjNameOfExecutable(saveName, NULL); + Tcl_DecrRefCount(saveName); return TCL_OK; } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 8c39505..4e73891 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.71 2004/11/30 19:34:51 dgp Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.72 2004/12/01 23:18:55 dgp Exp $ */ //#define _WIN32_WINNT 0x0500 @@ -674,19 +674,13 @@ NativeWriteReparse(LinkDirectory, buffer) * TclpFindExecutable -- * * This procedure computes the absolute path name of the current - * application, given its argv[0] value. + * application. * * Results: - * A clean UTF string that is the path to the executable. At this - * point we may not know the system encoding, but we convert the - * string value to UTF-8 using core Windows functions. The path name - * contains ASCII string and '/' chars do not conflict with other UTF - * chars. + * None. * * Side effects: - * The variable tclNativeExecutableName gets filled in with the file - * name for the application, if we figured it out. If we couldn't - * figure it out, tclNativeExecutableName is set to NULL. + * The computed path is stored. * *--------------------------------------------------------------------------- */ @@ -698,14 +692,6 @@ TclpFindExecutable(argv0) { WCHAR wName[MAX_PATH]; char name[MAX_PATH * TCL_UTF_MAX]; - Tcl_DString ds; - - if (argv0 == NULL) { - return; - } - if (tclNativeExecutableName != NULL) { - return; - } /* * Under Windows we ignore argv0, and return the path for the file used to @@ -721,12 +707,7 @@ TclpFindExecutable(argv0) } WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL); TclWinNoBackslash(name); - - Tcl_UtfToExternalDString(NULL, name, -1, &ds); - tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1)); - strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds)); - Tcl_DStringFree(&ds); - Tcl_GetNameOfExecutable(); + TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL); } /* diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 4b18c02..2601e4f 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPipe.c,v 1.52 2004/11/30 19:34:52 dgp Exp $ + * RCS: @(#) $Id: tclWinPipe.c,v 1.53 2004/12/01 23:18:55 dgp Exp $ */ #include "tclWinInt.h" @@ -1211,11 +1211,7 @@ TclpCreateProcess( Tcl_DString pipeDll; Tcl_DStringInit(&pipeDll); Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1); - - /* For safety, just in case the app didn't call it first */ - Tcl_FindExecutable(NULL); - - tclExePtr = Tcl_NewStringObj(Tcl_GetNameOfExecutable(), -1); + tclExePtr = TclGetObjNameOfExecutable(); start = Tcl_GetStringFromObj(tclExePtr, &i); for (end = start + (i-1); end > start; end--) { if (*end == '/') { |