diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclFileName.c | 11 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 90 |
2 files changed, 85 insertions, 16 deletions
diff --git a/generic/tclFileName.c b/generic/tclFileName.c index ea7ee05..be689af 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclFileName.c,v 1.40.2.3 2003/07/17 00:16:04 hobbs Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.40.2.4 2003/10/03 17:45:37 vincentdarley Exp $ */ #include "tclInt.h" @@ -1380,16 +1380,17 @@ Tcl_TranslateFileName(interp, name, bufferPtr) * with name after tilde substitution. */ { Tcl_Obj *path = Tcl_NewStringObj(name, -1); - CONST char *result; + Tcl_Obj *transPtr; Tcl_IncrRefCount(path); - result = Tcl_FSGetTranslatedStringPath(interp, path); - if (result == NULL) { + transPtr = Tcl_FSGetTranslatedPath(interp, path); + if (transPtr == NULL) { Tcl_DecrRefCount(path); return NULL; } + Tcl_DStringInit(bufferPtr); - Tcl_DStringAppend(bufferPtr, result, -1); + Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1); Tcl_DecrRefCount(path); /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index bfe08b4..c59348a 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.8 2003/09/01 12:30:38 vasiljevic Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.9 2003/10/03 17:45:37 vincentdarley Exp $ */ #include "tclInt.h" @@ -1810,6 +1810,9 @@ Tcl_FSStat(pathPtr, buf) retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer); statProcPtr = statProcPtr->nextPtr; } + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } } Tcl_MutexUnlock(&obsoleteFsHookMutex); @@ -1937,6 +1940,9 @@ Tcl_FSAccess(pathPtr, mode) retVal = (*accessProcPtr->proc)(path, mode); accessProcPtr = accessProcPtr->nextPtr; } + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } } Tcl_MutexUnlock(&obsoleteFsHookMutex); @@ -2014,6 +2020,9 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions) modeString, permissions); openFileChannelProcPtr = openFileChannelProcPtr->nextPtr; } + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } } Tcl_MutexUnlock(&obsoleteFsHookMutex); if (retVal != NULL) { @@ -5093,6 +5102,7 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) retObj = srcFsPathPtr->translatedPathPtr; } + Tcl_IncrRefCount(retObj); return retObj; } @@ -5123,7 +5133,13 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr) Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { - return Tcl_GetString(transPtr); + int len; + CONST char *result, *orig; + orig = Tcl_GetStringFromObj(transPtr, &len); + result = (char*) ckalloc((unsigned)(len+1)); + memcpy((VOID*) result, (VOID*) orig, (size_t) (len+1)); + Tcl_DecrRefCount(transPtr); + return result; } return NULL; @@ -5330,17 +5346,69 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * that call can actually result in a lot of other filesystem * action, which might loop back through here. */ - if ((path[0] != '\0') && - (Tcl_FSGetPathType(pathObjPtr) == TCL_PATH_RELATIVE)) { - useThisCwd = Tcl_FSGetCwd(interp); + if (path[0] != '\0') { + Tcl_PathType type = Tcl_FSGetPathType(pathObjPtr); + if (type == TCL_PATH_RELATIVE) { + useThisCwd = Tcl_FSGetCwd(interp); - if (useThisCwd == NULL) { - return NULL; - } + if (useThisCwd == NULL) return NULL; - absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); - Tcl_IncrRefCount(absolutePath); - /* We have a refCount on the cwd */ + absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); + Tcl_IncrRefCount(absolutePath); + /* We have a refCount on the cwd */ +#ifdef __WIN32__ + } else if (type == TCL_PATH_VOLUME_RELATIVE) { + /* + * Only Windows has volume-relative paths. These + * paths are rather rare, but is is nice if Tcl can + * handle them. It is much better if we can + * handle them here, rather than in the native fs code, + * because we really need to have a real absolute path + * just below. + * + * We do not let this block compile on non-Windows + * platforms because the test suite's manual forcing + * of tclPlatform can otherwise cause this code path + * to be executed, causing various errors because + * volume-relative paths really do not exist. + */ + useThisCwd = Tcl_FSGetCwd(interp); + if (useThisCwd == NULL) return NULL; + + if (path[0] == '/') { + /* + * Path of form /foo/bar which is a path in the + * root directory of the current volume. + */ + CONST char *drive = Tcl_GetString(useThisCwd); + absolutePath = Tcl_NewStringObj(drive,2); + Tcl_AppendToObj(absolutePath, path, -1); + Tcl_IncrRefCount(absolutePath); + /* We have a refCount on the cwd */ + } else { + /* + * Path of form C:foo/bar, but this only makes + * sense if the cwd is also on drive C. + */ + CONST char *drive = Tcl_GetString(useThisCwd); + char drive_c = path[0]; + if (drive_c >= 'a') { + drive_c -= ('a' - 'A'); + } + if (drive[0] == drive_c) { + absolutePath = Tcl_DuplicateObj(useThisCwd); + Tcl_IncrRefCount(absolutePath); + Tcl_AppendToObj(absolutePath, "/", 1); + Tcl_AppendToObj(absolutePath, path+2, -1); + /* We have a refCount on the cwd */ + } else { + /* We just can't handle it correctly here */ + Tcl_DecrRefCount(useThisCwd); + useThisCwd = NULL; + } + } +#endif /* __WIN32__ */ + } } /* Already has refCount incremented */ fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath, |