diff options
author | vincentdarley <vincentdarley@noemail.net> | 2004-01-21 19:59:32 (GMT) |
---|---|---|
committer | vincentdarley <vincentdarley@noemail.net> | 2004-01-21 19:59:32 (GMT) |
commit | 25a16d68f72f2c8425d6f443f9a69e5df6afe44f (patch) | |
tree | 0ffe5e984dd325a6bea1e24606e505aa4f37574b /generic | |
parent | a41b4f5072bdca8cf305eb70e821660477b632f0 (diff) | |
download | tcl-25a16d68f72f2c8425d6f443f9a69e5df6afe44f.zip tcl-25a16d68f72f2c8425d6f443f9a69e5df6afe44f.tar.gz tcl-25a16d68f72f2c8425d6f443f9a69e5df6afe44f.tar.bz2 |
filesystem optimisation -- Three main issues accomplished: (1) cleaned up variable names in
FossilOrigin-Name: 9cfcca63fb07d8c7d68befc16d84d01790094ac5
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 18 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 141 | ||||
-rw-r--r-- | generic/tclDecls.h | 37 | ||||
-rw-r--r-- | generic/tclFCmd.c | 32 | ||||
-rw-r--r-- | generic/tclFileName.c | 810 | ||||
-rw-r--r-- | generic/tclFileSystem.h | 17 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 328 | ||||
-rw-r--r-- | generic/tclInt.decls | 13 | ||||
-rw-r--r-- | generic/tclInt.h | 39 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 21 | ||||
-rw-r--r-- | generic/tclPathObj.c | 752 | ||||
-rw-r--r-- | generic/tclStubInit.c | 4 | ||||
-rw-r--r-- | generic/tclTest.c | 8 |
13 files changed, 1409 insertions, 811 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 084aed6..886354c 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.101 2003/09/29 21:38:49 dkf Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.102 2004/01/21 19:59:33 vincentdarley Exp $ library tcl @@ -1639,14 +1639,14 @@ declare 462 generic { int Tcl_FSEqualPaths(Tcl_Obj* firstPtr, Tcl_Obj* secondPtr) } declare 463 generic { - Tcl_Obj* Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj* pathObjPtr) + Tcl_Obj* Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr) } declare 464 generic { - Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *basePtr, int objc, + Tcl_Obj* Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *CONST objv[]) } declare 465 generic { - ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathObjPtr, + ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathPtr, Tcl_Filesystem *fsPtr) } declare 466 generic { @@ -1660,13 +1660,13 @@ declare 468 generic { ClientData clientData) } declare 469 generic { - CONST char* Tcl_FSGetNativePath(Tcl_Obj* pathObjPtr) + CONST char* Tcl_FSGetNativePath(Tcl_Obj* pathPtr) } declare 470 generic { - Tcl_Obj* Tcl_FSFileSystemInfo(Tcl_Obj* pathObjPtr) + Tcl_Obj* Tcl_FSFileSystemInfo(Tcl_Obj* pathPtr) } declare 471 generic { - Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathObjPtr) + Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathPtr) } declare 472 generic { Tcl_Obj* Tcl_FSListVolumes(void) @@ -1685,10 +1685,10 @@ declare 476 generic { Tcl_Obj* pathPtr) } declare 477 generic { - Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathObjPtr) + Tcl_Filesystem* Tcl_FSGetFileSystemForPath(Tcl_Obj* pathPtr) } declare 478 generic { - Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathObjPtr) + Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr) } # New function due to TIP#49 declare 479 generic { diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 48d3101..c679195 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.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: tclCmdAH.c,v 1.39 2003/12/24 04:18:18 davygrvy Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.40 2004/01/21 19:59:33 vincentdarley Exp $ */ #include "tclInt.h" @@ -23,13 +23,13 @@ */ static int CheckAccess _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, int mode)); + Tcl_Obj *pathPtr, int mode)); static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, Tcl_FSStatProc *statProc, + Tcl_Obj *pathPtr, Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr)); static char * GetTypeFromMode _ANSI_ARGS_((int mode)); static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp, - char *varName, Tcl_StatBuf *statPtr)); + Tcl_Obj *varName, Tcl_StatBuf *statPtr)); /* *---------------------------------------------------------------------- @@ -948,7 +948,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (objc != 3) { goto only3Args; } - dirPtr = TclFileDirname(interp, objv[2]); + dirPtr = TclPathPart(interp, objv[2], TCL_PATH_DIRNAME); if (dirPtr == NULL) { return TCL_ERROR; } else { @@ -968,17 +968,19 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } return CheckAccess(interp, objv[2], F_OK); case FCMD_EXTENSION: { - char *fileName, *extension; - + Tcl_Obj *ext; + if (objc != 3) { goto only3Args; } - fileName = Tcl_GetString(objv[2]); - extension = TclGetExtension(fileName); - if (extension != NULL) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), extension, -1); + ext = TclPathPart(interp, objv[2], TCL_PATH_EXTENSION); + if (ext != NULL) { + Tcl_SetObjResult(interp, ext); + Tcl_DecrRefCount(ext); + return TCL_OK; + } else { + return TCL_ERROR; } - return TCL_OK; } case FCMD_ISDIRECTORY: { int value; @@ -1077,7 +1079,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) * doesn't exist. */ int access; - Tcl_Obj *dirPtr = TclFileDirname(interp, objv[index]); + Tcl_Obj *dirPtr = TclPathPart(interp, objv[index], TCL_PATH_DIRNAME); if (dirPtr == NULL) { return TCL_ERROR; } @@ -1131,7 +1133,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_OK; } case FCMD_LSTAT: { - char *varName; Tcl_StatBuf buf; if (objc != 4) { @@ -1141,8 +1142,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) { return TCL_ERROR; } - varName = Tcl_GetString(objv[3]); - return StoreStatData(interp, varName, &buf); + return StoreStatData(interp, objv[3], &buf); } case FCMD_MTIME: { Tcl_StatBuf buf; @@ -1297,21 +1297,19 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) case FCMD_RENAME: return TclFileRenameCmd(interp, objc, objv); case FCMD_ROOTNAME: { - int length; - char *fileName, *extension; + Tcl_Obj *root; if (objc != 3) { goto only3Args; } - fileName = Tcl_GetStringFromObj(objv[2], &length); - extension = TclGetExtension(fileName); - if (extension == NULL) { - Tcl_SetObjResult(interp, objv[2]); + root = TclPathPart(interp, objv[2], TCL_PATH_ROOT); + if (root != NULL) { + Tcl_SetObjResult(interp, root); + Tcl_DecrRefCount(root); + return TCL_OK; } else { - Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName, - (int) (length - strlen(extension))); + return TCL_ERROR; } - return TCL_OK; } case FCMD_SEPARATOR: if ((objc < 2) || (objc > 3)) { @@ -1356,14 +1354,27 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) (Tcl_WideInt) buf.st_size); return TCL_OK; } - case FCMD_SPLIT: + case FCMD_SPLIT: { + Tcl_Obj *res; + if (objc != 3) { goto only3Args; } - Tcl_SetObjResult(interp, Tcl_FSSplitPath(objv[2], NULL)); - return TCL_OK; + res = Tcl_FSSplitPath(objv[2], NULL); + if (res == NULL) { + if (interp != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "could not read \"", Tcl_GetString(objv[2]), + "\": no such file or directory", + (char *) NULL); + } + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, res); + return TCL_OK; + } + } case FCMD_STAT: { - char *varName; Tcl_StatBuf buf; if (objc != 4) { @@ -1373,8 +1384,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } - varName = Tcl_GetString(objv[3]); - return StoreStatData(interp, varName, &buf); + return StoreStatData(interp, objv[3], &buf); } case FCMD_SYSTEM: { Tcl_Obj* fsInfo; @@ -1393,45 +1403,19 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } } case FCMD_TAIL: { - int splitElements; - Tcl_Obj *splitPtr; + Tcl_Obj *dirPtr; if (objc != 3) { goto only3Args; } - /* - * The behaviour we want here is slightly different to - * the standard Tcl_FSSplitPath in the handling of home - * directories; Tcl_FSSplitPath preserves the "~" while - * this code computes the actual full path name, if we - * had just a single component. - */ - splitPtr = Tcl_FSSplitPath(objv[2], &splitElements); - if ((splitElements == 1) && (Tcl_GetString(objv[2])[0] == '~')) { - Tcl_DecrRefCount(splitPtr); - splitPtr = Tcl_FSGetNormalizedPath(interp, objv[2]); - if (splitPtr == NULL) { - return TCL_ERROR; - } - splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements); - } - - /* - * Return the last component, unless it is the only component, - * and it is the root of an absolute path. - */ - - if (splitElements > 0) { - if ((splitElements > 1) - || (Tcl_FSGetPathType(objv[2]) == TCL_PATH_RELATIVE)) { - - Tcl_Obj *tail = NULL; - Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &tail); - Tcl_SetObjResult(interp, tail); - } + dirPtr = TclPathPart(interp, objv[2], TCL_PATH_TAIL); + if (dirPtr == NULL) { + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, dirPtr); + Tcl_DecrRefCount(dirPtr); + return TCL_OK; } - Tcl_DecrRefCount(splitPtr); - return TCL_OK; } case FCMD_TYPE: { Tcl_StatBuf buf; @@ -1484,19 +1468,19 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) */ static int -CheckAccess(interp, objPtr, mode) +CheckAccess(interp, pathPtr, mode) Tcl_Interp *interp; /* Interp for status return. Must not be * NULL. */ - Tcl_Obj *objPtr; /* Name of file to check. */ + Tcl_Obj *pathPtr; /* Name of file to check. */ int mode; /* Attribute to check; passed as argument to * access(). */ { int value; - if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) { + if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { value = 0; } else { - value = (Tcl_FSAccess(objPtr, mode) == 0); + value = (Tcl_FSAccess(pathPtr, mode) == 0); } Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value); @@ -1524,9 +1508,9 @@ CheckAccess(interp, objPtr, mode) */ static int -GetStatBuf(interp, objPtr, statProc, statPtr) +GetStatBuf(interp, pathPtr, statProc, statPtr) Tcl_Interp *interp; /* Interp for error return. May be NULL. */ - Tcl_Obj *objPtr; /* Path name to examine. */ + Tcl_Obj *pathPtr; /* Path name to examine. */ Tcl_FSStatProc *statProc; /* Either stat() or lstat() depending on * desired behavior. */ Tcl_StatBuf *statPtr; /* Filled with info about file obtained by @@ -1534,16 +1518,16 @@ GetStatBuf(interp, objPtr, statProc, statPtr) { int status; - if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) { + if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return TCL_ERROR; } - status = (*statProc)(objPtr, statPtr); + status = (*statProc)(pathPtr, statPtr); if (status < 0) { if (interp != NULL) { Tcl_AppendResult(interp, "could not read \"", - Tcl_GetString(objPtr), "\": ", + Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), (char *) NULL); } return TCL_ERROR; @@ -1573,12 +1557,11 @@ GetStatBuf(interp, objPtr, statProc, statPtr) static int StoreStatData(interp, varName, statPtr) Tcl_Interp *interp; /* Interpreter for error reports. */ - char *varName; /* Name of associative array variable + Tcl_Obj *varName; /* Name of associative array variable * in which to store stat results. */ Tcl_StatBuf *statPtr; /* Pointer to buffer containing * stat data to store in varName. */ { - Tcl_Obj *var = Tcl_NewStringObj(varName, -1); Tcl_Obj *field = Tcl_NewObj(); Tcl_Obj *value; register unsigned short mode; @@ -1589,14 +1572,13 @@ StoreStatData(interp, varName, statPtr) #define STORE_ARY(fieldName, object) \ Tcl_SetStringObj(field, (fieldName), -1); \ value = (object); \ - if (Tcl_ObjSetVar2(interp,var,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \ - Tcl_DecrRefCount(var); \ + if (Tcl_ObjSetVar2(interp,varName,field,value,TCL_LEAVE_ERR_MSG) == NULL) { \ + Tcl_DecrRefCount(varName); \ Tcl_DecrRefCount(field); \ Tcl_DecrRefCount(value); \ return TCL_ERROR; \ } - Tcl_IncrRefCount(var); Tcl_IncrRefCount(field); STORE_ARY("dev", Tcl_NewLongObj((long)statPtr->st_dev)); /* @@ -1619,7 +1601,6 @@ StoreStatData(interp, varName, statPtr) STORE_ARY("mode", Tcl_NewIntObj(mode)); STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); #undef STORE_ARY - Tcl_DecrRefCount(var); Tcl_DecrRefCount(field); return TCL_OK; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 1cacfd4..dba4689 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -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: tclDecls.h,v 1.100 2003/09/29 21:45:35 dkf Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.101 2004/01/21 19:59:33 vincentdarley Exp $ */ #ifndef _TCLDECLS @@ -2870,19 +2870,19 @@ EXTERN int Tcl_FSEqualPaths _ANSI_ARGS_((Tcl_Obj* firstPtr, #define Tcl_FSGetNormalizedPath_TCL_DECLARED /* 463 */ EXTERN Tcl_Obj* Tcl_FSGetNormalizedPath _ANSI_ARGS_(( - Tcl_Interp * interp, Tcl_Obj* pathObjPtr)); + Tcl_Interp * interp, Tcl_Obj* pathPtr)); #endif #ifndef Tcl_FSJoinToPath_TCL_DECLARED #define Tcl_FSJoinToPath_TCL_DECLARED /* 464 */ -EXTERN Tcl_Obj* Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj * basePtr, +EXTERN Tcl_Obj* Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj * pathPtr, int objc, Tcl_Obj *CONST objv[])); #endif #ifndef Tcl_FSGetInternalRep_TCL_DECLARED #define Tcl_FSGetInternalRep_TCL_DECLARED /* 465 */ -EXTERN ClientData Tcl_FSGetInternalRep _ANSI_ARGS_(( - Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr)); +EXTERN ClientData Tcl_FSGetInternalRep _ANSI_ARGS_((Tcl_Obj* pathPtr, + Tcl_Filesystem * fsPtr)); #endif #ifndef Tcl_FSGetTranslatedPath_TCL_DECLARED #define Tcl_FSGetTranslatedPath_TCL_DECLARED @@ -2906,18 +2906,17 @@ EXTERN Tcl_Obj* Tcl_FSNewNativePath _ANSI_ARGS_(( #ifndef Tcl_FSGetNativePath_TCL_DECLARED #define Tcl_FSGetNativePath_TCL_DECLARED /* 469 */ -EXTERN CONST char* Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); +EXTERN CONST char* Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj* pathPtr)); #endif #ifndef Tcl_FSFileSystemInfo_TCL_DECLARED #define Tcl_FSFileSystemInfo_TCL_DECLARED /* 470 */ -EXTERN Tcl_Obj* Tcl_FSFileSystemInfo _ANSI_ARGS_(( - Tcl_Obj* pathObjPtr)); +EXTERN Tcl_Obj* Tcl_FSFileSystemInfo _ANSI_ARGS_((Tcl_Obj* pathPtr)); #endif #ifndef Tcl_FSPathSeparator_TCL_DECLARED #define Tcl_FSPathSeparator_TCL_DECLARED /* 471 */ -EXTERN Tcl_Obj* Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); +EXTERN Tcl_Obj* Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj* pathPtr)); #endif #ifndef Tcl_FSListVolumes_TCL_DECLARED #define Tcl_FSListVolumes_TCL_DECLARED @@ -2950,12 +2949,12 @@ EXTERN CONST char* Tcl_FSGetTranslatedStringPath _ANSI_ARGS_(( #define Tcl_FSGetFileSystemForPath_TCL_DECLARED /* 477 */ EXTERN Tcl_Filesystem* Tcl_FSGetFileSystemForPath _ANSI_ARGS_(( - Tcl_Obj* pathObjPtr)); + Tcl_Obj* pathPtr)); #endif #ifndef Tcl_FSGetPathType_TCL_DECLARED #define Tcl_FSGetPathType_TCL_DECLARED /* 478 */ -EXTERN Tcl_PathType Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); +EXTERN Tcl_PathType Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj * pathPtr)); #endif #ifndef Tcl_OutputBuffered_TCL_DECLARED #define Tcl_OutputBuffered_TCL_DECLARED @@ -3745,22 +3744,22 @@ typedef struct TclStubs { Tcl_Obj* (*tcl_FSJoinPath) _ANSI_ARGS_((Tcl_Obj * listObj, int elements)); /* 460 */ Tcl_Obj* (*tcl_FSSplitPath) _ANSI_ARGS_((Tcl_Obj* pathPtr, int * lenPtr)); /* 461 */ int (*tcl_FSEqualPaths) _ANSI_ARGS_((Tcl_Obj* firstPtr, Tcl_Obj* secondPtr)); /* 462 */ - Tcl_Obj* (*tcl_FSGetNormalizedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathObjPtr)); /* 463 */ - Tcl_Obj* (*tcl_FSJoinToPath) _ANSI_ARGS_((Tcl_Obj * basePtr, int objc, Tcl_Obj *CONST objv[])); /* 464 */ - ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr)); /* 465 */ + Tcl_Obj* (*tcl_FSGetNormalizedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 463 */ + Tcl_Obj* (*tcl_FSJoinToPath) _ANSI_ARGS_((Tcl_Obj * pathPtr, int objc, Tcl_Obj *CONST objv[])); /* 464 */ + ClientData (*tcl_FSGetInternalRep) _ANSI_ARGS_((Tcl_Obj* pathPtr, Tcl_Filesystem * fsPtr)); /* 465 */ Tcl_Obj* (*tcl_FSGetTranslatedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 466 */ int (*tcl_FSEvalFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * fileName)); /* 467 */ Tcl_Obj* (*tcl_FSNewNativePath) _ANSI_ARGS_((Tcl_Filesystem* fromFilesystem, ClientData clientData)); /* 468 */ - CONST char* (*tcl_FSGetNativePath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 469 */ - Tcl_Obj* (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 470 */ - Tcl_Obj* (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 471 */ + CONST char* (*tcl_FSGetNativePath) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 469 */ + Tcl_Obj* (*tcl_FSFileSystemInfo) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 470 */ + Tcl_Obj* (*tcl_FSPathSeparator) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 471 */ Tcl_Obj* (*tcl_FSListVolumes) _ANSI_ARGS_((void)); /* 472 */ int (*tcl_FSRegister) _ANSI_ARGS_((ClientData clientData, Tcl_Filesystem * fsPtr)); /* 473 */ int (*tcl_FSUnregister) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 474 */ ClientData (*tcl_FSData) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 475 */ CONST char* (*tcl_FSGetTranslatedStringPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 476 */ - Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 477 */ - Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); /* 478 */ + Tcl_Filesystem* (*tcl_FSGetFileSystemForPath) _ANSI_ARGS_((Tcl_Obj* pathPtr)); /* 477 */ + Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 478 */ int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */ void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 480 */ int (*tcl_EvalTokensStandard) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 481 */ diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index fb4a880..3d78f4c 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.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: tclFCmd.c,v 1.22 2003/06/23 10:14:02 vincentdarley Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.23 2004/01/21 19:59:33 vincentdarley Exp $ */ #include "tclInt.h" @@ -241,6 +241,7 @@ TclFileMakeDirsCmd(interp, objc, objv) } split = Tcl_FSSplitPath(objv[i],&pobjc); + Tcl_IncrRefCount(split); if (pobjc == 0) { errno = ENOENT; errfile = objv[i]; @@ -553,12 +554,18 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) actualSource = source; Tcl_IncrRefCount(actualSource); -#if 0 -#ifdef S_ISLNK /* - * To add a flag to make 'copy' copy links instead of files, we could - * add a condition to ignore this 'if' here. + * Activate the following block to copy files instead of links. + * However Tcl's semantics currently say we should copy links, so + * any such change should be the subject of careful study on + * the consequences. + * + * Perhaps there could be an optional flag to 'file copy' to + * dictate which approach to use, with the default being _not_ + * to have this block active. */ +#if 0 +#ifdef S_ISLNK if (copyFlag && S_ISLNK(sourceStatBuf.st_mode)) { /* * We want to copy files not links. Therefore we must follow the @@ -581,6 +588,17 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) if (path == NULL) { break; } + /* + * Now we want to check if this is a relative path, + * and if so, to make it absolute + */ + if (Tcl_FSGetPathType(path) == TCL_PATH_RELATIVE) { + Tcl_Obj *abs = Tcl_FSJoinToPath(actualSource, 1, &path); + if (abs == NULL) break; + Tcl_IncrRefCount(abs); + Tcl_DecrRefCount(path); + path = abs; + } Tcl_DecrRefCount(actualSource); actualSource = path; counter++; @@ -796,7 +814,8 @@ FileBasename(interp, pathPtr) Tcl_Obj *resultPtr = NULL; splitPtr = Tcl_FSSplitPath(pathPtr, &objc); - + Tcl_IncrRefCount(splitPtr); + if (objc != 0) { if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) { Tcl_DecrRefCount(splitPtr); @@ -804,6 +823,7 @@ FileBasename(interp, pathPtr) return NULL; } splitPtr = Tcl_FSSplitPath(pathPtr, &objc); + Tcl_IncrRefCount(splitPtr); } /* diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 52ebfd8..54c11cc 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.45 2004/01/13 17:13:01 dgp Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.46 2004/01/21 19:59:33 vincentdarley Exp $ */ #include "tclInt.h" @@ -75,11 +75,15 @@ static CONST char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp, static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path, Tcl_DString *resultPtr, int offset, Tcl_PathType *typePtr)); -static int SkipToChar _ANSI_ARGS_((char **stringPtr, - char *match)); +static int SkipToChar _ANSI_ARGS_((CONST char **stringPtr, + char match)); static Tcl_Obj* SplitMacPath _ANSI_ARGS_((CONST char *path)); static Tcl_Obj* SplitWinPath _ANSI_ARGS_((CONST char *path)); static Tcl_Obj* SplitUnixPath _ANSI_ARGS_((CONST char *path)); +static int DoGlob _ANSI_ARGS_((Tcl_Interp *interp, + char *separators, Tcl_Obj *pathPtr, + int flags, char *pattern, Tcl_GlobTypeData *types)); + #ifdef MAC_UNDERSTANDS_UNIX_PATHS /* @@ -347,14 +351,15 @@ Tcl_GetPathType(path) */ Tcl_PathType -TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef) - Tcl_Obj *pathObjPtr; - int *driveNameLengthPtr; - Tcl_Obj **driveNameRef; +TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef) + Tcl_Obj *pathPtr; /* Native path of interest */ + int *driveNameLengthPtr; /* Returns length of drive, if non-NULL + * and path was absolute */ + Tcl_Obj **driveNameRef; { Tcl_PathType type = TCL_PATH_ABSOLUTE; int pathLen; - char *path = Tcl_GetStringFromObj(pathObjPtr, &pathLen); + char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); if (path[0] == '~') { /* @@ -611,6 +616,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr) tmpPtr = Tcl_NewStringObj(path, -1); Tcl_IncrRefCount(tmpPtr); resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr); + Tcl_IncrRefCount(resultPtr); Tcl_DecrRefCount(tmpPtr); /* Calculate space required for the result */ @@ -1055,9 +1061,15 @@ SplitMacPath(path) * This function takes the given object, which should usually be a * valid path or NULL, and joins onto it the array of paths * segments given. - * + * + * The objects in the array given will temporarily have their + * refCount increased by one, and then decreased by one when this + * function exits (which means if they had zero refCount when we + * were called, they will be freed). + * * Results: - * Returns object with refCount of zero + * Returns object owned by the caller (which should increment its + * refCount) - typically an object with refCount of zero. * * Side effects: * None. @@ -1066,25 +1078,35 @@ SplitMacPath(path) */ Tcl_Obj* -Tcl_FSJoinToPath(basePtr, objc, objv) - Tcl_Obj *basePtr; - int objc; - Tcl_Obj *CONST objv[]; +Tcl_FSJoinToPath(pathPtr, objc, objv) + Tcl_Obj *pathPtr; /* Valid path or NULL. */ + int objc; /* Number of array elements to join */ + Tcl_Obj *CONST objv[]; /* Path elements to join. */ { int i; Tcl_Obj *lobj, *ret; - if (basePtr == NULL) { + if (pathPtr == NULL) { lobj = Tcl_NewListObj(0, NULL); } else { - lobj = Tcl_NewListObj(1, &basePtr); + lobj = Tcl_NewListObj(1, &pathPtr); } for (i = 0; i<objc;i++) { Tcl_ListObjAppendElement(NULL, lobj, objv[i]); } ret = Tcl_FSJoinPath(lobj, -1); + /* + * It is possible that 'ret' is just a member of the list and is + * therefore going to be freed here. Therefore we must adjust the + * refCount manually. (It would be better if we changed the + * documentation of this function and Tcl_FSJoinPath so that + * the returned object already has a refCount for the caller, + * hence avoiding these subtleties (and code ugliness)). + */ + Tcl_IncrRefCount(ret); Tcl_DecrRefCount(lobj); + ret->refCount--; return ret; } @@ -1428,11 +1450,11 @@ Tcl_TranslateFileName(interp, name, bufferPtr) *---------------------------------------------------------------------- */ -char * +CONST char * TclGetExtension(name) - char *name; /* File name to parse. */ + CONST char *name; /* File name to parse. */ { - char *p, *lastSep; + CONST char *p, *lastSep; /* * First find the last directory separator. @@ -1710,8 +1732,15 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) char *search, *find; Tcl_DStringInit(&pref); if (last == first) { - /* The whole thing is a prefix */ + /* + * The whole thing is a prefix. This means we must + * remove any 'tails' flag too, since it is irrelevant + * now (the same effect will happen without it), but in + * particular its use in TclGlob requires a non-NULL + * pathOrDir. + */ Tcl_DStringAppend(&pref, first, -1); + globFlags &= ~TCL_GLOBMODE_TAILS; pathOrDir = NULL; } else { /* Have to split off the end */ @@ -1957,20 +1986,24 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) * * TclGlob -- * - * This procedure prepares arguments for the TclDoGlob call. + * This procedure prepares arguments for the DoGlob call. * It sets the separator string based on the platform, performs - * tilde substitution, and calls TclDoGlob. + * tilde substitution, and calls DoGlob. * * The interpreter's result, on entry to this function, must * be a valid Tcl list (e.g. it could be empty), since we will * lappend any new results to that list. If it is not a valid * list, this function will fail to do anything very meaningful. + * + * Note that if globFlags contains 'TCL_GLOBMODE_TAILS' then + * pathPrefix cannot be NULL (it is only allowed with -dir or + * -path). * * Results: * The return value is a standard Tcl result indicating whether * an error occurred in globbing. After a normal return the - * result in interp (set by TclDoGlob) holds all of the file names - * given by the pattern and unquotedPrefix arguments. After an + * result in interp (set by DoGlob) holds all of the file names + * given by the pattern and pathPrefix arguments. After an * error the result in interp will hold an error message, unless * the 'TCL_GLOBMODE_NO_COMPLAIN' flag was given, in which case * an error results in a TCL_OK return leaving the interpreter's @@ -1984,13 +2017,13 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -TclGlob(interp, pattern, unquotedPrefix, globFlags, types) +TclGlob(interp, pattern, pathPrefix, globFlags, types) Tcl_Interp *interp; /* Interpreter for returning error message * or appending list of matching file names. */ char *pattern; /* Glob pattern to match. Must not refer * to a static string. */ - Tcl_Obj *unquotedPrefix; /* Prefix to glob pattern, if non-null, which - * is considered literally. */ + Tcl_Obj *pathPrefix; /* Path prefix to glob pattern, if non-null, + * which is considered literally. */ int globFlags; /* Stores or'ed combination of flags */ Tcl_GlobTypeData *types; /* Struct containing acceptable types. * May be NULL. */ @@ -1998,11 +2031,9 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) char *separators; CONST char *head; char *tail, *start; - char c; - int result, prefixLen; - Tcl_DString buffer; + int result; Tcl_Obj *oldResult; - + separators = NULL; /* lint. */ switch (tclPlatform) { case TCL_PLATFORM_UNIX: @@ -2013,7 +2044,7 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) break; case TCL_PLATFORM_MAC: #ifdef MAC_UNDERSTANDS_UNIX_PATHS - if (unquotedPrefix == NULL) { + if (pathPrefix == NULL) { separators = (strchr(pattern, ':') == NULL) ? "/" : ":"; } else { separators = ":"; @@ -2024,91 +2055,120 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) break; } - Tcl_DStringInit(&buffer); - if (unquotedPrefix != NULL) { - start = Tcl_GetString(unquotedPrefix); - } else { - start = pattern; - } - - /* - * Perform tilde substitution, if needed. - */ + if (pathPrefix == NULL) { + char c; + Tcl_DString buffer; + Tcl_DStringInit(&buffer); - if (start[0] == '~') { - + start = pattern; /* - * Find the first path separator after the tilde. + * Perform tilde substitution, if needed. */ - for (tail = start; *tail != '\0'; tail++) { - if (*tail == '\\') { - if (strchr(separators, tail[1]) != NULL) { + + if (start[0] == '~') { + + /* + * Find the first path separator after the tilde. + */ + for (tail = start; *tail != '\0'; tail++) { + if (*tail == '\\') { + if (strchr(separators, tail[1]) != NULL) { + break; + } + } else if (strchr(separators, *tail) != NULL) { break; } - } else if (strchr(separators, *tail) != NULL) { - break; } - } - /* - * Determine the home directory for the specified user. - */ - - c = *tail; - *tail = '\0'; - if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) { - /* - * We will ignore any error message here, and we - * don't want to mess up the interpreter's result. + /* + * Determine the home directory for the specified user. */ - head = DoTildeSubst(NULL, start+1, &buffer); - } else { - head = DoTildeSubst(interp, start+1, &buffer); - } - *tail = c; - if (head == NULL) { + + c = *tail; + *tail = '\0'; if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) { - return TCL_OK; + /* + * We will ignore any error message here, and we + * don't want to mess up the interpreter's result. + */ + head = DoTildeSubst(NULL, start+1, &buffer); } else { - return TCL_ERROR; + head = DoTildeSubst(interp, start+1, &buffer); } - } - if (head != Tcl_DStringValue(&buffer)) { - Tcl_DStringAppend(&buffer, head, -1); - } - if (unquotedPrefix != NULL) { - Tcl_DStringAppend(&buffer, tail, -1); + *tail = c; + if (head == NULL) { + if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) { + return TCL_OK; + } else { + return TCL_ERROR; + } + } + if (head != Tcl_DStringValue(&buffer)) { + Tcl_DStringAppend(&buffer, head, -1); + } + pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer), + Tcl_DStringLength(&buffer)); + Tcl_IncrRefCount(pathPrefix); + globFlags |= TCL_GLOBMODE_DIR; + if (c != '\0') { + tail++; + } + Tcl_DStringFree(&buffer); + } else { tail = pattern; } } else { + Tcl_IncrRefCount(pathPrefix); tail = pattern; - if (unquotedPrefix != NULL) { - Tcl_DStringAppend(&buffer,Tcl_GetString(unquotedPrefix),-1); - } } /* - * We want to remember the length of the current prefix, - * in case we are using TCL_GLOBMODE_TAILS. Also if we - * are using TCL_GLOBMODE_DIR, we must make sure the - * prefix ends in a directory separator. + * Handling empty path prefixes with glob patterns like 'C:' or + * 'c:////////' is a pain on Windows if we leave it too late, since + * these aren't really patterns at all! We therefore check the head + * of the pattern now for such cases, if we don't have an unquoted + * prefix yet. + * + * Similarly on Unix with '/' at the head of the pattern -- it + * just indicates the root volume, so we treat it as such. */ - prefixLen = Tcl_DStringLength(&buffer); - - if (prefixLen > 0) { - c = Tcl_DStringValue(&buffer)[prefixLen-1]; - if (strchr(separators, c) == NULL) { - /* - * If the prefix is a directory, make sure it ends in a - * directory separator. - */ - if (globFlags & TCL_GLOBMODE_DIR) { - Tcl_DStringAppend(&buffer,separators,1); + if (tclPlatform == TCL_PLATFORM_WINDOWS) { + if (pathPrefix == NULL && tail[0] != '\0' && tail[1] == ':') { + char *p = tail + 1; + pathPrefix = Tcl_NewStringObj(tail, 1); + while (*p != '\0') { + char c = p[1]; + if (*p == '\\') { + if (strchr(separators, c) != NULL) { + if (c == '\\') c = '/'; + Tcl_AppendToObj(pathPrefix, &c, 1); + p++; + } else { + break; + } + } else if (strchr(separators, *p) != NULL) { + Tcl_AppendToObj(pathPrefix, p, 1); + } else { + break; + } + p++; } - prefixLen++; + tail = p; + Tcl_IncrRefCount(pathPrefix); + } + /* + * ':' no longer needed as a separator. It is only relevant + * to the beginning of the path. + */ + separators = "/\\"; + } else if (tclPlatform == TCL_PLATFORM_UNIX) { + if (pathPrefix == NULL && tail[0] == '/') { + pathPrefix = Tcl_NewStringObj(tail, 1); + tail++; + Tcl_IncrRefCount(pathPrefix); } } - + /* * We need to get the old result, in case it is over-written * below when we still need it. @@ -2116,8 +2176,18 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) oldResult = Tcl_GetObjResult(interp); Tcl_IncrRefCount(oldResult); Tcl_ResetResult(interp); - - result = TclDoGlob(interp, separators, &buffer, tail, types); + + if (*tail == '\0' && pathPrefix != NULL) { + /* + * An empty pattern + */ + result = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), + pathPrefix, NULL, types); + + } else { + result = DoGlob(interp, separators, pathPrefix, + globFlags & TCL_GLOBMODE_DIR, tail, types); + } if (result != TCL_OK) { if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) { @@ -2132,37 +2202,49 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) * * If we only want the tails, we must strip off the prefix now. * It may seem more efficient to pass the tails flag down into - * TclDoGlob, Tcl_FSMatchInDirectory, but those functions are + * DoGlob, Tcl_FSMatchInDirectory, but those functions are * continually adjusting the prefix as the various pieces of * the pattern are assimilated, so that would add a lot of * complexity to the code. This way is a little slower (when * the -tails flag is given), but much simpler to code. */ - int objc, i; - Tcl_Obj **objv; - /* Ensure sole ownership */ + /* + * Ensure sole ownership. We also assume that oldResult + * is a valid list in the code below. + */ if (Tcl_IsShared(oldResult)) { Tcl_DecrRefCount(oldResult); oldResult = Tcl_DuplicateObj(oldResult); Tcl_IncrRefCount(oldResult); } - Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), - &objc, &objv); -#ifdef MAC_TCL - /* adjust prefixLen if TclDoGlob prepended a ':' */ - if ((prefixLen > 0) && (objc > 0) - && (Tcl_DStringValue(&buffer)[0] != ':')) { - char *str = Tcl_GetStringFromObj(objv[0],NULL); - if (str[0] == ':') { + if (globFlags & TCL_GLOBMODE_TAILS) { + int objc, i; + Tcl_Obj **objv; + int prefixLen; + + /* If this length has never been set, set it here */ + CONST char *pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen); + if (prefixLen > 0) { + if (strchr(separators, pre[prefixLen-1]) == NULL) { prefixLen++; + } } - } -#endif - for (i = 0; i< objc; i++) { - Tcl_Obj* elt; - if (globFlags & TCL_GLOBMODE_TAILS) { + + Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), + &objc, &objv); + #ifdef MAC_TCL + /* adjust prefixLen if DoGlob prepended a ':' */ + if ((prefixLen > 0) && (objc > 0) && (pre[0] != ':')) { + CONST char *str = Tcl_GetStringFromObj(objv[0],NULL); + if (str[0] == ':') { + prefixLen++; + } + } + #endif + for (i = 0; i< objc; i++) { + Tcl_Obj* elt; int len; char *oldStr = Tcl_GetStringFromObj(objv[i],&len); if (len == prefixLen) { @@ -2176,11 +2258,10 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) elt = Tcl_NewStringObj(oldStr + prefixLen, len - prefixLen); } - } else { - elt = objv[i]; + Tcl_ListObjAppendElement(interp, oldResult, elt); } - /* Assumption that 'oldResult' is a valid list */ - Tcl_ListObjAppendElement(interp, oldResult, elt); + } else { + Tcl_ListObjAppendList(interp, oldResult, Tcl_GetObjResult(interp)); } Tcl_SetObjResult(interp, oldResult); } @@ -2189,7 +2270,6 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) * end here so we free our reference. */ Tcl_DecrRefCount(oldResult); - Tcl_DStringFree(&buffer); return result; } @@ -2215,11 +2295,11 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) static int SkipToChar(stringPtr, match) - char **stringPtr; /* Pointer string to check. */ - char *match; /* Pointer to character to find. */ + CONST char **stringPtr; /* Pointer string to check. */ + char match; /* Pointer to character to find. */ { int quoted, level; - register char *p; + register CONST char *p; quoted = 0; level = 0; @@ -2229,7 +2309,7 @@ SkipToChar(stringPtr, match) quoted = 0; continue; } - if ((level == 0) && (*p == *match)) { + if ((level == 0) && (*p == match)) { *stringPtr = p; return 1; } @@ -2248,22 +2328,20 @@ SkipToChar(stringPtr, match) /* *---------------------------------------------------------------------- * - * TclDoGlob -- - * - * This recursive procedure forms the heart of the globbing - * code. It performs a depth-first traversal of the tree - * given by the path name to be globbed. The directory and - * remainder are assumed to be native format paths. The prefix - * contained in 'headPtr' is not used as a glob pattern, simply - * as a path specifier, so it can contain unquoted glob-sensitive - * characters (if the directories to which it points contain - * such strange characters). + * DoGlob -- * + * This recursive procedure forms the heart of the globbing code. + * It performs a depth-first traversal of the tree given by the + * path name to be globbed and the pattern. The directory and + * remainder are assumed to be native format paths. The prefix + * contained in 'pathPtr' is either a directory or path from which + * to start the search (or NULL). + * * Results: * The return value is a standard Tcl result indicating whether * an error occurred in globbing. After a normal return the * result in interp will be set to hold all of the file names - * given by the dir and rem arguments. After an error the + * given by the dir and remaining arguments. After an error the * result in interp will hold an error message. * * Side effects: @@ -2272,128 +2350,142 @@ SkipToChar(stringPtr, match) *---------------------------------------------------------------------- */ -int -TclDoGlob(interp, separators, headPtr, tail, types) +static int +DoGlob(interp, separators, pathPtr, flags, pattern, types) Tcl_Interp *interp; /* Interpreter to use for error reporting * (e.g. unmatched brace). */ char *separators; /* String containing separator characters * that should be used to identify globbing * boundaries. */ - Tcl_DString *headPtr; /* Completely expanded prefix. */ - char *tail; /* The unexpanded remainder of the path. + Tcl_Obj *pathPtr; /* Completely expanded prefix. */ + int flags; /* If non-zero then pathPtr is a + * directory */ + char *pattern; /* The pattern to match against. * Must not be a pointer to a static string. */ Tcl_GlobTypeData *types; /* List object containing list of acceptable - * types. May be NULL. */ + * types. May be NULL. */ { int baseLength, quoted, count; int result = TCL_OK; - char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar; - char lastChar = 0; - - int length = Tcl_DStringLength(headPtr); - - if (length > 0) { - lastChar = Tcl_DStringValue(headPtr)[length-1]; - } + char *name, *p, *openBrace, *closeBrace, *firstSpecialChar; /* - * Consume any leading directory separators, leaving tail pointing + * Consume any leading directory separators, leaving pattern pointing * just past the last initial separator. */ count = 0; - name = tail; - for (; *tail != '\0'; tail++) { - if (*tail == '\\') { + name = pattern; + for (; *pattern != '\0'; pattern++) { + if (*pattern == '\\') { /* * If the first character is escaped, either we have a directory * separator, or we have any other character. In the latter case - * the rest of tail is a pattern, and we must break from the loop. + * the rest is a pattern, and we must break from the loop. * This is particularly important on Windows where '\' is both * the escaping character and a directory separator. */ - if (strchr(separators, tail[1]) != NULL) { - tail++; + if (strchr(separators, pattern[1]) != NULL) { + pattern++; } else { break; } - } else if (strchr(separators, *tail) == NULL) { + } else if (strchr(separators, *pattern) == NULL) { break; } count++; } + /* + * This block of code is not exercised by the Tcl test suite as of + * Tcl 8.5a0. Simplifications to the calling paths suggest it may + * not be necessary any more, since path separators are handled + * elsewhere. It is left in place in case new bugs are reported + * (particularly on MacOS) + */ + +#if 0 /* * Deal with path separators. On the Mac, we have to watch out * for multiple separators, since they are special in Mac-style * paths. */ + if (pathPtr == NULL) { + /* + * Length used to be the length of the prefix, and lastChar + * the lastChar of the prefix. But, none of this is used + * any more. + */ + int length = 0; + char lastChar = 0; - switch (tclPlatform) { - case TCL_PLATFORM_MAC: -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - if (*separators == '/') { - if (((length == 0) && (count == 0)) - || ((length > 0) && (lastChar != ':'))) { - Tcl_DStringAppend(headPtr, ":", 1); - } - } else { -#endif - if (count == 0) { - if ((length > 0) && (lastChar != ':')) { - Tcl_DStringAppend(headPtr, ":", 1); + switch (tclPlatform) { + case TCL_PLATFORM_MAC: + #ifdef MAC_UNDERSTANDS_UNIX_PATHS + if (*separators == '/') { + if (((length == 0) && (count == 0)) + || ((length > 0) && (lastChar != ':'))) { + Tcl_DStringAppend(&append, ":", 1); } } else { - if (lastChar == ':') { - count--; - } - while (count-- > 0) { - Tcl_DStringAppend(headPtr, ":", 1); + #endif + if (count == 0) { + if ((length > 0) && (lastChar != ':')) { + Tcl_DStringAppend(&append, ":", 1); + } + } else { + if (lastChar == ':') { + count--; + } + while (count-- > 0) { + Tcl_DStringAppend(&append, ":", 1); + } } + #ifdef MAC_UNDERSTANDS_UNIX_PATHS } -#ifdef MAC_UNDERSTANDS_UNIX_PATHS - } -#endif - break; - case TCL_PLATFORM_WINDOWS: - /* - * If this is a drive relative path, add the colon and the - * trailing slash if needed. Otherwise add the slash if - * this is the first absolute element, or a later relative - * element. Add an extra slash if this is a UNC path. - */ + #endif + break; + case TCL_PLATFORM_WINDOWS: + /* + * If this is a drive relative path, add the colon and the + * trailing slash if needed. Otherwise add the slash if + * this is the first absolute element, or a later relative + * element. Add an extra slash if this is a UNC path. + */ - if (*name == ':') { - Tcl_DStringAppend(headPtr, ":", 1); - if (count > 1) { - Tcl_DStringAppend(headPtr, "/", 1); - } - } else if ((*tail != '\0') - && (((length > 0) - && (strchr(separators, lastChar) == NULL)) - || ((length == 0) && (count > 0)))) { - Tcl_DStringAppend(headPtr, "/", 1); - if ((length == 0) && (count > 1)) { - Tcl_DStringAppend(headPtr, "/", 1); + if (*name == ':') { + Tcl_DStringAppend(&append, ":", 1); + if (count > 1) { + Tcl_DStringAppend(&append, "/", 1); + } + } else if ((*pattern != '\0') + && (((length > 0) + && (strchr(separators, lastChar) == NULL)) + || ((length == 0) && (count > 0)))) { + Tcl_DStringAppend(&append, "/", 1); + if ((length == 0) && (count > 1)) { + Tcl_DStringAppend(&append, "/", 1); + } } - } - - break; - case TCL_PLATFORM_UNIX: - /* - * Add a separator if this is the first absolute element, or - * a later relative element. - */ + + break; + case TCL_PLATFORM_UNIX: + /* + * Add a separator if this is the first absolute element, or + * a later relative element. + */ - if ((*tail != '\0') - && (((length > 0) - && (strchr(separators, lastChar) == NULL)) - || ((length == 0) && (count > 0)))) { - Tcl_DStringAppend(headPtr, "/", 1); - } - break; + if ((*pattern != '\0') + && (((length > 0) + && (strchr(separators, lastChar) == NULL)) + || ((length == 0) && (count > 0)))) { + Tcl_DStringAppend(&append, "/", 1); + } + break; + } } - +#endif + /* * Look for the first matching pair of braces or the first * directory separator that is not inside a pair of braces. @@ -2401,21 +2493,24 @@ TclDoGlob(interp, separators, headPtr, tail, types) openBrace = closeBrace = NULL; quoted = 0; - for (p = tail; *p != '\0'; p++) { + for (p = pattern; *p != '\0'; p++) { if (quoted) { quoted = 0; } else if (*p == '\\') { quoted = 1; if (strchr(separators, p[1]) != NULL) { - break; /* Quoted directory separator. */ + /* Quoted directory separator. */ + break; } } else if (strchr(separators, *p) != NULL) { - break; /* Unquoted directory separator. */ + /* Unquoted directory separator. */ + break; } else if (*p == '{') { openBrace = p; p++; - if (SkipToChar(&p, "}")) { - closeBrace = p; /* Balanced braces. */ + if (SkipToChar(&p, '}')) { + /* Balanced braces. */ + closeBrace = p; break; } Tcl_SetResult(interp, "unmatched open-brace in file name", @@ -2434,6 +2529,7 @@ TclDoGlob(interp, separators, headPtr, tail, types) if (openBrace != NULL) { char *element; + Tcl_DString newName; Tcl_DStringInit(&newName); @@ -2443,20 +2539,18 @@ TclDoGlob(interp, separators, headPtr, tail, types) * before the first brace and recursively call TclDoGlob. */ - Tcl_DStringAppend(&newName, tail, openBrace-tail); + Tcl_DStringAppend(&newName, pattern, openBrace-pattern); baseLength = Tcl_DStringLength(&newName); - length = Tcl_DStringLength(headPtr); *closeBrace = '\0'; for (p = openBrace; p != closeBrace; ) { p++; element = p; - SkipToChar(&p, ","); - Tcl_DStringSetLength(headPtr, length); + SkipToChar(&p, ','); Tcl_DStringSetLength(&newName, baseLength); Tcl_DStringAppend(&newName, element, p-element); Tcl_DStringAppend(&newName, closeBrace+1, -1); - result = TclDoGlob(interp, separators, headPtr, - Tcl_DStringValue(&newName), types); + result = DoGlob(interp, separators, pathPtr, flags, + Tcl_DStringValue(&newName), types); if (result != TCL_OK) { break; } @@ -2471,7 +2565,17 @@ TclDoGlob(interp, separators, headPtr, tail, types) * this path component. The variable p is pointing at a quoted or * unquoted directory separator or the end of the string. So we need * to check for special globbing characters in the current pattern. - * We avoid modifying tail if p is pointing at the end of the string. + * We avoid modifying pattern if p is pointing at the end of the string. + * + * If we find any globbing characters, then we must call + * Tcl_FSMatchInDirectory. If we're at the end of the string, then + * that's all we need to do. If we're not at the end of the + * string, then we must recurse, so we do that below. + * + * Alternatively, if there are no globbing characters then again + * there are two cases. If we're at the end of the string, we just + * need to check for the given path's existence and type. If we're + * not at the end of the string, we recurse. */ if (*p != '\0') { @@ -2481,27 +2585,26 @@ TclDoGlob(interp, separators, headPtr, tail, types) * if the string is a static. */ - savedChar = *p; + char savedChar = *p; *p = '\0'; - firstSpecialChar = strpbrk(tail, "*[]?\\"); + firstSpecialChar = strpbrk(pattern, "*[]?\\"); *p = savedChar; } else { - firstSpecialChar = strpbrk(tail, "*[]?\\"); + firstSpecialChar = strpbrk(pattern, "*[]?\\"); } if (firstSpecialChar != NULL) { int ret; - Tcl_Obj *head = Tcl_NewStringObj(Tcl_DStringValue(headPtr),-1); - Tcl_IncrRefCount(head); + /* * Look for matching files in the given directory. The - * implementation of this function is platform specific. For + * implementation of this function is filesystem specific. For * each file that matches, it will add the match onto the * resultPtr given. */ if (*p == '\0') { ret = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), - head, tail, types); + pathPtr, pattern, types); } else { Tcl_Obj* resultPtr; @@ -2515,7 +2618,7 @@ TclDoGlob(interp, separators, headPtr, tail, types) *p = '\0'; resultPtr = Tcl_NewListObj(0, NULL); ret = Tcl_FSMatchInDirectory(interp, resultPtr, - head, tail, &dirOnly); + pathPtr, pattern, &dirOnly); *p = save; if (ret == TCL_OK) { int resLength; @@ -2524,17 +2627,9 @@ TclDoGlob(interp, separators, headPtr, tail, types) int i; for (i =0; i< resLength; i++) { Tcl_Obj *elt; - Tcl_DString ds; + Tcl_ListObjIndex(interp, resultPtr, i, &elt); - Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1); - if(tclPlatform == TCL_PLATFORM_MAC) { - Tcl_DStringAppend(&ds, ":",1); - } else { - Tcl_DStringAppend(&ds, "/",1); - } - ret = TclDoGlob(interp, separators, &ds, p+1, types); - Tcl_DStringFree(&ds); + ret = DoGlob(interp, separators, elt, 1, p+1, types); if (ret != TCL_OK) { break; } @@ -2543,154 +2638,121 @@ TclDoGlob(interp, separators, headPtr, tail, types) } Tcl_DecrRefCount(resultPtr); } - Tcl_DecrRefCount(head); return ret; - } - Tcl_DStringAppend(headPtr, tail, p-tail); - if (*p != '\0') { - return TclDoGlob(interp, separators, headPtr, p, types); } else { - /* - * This is the code path reached by a command like 'glob foo'. - * - * There are no more wildcards in the pattern and no more - * unprocessed characters in the tail, so now we can construct - * the path, and pass it to Tcl_FSMatchInDirectory with an - * empty pattern to verify the existence of the file and check - * it is of the correct type (if a 'types' flag it given -- if - * no such flag was given, we could just use 'Tcl_FSLStat', but - * for simplicity we keep to a common approach). + /* + * We reach here with no pattern char in current section */ + + if (*p != '\0') { + Tcl_Obj *joined; + int ret; + + /* + * If it's not the end of the string, we must recurse + */ + if (pathPtr != NULL) { + if (flags) { + joined = TclNewFSPathObj(pathPtr, pattern, p-pattern); + } else { + joined = Tcl_DuplicateObj(pathPtr); + Tcl_AppendToObj(joined, pattern, p-pattern); + } + } else { + joined = Tcl_NewStringObj(pattern, p-pattern); + } + Tcl_IncrRefCount(joined); + ret = DoGlob(interp, separators, joined, 1, p, types); + Tcl_DecrRefCount(joined); + return ret; + } else { + /* + * This is the code path reached by a command like 'glob foo'. + * + * There are no more wildcards in the pattern and no more + * unprocessed characters in the pattern, so now we can construct + * the path, and pass it to Tcl_FSMatchInDirectory with an + * empty pattern to verify the existence of the file and check + * it is of the correct type (if a 'types' flag it given -- if + * no such flag was given, we could just use 'Tcl_FSLStat', but + * for simplicity we keep to a common approach). + */ - Tcl_Obj *nameObj; + Tcl_Obj *joined; + int length; + Tcl_DString append; + + Tcl_DStringInit(&append); + Tcl_DStringAppend(&append, pattern, p-pattern); - switch (tclPlatform) { - case TCL_PLATFORM_MAC: { - if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) { - Tcl_DStringAppend(headPtr, ":", 1); - } - break; + if (pathPtr != NULL) { + Tcl_GetStringFromObj(pathPtr, &length); + } else { + length = 0; } - case TCL_PLATFORM_WINDOWS: { - if (Tcl_DStringLength(headPtr) == 0) { - if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) - || (*name == '/')) { - Tcl_DStringAppend(headPtr, "/", 1); - } else { - Tcl_DStringAppend(headPtr, ".", 1); + + switch (tclPlatform) { + case TCL_PLATFORM_MAC: { + if (strchr(Tcl_DStringValue(&append), ':') == NULL) { + Tcl_DStringAppend(&append, ":", 1); } + break; } -#if defined(__CYGWIN__) && defined(__WIN32__) - { - extern int cygwin_conv_to_win32_path - _ANSI_ARGS_((CONST char *, char *)); - char winbuf[MAX_PATH+1]; - - cygwin_conv_to_win32_path(Tcl_DStringValue(headPtr), winbuf); - Tcl_DStringFree(headPtr); - Tcl_DStringAppend(headPtr, winbuf, -1); + case TCL_PLATFORM_WINDOWS: { + if (length == 0 && (Tcl_DStringLength(&append) == 0)) { + if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) + || (*name == '/')) { + Tcl_DStringAppend(&append, "/", 1); + } else { + Tcl_DStringAppend(&append, ".", 1); + } + } + #if defined(__CYGWIN__) && defined(__WIN32__) + { + extern int cygwin_conv_to_win32_path + _ANSI_ARGS_((CONST char *, char *)); + char winbuf[MAX_PATH+1]; + + cygwin_conv_to_win32_path(Tcl_DStringValue(&append), winbuf); + Tcl_DStringFree(&append); + Tcl_DStringAppend(&append, winbuf, -1); + } + #endif /* __CYGWIN__ && __WIN32__ */ + break; } -#endif /* __CYGWIN__ && __WIN32__ */ - /* - * Convert to forward slashes. This is required to pass - * some Tcl tests. We should probably remove the conversions - * here and in tclWinFile.c, since they aren't needed since - * the dropping of support for Win32s. - */ - for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) { - if (*p == '\\') { - *p = '/'; + case TCL_PLATFORM_UNIX: { + if (length == 0 && (Tcl_DStringLength(&append) == 0)) { + if ((*name == '\\' && name[1] == '/') || (*name == '/')) { + Tcl_DStringAppend(&append, "/", 1); + } else { + Tcl_DStringAppend(&append, ".", 1); + } } + break; } - break; } - case TCL_PLATFORM_UNIX: { - if (Tcl_DStringLength(headPtr) == 0) { - if ((*name == '\\' && name[1] == '/') || (*name == '/')) { - Tcl_DStringAppend(headPtr, "/", 1); - } else { - Tcl_DStringAppend(headPtr, ".", 1); - } + /* Common for all platforms */ + if (pathPtr != NULL) { + if (flags) { + joined = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append), + Tcl_DStringLength(&append)); + } else { + joined = Tcl_DuplicateObj(pathPtr); + Tcl_AppendToObj(joined, Tcl_DStringValue(&append), + Tcl_DStringLength(&append)); } - break; + } else { + joined = Tcl_NewStringObj(Tcl_DStringValue(&append), + Tcl_DStringLength(&append)); } + Tcl_IncrRefCount(joined); + Tcl_DStringFree(&append); + Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), joined, + NULL, types); + Tcl_DecrRefCount(joined); + return TCL_OK; } - /* Common for all platforms */ - name = Tcl_DStringValue(headPtr); - nameObj = Tcl_NewStringObj(name, Tcl_DStringLength(headPtr)); - - Tcl_IncrRefCount(nameObj); - Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp), nameObj, - NULL, types); - Tcl_DecrRefCount(nameObj); - return TCL_OK; - } -} - - -/* - *--------------------------------------------------------------------------- - * - * TclFileDirname - * - * This procedure calculates the directory above a given - * path: basically 'file dirname'. It is used both by - * the 'dirname' subcommand of file and by code in tclIOUtil.c. - * - * Results: - * NULL if an error occurred, otherwise a Tcl_Obj owned by - * the caller (i.e. most likely with refCount 1). - * - * Side effects: - * None. - * - *--------------------------------------------------------------------------- - */ - -Tcl_Obj* -TclFileDirname(interp, pathPtr) - Tcl_Interp *interp; /* Used for error reporting */ - Tcl_Obj *pathPtr; /* Path to take dirname of */ -{ - int splitElements; - Tcl_Obj *splitPtr; - Tcl_Obj *splitResultPtr = NULL; - - /* - * The behaviour we want here is slightly different to - * the standard Tcl_FSSplitPath in the handling of home - * directories; Tcl_FSSplitPath preserves the "~" while - * this code computes the actual full path name, if we - * had just a single component. - */ - splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); - if ((splitElements == 1) && (Tcl_GetString(pathPtr)[0] == '~')) { - Tcl_DecrRefCount(splitPtr); - splitPtr = Tcl_FSGetNormalizedPath(interp, pathPtr); - if (splitPtr == NULL) { - return NULL; - } - splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements); - } - - /* - * Return all but the last component. If there is only one - * component, return it if the path was non-relative, otherwise - * return the current directory. - */ - - if (splitElements > 1) { - splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); - } else if (splitElements == 0 || - (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { - splitResultPtr = Tcl_NewStringObj( - ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1); - } else { - Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr); } - Tcl_IncrRefCount(splitResultPtr); - Tcl_DecrRefCount(splitPtr); - return splitResultPtr; } /* diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index e7e9421..8d0ab34 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -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: tclFileSystem.h,v 1.5 2003/10/10 15:50:35 dkf Exp $ + * RCS: @(#) $Id: tclFileSystem.h,v 1.6 2004/01/21 19:59:33 vincentdarley Exp $ */ /* @@ -50,6 +50,7 @@ typedef struct ThreadSpecificData { int cwdPathEpoch; int filesystemEpoch; Tcl_Obj *cwdPathPtr; + ClientData cwdClientData; FilesystemRecord *filesystemList; } ThreadSpecificData; @@ -61,19 +62,19 @@ typedef struct ThreadSpecificData { * These functions are not exported at all at present. */ -int TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj* objPtr)); +int TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj** pathPtrPtr)); int TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, ClientData clientData)); + Tcl_Obj *pathPtr, ClientData clientData)); int TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr)); Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, Tcl_Obj *cwdPtr)); + Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr)); Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_(( Tcl_Filesystem *fromFilesystem, ClientData clientData, FilesystemRecord **fsRecPtrPtr)); -int TclFSEnsureEpochOk _ANSI_ARGS_((Tcl_Obj* pathObjPtr, +int TclFSEnsureEpochOk _ANSI_ARGS_((Tcl_Obj* pathPtr, Tcl_Filesystem **fsPtrPtr)); -void TclFSSetPathDetails _ANSI_ARGS_((Tcl_Obj *pathObjPtr, +void TclFSSetPathDetails _ANSI_ARGS_((Tcl_Obj *pathPtr, FilesystemRecord *fsRecPtr, ClientData clientData )); Tcl_Obj* TclFSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr, ClientData *clientDataPtr)); @@ -87,10 +88,10 @@ extern Tcl_ThreadDataKey tclFsDataKey; /* * Private shared functions for use by tclIOUtil.c and tclPathObj.c */ -Tcl_PathType TclFSGetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, +Tcl_PathType TclFSGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr)); -Tcl_PathType TclGetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, +Tcl_PathType TclGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Filesystem **filesystemPtrPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); Tcl_FSPathInFilesystemProc TclNativePathInFilesystem; diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index c47e07f..738f182 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.92 2004/01/09 15:22:46 vincentdarley Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.93 2004/01/21 19:59:33 vincentdarley Exp $ */ #include "tclInt.h" @@ -35,13 +35,16 @@ * Prototypes for procedures defined later in this file. */ -static FilesystemRecord* FsGetFirstFilesystem _ANSI_ARGS_((void)); -static void FsThrExitProc _ANSI_ARGS_((ClientData cd)); -static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr, - CONST char *pattern)); -static Tcl_Obj* FsAddMountsToGlobResult _ANSI_ARGS_((Tcl_Obj *result, - Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)); - +static FilesystemRecord* FsGetFirstFilesystem _ANSI_ARGS_((void)); +static void FsThrExitProc _ANSI_ARGS_((ClientData cd)); +static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr, + CONST char *pattern)); +static Tcl_Obj* FsAddMountsToGlobResult _ANSI_ARGS_((Tcl_Obj *result, + Tcl_Obj *pathPtr, CONST char *pattern, + Tcl_GlobTypeData *types)); +static void FsUpdateCwd _ANSI_ARGS_((Tcl_Obj *cwdObj, + ClientData clientData)); + #ifdef TCL_THREADS static void FsRecacheFilesystemList(void); #endif @@ -297,7 +300,6 @@ TCL_DECLARE_MUTEX(obsoleteFsHookMutex) */ static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator; static Tcl_FSFreeInternalRepProc NativeFreeInternalRep; -Tcl_FSDupInternalRepProc TclNativeDupInternalRep; static Tcl_FSCreateInternalRepProc NativeCreateNativeRep; static Tcl_FSFileAttrStringsProc NativeFileAttrStrings; static Tcl_FSFileAttrsGetProc NativeFileAttrsGet; @@ -318,7 +320,6 @@ Tcl_FSInternalToNormalizedProc TclpNativeToNormalized; Tcl_FSStatProc TclpObjStat; Tcl_FSAccessProc TclpObjAccess; Tcl_FSMatchInDirectoryProc TclpMatchInDirectory; -Tcl_FSGetCwdProc TclpObjGetCwd; Tcl_FSChdirProc TclpObjChdir; Tcl_FSLstatProc TclpObjLstat; Tcl_FSCopyFileProc TclpObjCopyFile; @@ -342,7 +343,7 @@ Tcl_FSListVolumesProc TclpObjListVolumes; Tcl_Filesystem tclNativeFilesystem = { "native", sizeof(Tcl_Filesystem), - TCL_FILESYSTEM_VERSION_1, + TCL_FILESYSTEM_VERSION_2, &TclNativePathInFilesystem, &TclNativeDupInternalRep, &NativeFreeInternalRep, @@ -373,7 +374,8 @@ Tcl_Filesystem tclNativeFilesystem = { &TclpObjCopyDirectory, &TclpObjLstat, &TclpDlopen, - &TclpObjGetCwd, + /* Needs a cast since we're using version_2 */ + (Tcl_FSGetCwdProc*)&TclpGetNativeCwd, &TclpObjChdir }; @@ -415,6 +417,7 @@ TCL_DECLARE_MUTEX(filesystemMutex) */ static Tcl_Obj* cwdPathPtr = NULL; static int cwdPathEpoch = 0; +static ClientData cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) Tcl_ThreadDataKey tclFsDataKey; @@ -454,6 +457,9 @@ FsThrExitProc(cd) if (tsdPtr->cwdPathPtr != NULL) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); } + if (tsdPtr->cwdClientData != NULL) { + NativeFreeInternalRep(tsdPtr->cwdClientData); + } /* Trash the filesystems cache */ fsRecPtr = tsdPtr->filesystemList; while (fsRecPtr != NULL) { @@ -465,24 +471,53 @@ FsThrExitProc(cd) } } +/* + *---------------------------------------------------------------------- + * + * TclFSCwdPointerEquals -- + * + * Check whether the current working directory is equal to the + * path given. + * + * Results: + * 1 (equal) or 0 (un-equal) as appropriate. + * + * Side effects: + * If the paths are equal, but are not the same object, this + * method will modify the given pathPtrPtr to refer to the same + * object. In this case the object pointed to by pathPtrPtr will + * have its refCount decremented, and it will be adjusted to + * point to the cwd (with a new refCount). + * + *---------------------------------------------------------------------- + */ + int -TclFSCwdPointerEquals(objPtr) - Tcl_Obj* objPtr; +TclFSCwdPointerEquals(pathPtrPtr) + Tcl_Obj** pathPtrPtr; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); Tcl_MutexLock(&cwdMutex); if (tsdPtr->cwdPathPtr == NULL || tsdPtr->cwdPathEpoch != cwdPathEpoch) { - if (tsdPtr->cwdPathPtr) { + if (tsdPtr->cwdPathPtr != NULL) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); } + if (tsdPtr->cwdClientData != NULL) { + NativeFreeInternalRep(tsdPtr->cwdClientData); + } if (cwdPathPtr == NULL) { tsdPtr->cwdPathPtr = NULL; } else { tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr); Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } + if (cwdClientData == NULL) { + tsdPtr->cwdClientData = NULL; + } else { + tsdPtr->cwdClientData = TclNativeDupInternalRep(cwdClientData); + } tsdPtr->cwdPathEpoch = cwdPathEpoch; } Tcl_MutexUnlock(&cwdMutex); @@ -492,7 +527,30 @@ TclFSCwdPointerEquals(objPtr) tsdPtr->initialized = 1; } - return (tsdPtr->cwdPathPtr == objPtr); + if (pathPtrPtr == NULL) { + return (tsdPtr->cwdPathPtr == NULL); + } + + if (tsdPtr->cwdPathPtr == *pathPtrPtr) { + return 1; + } else { + int len1, len2; + CONST char *str1, *str2; + str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); + str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2); + if (len1 == len2 && !strcmp(str1,str2)) { + /* + * They are equal, but different objects. Update so they + * will be the same object in the future. + */ + Tcl_DecrRefCount(*pathPtrPtr); + *pathPtrPtr = tsdPtr->cwdPathPtr; + Tcl_IncrRefCount(*pathPtrPtr); + return 1; + } else { + return 0; + } + } } #ifdef TCL_THREADS @@ -568,9 +626,13 @@ FsGetFirstFilesystem(void) { return fsRecPtr; } +/* + * If non-NULL, clientData is owned by us and must be freed later. + */ static void -FsUpdateCwd(cwdObj) +FsUpdateCwd(cwdObj, clientData) Tcl_Obj *cwdObj; + ClientData clientData; { int len; char *str = NULL; @@ -584,12 +646,17 @@ FsUpdateCwd(cwdObj) if (cwdPathPtr != NULL) { Tcl_DecrRefCount(cwdPathPtr); } + if (cwdClientData != NULL) { + NativeFreeInternalRep(cwdClientData); + } if (cwdObj == NULL) { cwdPathPtr = NULL; + cwdClientData = NULL; } else { /* This must be stored as string obj! */ cwdPathPtr = Tcl_NewStringObj(str, len); Tcl_IncrRefCount(cwdPathPtr); + cwdClientData = TclNativeDupInternalRep(clientData); } cwdPathEpoch++; tsdPtr->cwdPathEpoch = cwdPathEpoch; @@ -598,10 +665,15 @@ FsUpdateCwd(cwdObj) if (tsdPtr->cwdPathPtr) { Tcl_DecrRefCount(tsdPtr->cwdPathPtr); } + if (tsdPtr->cwdClientData) { + NativeFreeInternalRep(tsdPtr->cwdClientData); + } if (cwdObj == NULL) { tsdPtr->cwdPathPtr = NULL; + tsdPtr->cwdClientData = NULL; } else { tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len); + tsdPtr->cwdClientData = clientData; Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } } @@ -641,6 +713,10 @@ TclFinalizeFilesystem() cwdPathPtr = NULL; cwdPathEpoch = 0; } + if (cwdClientData != NULL) { + NativeFreeInternalRep(cwdClientData); + cwdClientData = NULL; + } /* * Remove all filesystems, freeing any allocated memory @@ -922,7 +998,13 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) * May be NULL. In particular the directory * flag is very important. */ { - Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); + Tcl_Filesystem *fsPtr; + if (pathPtr != NULL) { + fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); + } else { + fsPtr = NULL; + } + if (fsPtr != NULL) { Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc; if (proc != NULL) { @@ -1024,10 +1106,12 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) */ static Tcl_Obj* FsAddMountsToGlobResult(result, pathPtr, pattern, types) - Tcl_Obj *result; /* The current list of matching paths */ - Tcl_Obj *pathPtr; /* The directory in question */ - CONST char *pattern; - Tcl_GlobTypeData *types; + Tcl_Obj *result; /* The current list of matching paths */ + Tcl_Obj *pathPtr; /* The directory in question */ + CONST char *pattern; /* Pattern to match against. */ + Tcl_GlobTypeData *types; /* Object containing list of acceptable types. + * May be NULL. In particular the directory + * flag is very important. */ { int mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); @@ -1234,10 +1318,13 @@ Tcl_FSData(fsPtr) */ int TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) - Tcl_Interp *interp; - Tcl_Obj *pathPtr; - int startAt; - ClientData *clientDataPtr; + Tcl_Interp *interp; /* Used for error messages. */ + Tcl_Obj *pathPtr; /* The path to normalize in place */ + int startAt; /* Start at this char-offset */ + ClientData *clientDataPtr; /* If we generated a complete + * normalized path for a given + * filesystem, we can optionally return + * an fs-specific clientdata here. */ { FilesystemRecord *fsRecPtr, *firstFsRecPtr; /* Ignore this variable */ @@ -1497,7 +1584,8 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName) Tcl_Interp *interp; /* Interpreter in which to process file. */ Tcl_Obj *pathPtr; /* Path of file to process. Tilde-substitution * will be performed on this name. */ - CONST char *encodingName; + CONST char *encodingName; /* If non-NULL, then use this encoding + * for the file. */ { int result, length; Tcl_StatBuf statBuf; @@ -1540,7 +1628,7 @@ Tcl_FSEvalFileEx(interp, pathPtr, encodingName) * Else don't touch it (and use the system encoding) * Report error on unknown encoding. */ - if (encodingName) { + if (encodingName != NULL) { if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { Tcl_Close(interp,chan); @@ -2307,7 +2395,48 @@ Tcl_FSGetCwd(interp) while ((retVal == NULL) && (fsRecPtr != NULL)) { Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc; if (proc != NULL) { - retVal = (*proc)(interp); + if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) { + ClientData retCd; + TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc; + + retCd = (*proc2)(NULL); + if (retCd != NULL) { + Tcl_Obj *norm; + /* Looks like a new current directory */ + retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(retCd); + Tcl_IncrRefCount(retVal); + norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); + if (norm != NULL) { + /* + * We found a cwd, which is now in our global storage. + * We must make a copy. Norm already has a refCount of 1. + * + * Threading issue: note that multiple threads at system + * startup could in principle call this procedure + * simultaneously. They will therefore each set the + * cwdPathPtr independently. That behaviour is a bit + * peculiar, but should be fine. Once we have a cwd, + * we'll always be in the 'else' branch below which + * is simpler. + */ + FsUpdateCwd(norm, retCd); + Tcl_DecrRefCount(norm); + } else { + (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd); + } + Tcl_DecrRefCount(retVal); + retVal = NULL; + goto cdDidNotChange; + } else { + if (interp != NULL) { + Tcl_AppendResult(interp, + "error getting working directory name: ", + Tcl_PosixError(interp), (char *) NULL); + } + } + } else { + retVal = (*proc)(interp); + } } fsRecPtr = fsRecPtr->nextPtr; } @@ -2334,7 +2463,8 @@ Tcl_FSGetCwd(interp) * we'll always be in the 'else' branch below which * is simpler. */ - FsUpdateCwd(norm); + ClientData cd = (ClientData) Tcl_FSGetNativePath(norm); + FsUpdateCwd(norm, TclNativeDupInternalRep(cd)); Tcl_DecrRefCount(norm); } Tcl_DecrRefCount(retVal); @@ -2359,10 +2489,32 @@ Tcl_FSGetCwd(interp) */ if (fsPtr != NULL) { Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc; + ClientData retCd = NULL; if (proc != NULL) { - Tcl_Obj *retVal = (*proc)(interp); + Tcl_Obj *retVal; + if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) { + TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc; + + retCd = (*proc2)(tsdPtr->cwdClientData); + if (retCd == NULL && interp != NULL) { + Tcl_AppendResult(interp, + "error getting working directory name: ", + Tcl_PosixError(interp), (char *) NULL); + } + + if (retCd == tsdPtr->cwdClientData) { + goto cdDidNotChange; + } + + /* Looks like a new current directory */ + retVal = (*fsPtr->internalToNormalizedProc)(retCd); + Tcl_IncrRefCount(retVal); + } else { + retVal = (*proc)(interp); + } if (retVal != NULL) { - Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL); + Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, + NULL); /* * Check whether cwd has changed from the value * previously stored in cwdPathPtr. Really 'norm' @@ -2370,6 +2522,9 @@ Tcl_FSGetCwd(interp) */ if (norm == NULL) { /* Do nothing */ + if (retCd != NULL) { + (*fsPtr->freeInternalRepProc)(retCd); + } } else if (Tcl_FSEqualPaths(tsdPtr->cwdPathPtr, norm)) { /* * If the paths were equal, we can be more @@ -2379,19 +2534,23 @@ Tcl_FSGetCwd(interp) * path we just calculated. */ Tcl_DecrRefCount(norm); + if (retCd != NULL) { + (*fsPtr->freeInternalRepProc)(retCd); + } } else { - FsUpdateCwd(norm); + FsUpdateCwd(norm, retCd); Tcl_DecrRefCount(norm); } Tcl_DecrRefCount(retVal); } else { /* The 'cwd' function returned an error; reset the cwd */ - FsUpdateCwd(NULL); + FsUpdateCwd(NULL, NULL); } } } } + cdDidNotChange: if (tsdPtr->cwdPathPtr != NULL) { Tcl_IncrRefCount(tsdPtr->cwdPathPtr); } @@ -2469,11 +2628,13 @@ Tcl_FSChdir(pathPtr) * will have been cached as a result of the * Tcl_FSGetFileSystemForPath call above anyway). */ + ClientData cd; Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normDirName == NULL) { return TCL_ERROR; } - FsUpdateCwd(normDirName); + cd = (ClientData) Tcl_FSGetNativePath(pathPtr); + FsUpdateCwd(normDirName, TclNativeDupInternalRep(cd)); } } else { Tcl_SetErrno(ENOENT); @@ -3239,10 +3400,13 @@ TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr) */ Tcl_PathType -TclGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef) - Tcl_Obj *pathObjPtr; - Tcl_Filesystem **filesystemPtrPtr; - int *driveNameLengthPtr; +TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef) + Tcl_Obj *pathPtr; /* Path to determine type for */ + Tcl_Filesystem **filesystemPtrPtr; /* If absolute path and this is + * non-NULL, then set to the + * filesystem which claims this + * path */ + int *driveNameLengthPtr; Tcl_Obj **driveNameRef; { FilesystemRecord *fsRecPtr; @@ -3250,7 +3414,7 @@ TclGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef) char *path; Tcl_PathType type = TCL_PATH_RELATIVE; - path = Tcl_GetStringFromObj(pathObjPtr, &pathLen); + path = Tcl_GetStringFromObj(pathPtr, &pathLen); /* * Call each of the "listVolumes" function in succession, checking @@ -3335,7 +3499,7 @@ TclGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef) } if (type != TCL_PATH_ABSOLUTE) { - type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, + type = TclpGetNativePathType(pathPtr, driveNameLengthPtr, driveNameRef); if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) { *filesystemPtrPtr = &tclNativeFilesystem; @@ -3655,7 +3819,8 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr) * the cwd is inside the directory, so we * perform a 'cd [file dirname $path]' */ - Tcl_Obj *dirPtr = TclFileDirname(NULL, pathPtr); + Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr, + TCL_PATH_DIRNAME); Tcl_FSChdir(dirPtr); Tcl_DecrRefCount(dirPtr); } @@ -3690,13 +3855,13 @@ Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr) */ Tcl_Filesystem* -Tcl_FSGetFileSystemForPath(pathObjPtr) - Tcl_Obj* pathObjPtr; +Tcl_FSGetFileSystemForPath(pathPtr) + Tcl_Obj* pathPtr; { FilesystemRecord *fsRecPtr; Tcl_Filesystem* retVal = NULL; - if (pathObjPtr == NULL) { + if (pathPtr == NULL) { Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object"); return NULL; } @@ -3708,7 +3873,7 @@ Tcl_FSGetFileSystemForPath(pathObjPtr) * the ref count on return or not). */ - if (pathObjPtr->refCount == 0) { + if (pathPtr->refCount == 0) { Tcl_Panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0"); return NULL; } @@ -3717,7 +3882,7 @@ Tcl_FSGetFileSystemForPath(pathObjPtr) * Check if the filesystem has changed in some way since * this object's internal representation was calculated. */ - if (TclFSEnsureEpochOk(pathObjPtr, &retVal) != TCL_OK) { + if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) { return NULL; } @@ -3732,13 +3897,13 @@ Tcl_FSGetFileSystemForPath(pathObjPtr) Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc; if (proc != NULL) { ClientData clientData = NULL; - int ret = (*proc)(pathObjPtr, &clientData); + int ret = (*proc)(pathPtr, &clientData); if (ret != -1) { /* - * We assume the type of pathObjPtr hasn't been changed + * We assume the type of pathPtr hasn't been changed * by the above call to the pathInFilesystemProc. */ - TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData); + TclFSSetPathDetails(pathPtr, fsRecPtr, clientData); retVal = fsRecPtr->fsPtr; } } @@ -3781,10 +3946,10 @@ Tcl_FSGetFileSystemForPath(pathObjPtr) */ CONST char * -Tcl_FSGetNativePath(pathObjPtr) - Tcl_Obj *pathObjPtr; +Tcl_FSGetNativePath(pathPtr) + Tcl_Obj *pathPtr; { - return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem); + return (CONST char *)Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem); } /* @@ -3803,19 +3968,26 @@ Tcl_FSGetNativePath(pathObjPtr) *--------------------------------------------------------------------------- */ static ClientData -NativeCreateNativeRep(pathObjPtr) - Tcl_Obj* pathObjPtr; +NativeCreateNativeRep(pathPtr) + Tcl_Obj* pathPtr; { char *nativePathPtr; Tcl_DString ds; - Tcl_Obj* validPathObjPtr; + Tcl_Obj* validPathPtr; int len; char *str; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - /* Make sure the normalized path is set */ - validPathObjPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr); + if (tsdPtr->cwdClientData != NULL) { + /* The cwd is native */ + validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); + } else { + /* Make sure the normalized path is set */ + validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); + Tcl_IncrRefCount(validPathPtr); + } - str = Tcl_GetStringFromObj(validPathObjPtr, &len); + str = Tcl_GetStringFromObj(validPathPtr, &len); #ifdef __WIN32__ Tcl_WinUtfToTChar(str, len, &ds); if (tclWinProcs->useWide) { @@ -3827,6 +3999,7 @@ NativeCreateNativeRep(pathObjPtr) Tcl_UtfToExternalDString(NULL, str, len, &ds); len = Tcl_DStringLength(&ds) + sizeof(char); #endif + Tcl_DecrRefCount(validPathPtr); nativePathPtr = ckalloc((unsigned) len); memcpy((VOID*)nativePathPtr, (VOID*)Tcl_DStringValue(&ds), (size_t) len); @@ -3841,6 +4014,11 @@ NativeCreateNativeRep(pathObjPtr) * * Convert native format to a normalized path object, with refCount * of zero. + * + * Currently assumes all native paths are actually normalized + * already, so if the path given is not normalized this will + * actually just convert to a valid string path, but not + * necessarily a normalized one. * * Results: * A valid normalized path. @@ -3856,12 +4034,14 @@ TclpNativeToNormalized(clientData) { Tcl_DString ds; Tcl_Obj *objPtr; - CONST char *copy; int len; #ifdef __WIN32__ + char *copy; + char *p; Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds); #else + CONST char *copy; Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds); #endif @@ -3883,6 +4063,14 @@ TclpNativeToNormalized(clientData) len -= 4; } } + /* + * Ensure we are using forward slashes only. + */ + for (p = copy; *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; + } + } #endif objPtr = Tcl_NewStringObj(copy,len); @@ -3978,12 +4166,12 @@ NativeFreeInternalRep(clientData) *--------------------------------------------------------------------------- */ Tcl_Obj* -Tcl_FSFileSystemInfo(pathObjPtr) - Tcl_Obj* pathObjPtr; +Tcl_FSFileSystemInfo(pathPtr) + Tcl_Obj* pathPtr; { Tcl_Obj *resPtr; Tcl_FSFilesystemPathTypeProc *proc; - Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr); + Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr == NULL) { return NULL; @@ -3996,7 +4184,7 @@ Tcl_FSFileSystemInfo(pathObjPtr) proc = fsPtr->filesystemPathTypeProc; if (proc != NULL) { - Tcl_Obj *typePtr = (*proc)(pathObjPtr); + Tcl_Obj *typePtr = (*proc)(pathPtr); if (typePtr != NULL) { Tcl_ListObjAppendElement(NULL, resPtr, typePtr); } @@ -4024,16 +4212,16 @@ Tcl_FSFileSystemInfo(pathObjPtr) *--------------------------------------------------------------------------- */ Tcl_Obj* -Tcl_FSPathSeparator(pathObjPtr) - Tcl_Obj* pathObjPtr; +Tcl_FSPathSeparator(pathPtr) + Tcl_Obj* pathPtr; { - Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr); + Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr == NULL) { return NULL; } if (fsPtr->filesystemSeparatorProc != NULL) { - return (*fsPtr->filesystemSeparatorProc)(pathObjPtr); + return (*fsPtr->filesystemSeparatorProc)(pathPtr); } return NULL; @@ -4056,8 +4244,8 @@ Tcl_FSPathSeparator(pathObjPtr) *--------------------------------------------------------------------------- */ static Tcl_Obj* -NativeFilesystemSeparator(pathObjPtr) - Tcl_Obj* pathObjPtr; +NativeFilesystemSeparator(pathPtr) + Tcl_Obj* pathPtr; { char *separator = NULL; /* lint */ switch (tclPlatform) { diff --git a/generic/tclInt.decls b/generic/tclInt.decls index ec6604c..b9dae7e 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.67 2003/12/15 00:49:38 davygrvy Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.68 2004/01/21 19:59:33 vincentdarley Exp $ library tcl @@ -75,10 +75,11 @@ declare 11 generic { declare 12 generic { void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr) } -declare 13 generic { - int TclDoGlob(Tcl_Interp *interp, char *separators, - Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types) -} +# Removed in 8.5 +#declare 13 generic { +# int TclDoGlob(Tcl_Interp *interp, char *separators, +# Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types) +#} declare 14 generic { void TclDumpMemoryInfo(FILE *outFile) } @@ -140,7 +141,7 @@ declare 28 generic { # char *TclGetEnv(CONST char *name) # } declare 31 generic { - char *TclGetExtension(char *name) + CONST char *TclGetExtension(CONST char *name) } declare 32 generic { int TclGetFrame(Tcl_Interp *interp, CONST char *str, diff --git a/generic/tclInt.h b/generic/tclInt.h index 8ab9900..6825d08 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.142 2004/01/18 16:19:06 dkf Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.143 2004/01/21 19:59:33 vincentdarley Exp $ */ #ifndef _TCLINT @@ -1483,6 +1483,22 @@ typedef struct List { Tcl_Obj **elements; /* Array of pointers to element objects. */ } List; +/* + *---------------------------------------------------------------- + * Data structures related to the filesystem internals + *---------------------------------------------------------------- + */ + + +/* + * The version_2 filesystem is private to Tcl. As and when these + * changes have been thoroughly tested and investigated a new public + * filesystem interface will be released. The aim is more versatile + * virtual filesystem interfaces, more efficiency in 'path' manipulation + * and usage, and cleaner filesystem code internally. + */ +#define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) +typedef ClientData (TclFSGetCwdProc2) _ANSI_ARGS_((ClientData clientData)); /* * The following types are used for getting and storing platform-specific @@ -1525,6 +1541,13 @@ typedef struct TclpTime_t_ *TclpTime_t; #define TCL_GLOBMODE_DIR 4 #define TCL_GLOBMODE_TAILS 8 +typedef enum Tcl_PathPart { + TCL_PATH_DIRNAME, + TCL_PATH_TAIL, + TCL_PATH_EXTENSION, + TCL_PATH_ROOT +} Tcl_PathPart; + /* *---------------------------------------------------------------- * Data structures related to obsolete filesystem hooks @@ -1760,7 +1783,7 @@ EXTERN void TclpNativeJoinPath _ANSI_ARGS_((Tcl_Obj *prefix, char *joining)); EXTERN Tcl_Obj* TclpNativeSplitPath _ANSI_ARGS_((Tcl_Obj *pathPtr, int *lenPtr)); -EXTERN Tcl_PathType TclpGetNativePathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, +EXTERN Tcl_PathType TclpGetNativePathType _ANSI_ARGS_((Tcl_Obj *pathPtr, int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); EXTERN int TclCrossFilesystemCopy _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target)); @@ -1776,13 +1799,15 @@ EXTERN int TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr, EXTERN int TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types)); -EXTERN Tcl_Obj* TclpObjGetCwd _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN ClientData TclpGetNativeCwd _ANSI_ARGS_((ClientData clientData)); +EXTERN Tcl_FSDupInternalRepProc TclNativeDupInternalRep; EXTERN Tcl_Obj* TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkType)); EXTERN int TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr)); -EXTERN Tcl_Obj* TclFileDirname _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj*pathPtr)); -EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf)); +EXTERN Tcl_Obj* TclPathPart _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *pathPtr, Tcl_PathPart portion)); +EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, + Tcl_StatBuf *buf)); EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions)); @@ -1818,7 +1843,7 @@ EXTERN void TclTransferResult _ANSI_ARGS_((Tcl_Interp *sourceInterp, EXTERN Tcl_Obj* TclpNativeToNormalized _ANSI_ARGS_((ClientData clientData)); EXTERN Tcl_Obj* TclpFilesystemPathType - _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); + _ANSI_ARGS_((Tcl_Obj* pathPtr)); EXTERN Tcl_PackageInitProc* TclpFindSymbol _ANSI_ARGS_((Tcl_Interp *interp, Tcl_LoadHandle loadHandle, CONST char *symbol)); EXTERN int TclpDlopen _ANSI_ARGS_((Tcl_Interp *interp, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 429c6cc..0d2e455 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.55 2003/12/15 00:49:38 davygrvy Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.56 2004/01/21 19:59:33 vincentdarley Exp $ */ #ifndef _TCLINTDECLS @@ -124,13 +124,7 @@ EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_(( EXTERN void TclDeleteVars _ANSI_ARGS_((Interp * iPtr, Tcl_HashTable * tablePtr)); #endif -#ifndef TclDoGlob_TCL_DECLARED -#define TclDoGlob_TCL_DECLARED -/* 13 */ -EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp * interp, - char * separators, Tcl_DString * headPtr, - char * tail, Tcl_GlobTypeData * types)); -#endif +/* Slot 13 is reserved */ #ifndef TclDumpMemoryInfo_TCL_DECLARED #define TclDumpMemoryInfo_TCL_DECLARED /* 14 */ @@ -190,7 +184,7 @@ EXTERN Tcl_Channel TclpGetDefaultStdChannel _ANSI_ARGS_((int type)); #ifndef TclGetExtension_TCL_DECLARED #define TclGetExtension_TCL_DECLARED /* 31 */ -EXTERN char * TclGetExtension _ANSI_ARGS_((char * name)); +EXTERN CONST char * TclGetExtension _ANSI_ARGS_((CONST char * name)); #endif #ifndef TclGetFrame_TCL_DECLARED #define TclGetFrame_TCL_DECLARED @@ -991,7 +985,7 @@ typedef struct TclIntStubs { int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp * interp, Namespace * nsPtr, CONST char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)); /* 10 */ void (*tclDeleteCompiledLocalVars) _ANSI_ARGS_((Interp * iPtr, CallFrame * framePtr)); /* 11 */ void (*tclDeleteVars) _ANSI_ARGS_((Interp * iPtr, Tcl_HashTable * tablePtr)); /* 12 */ - int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail, Tcl_GlobTypeData * types)); /* 13 */ + void *reserved13; void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */ void *reserved15; void (*tclExprFloatError) _ANSI_ARGS_((Tcl_Interp * interp, double value)); /* 16 */ @@ -1009,7 +1003,7 @@ typedef struct TclIntStubs { Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */ void *reserved29; void *reserved30; - char * (*tclGetExtension) _ANSI_ARGS_((char * name)); /* 31 */ + CONST char * (*tclGetExtension) _ANSI_ARGS_((CONST char * name)); /* 31 */ int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CallFrame ** framePtrPtr)); /* 32 */ TclCmdProcType (*tclGetInterpProc) _ANSI_ARGS_((void)); /* 33 */ int (*tclGetIntForIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr)); /* 34 */ @@ -1246,10 +1240,7 @@ extern TclIntStubs *tclIntStubsPtr; #define TclDeleteVars \ (tclIntStubsPtr->tclDeleteVars) /* 12 */ #endif -#ifndef TclDoGlob -#define TclDoGlob \ - (tclIntStubsPtr->tclDoGlob) /* 13 */ -#endif +/* Slot 13 is reserved */ #ifndef TclDumpMemoryInfo #define TclDumpMemoryInfo \ (tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */ diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 30bffcc..acb16b7 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.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: tclPathObj.c,v 1.19 2003/12/24 04:18:20 davygrvy Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.20 2004/01/21 19:59:33 vincentdarley Exp $ */ #include "tclInt.h" @@ -26,12 +26,13 @@ static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)); -static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr)); -static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *pathPtr)); +static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr)); static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr)); + Tcl_Obj *pathPtr)); static int FindSplitPos _ANSI_ARGS_((CONST char *path, int separator)); static int IsSeparatorOrNull _ANSI_ARGS_((int ch)); +static Tcl_Obj* GetExtension _ANSI_ARGS_((Tcl_Obj *pathPtr)); /* @@ -54,8 +55,25 @@ Tcl_ObjType tclFsPathType = { * certain optimisations when used to represent paths which are * already normalized and absolute. * - * Note that 'normPathPtr' can be a circular reference to the - * container Tcl_Obj of this FsPath. + * Note that both 'translatedPathPtr' and 'normPathPtr' can be a + * circular reference to the container Tcl_Obj of this FsPath. + * + * There are two cases, with the first being the most common: + * + * (i) flags == 0, => Ordinary path. + * + * translatedPathPtr contains the translated path (which may be + * a circular reference to the object itself). If it is NULL + * then the path is pure normalized (and the normPathPtr will be + * a circular reference). cwdPtr is null for an absolute path, + * and non-null for a relative path (unless the cwd has never been + * set, in which case the cwdPtr may also be null for a relative path). + * + * (ii) flags != 0, => Special path, see TclNewFSPathObj + * + * Now, this is a path like 'file join $dir $tail' where, cwdPtr is + * the $dir and normPathPtr is the $tail. + * */ typedef struct FsPath { Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. @@ -75,7 +93,8 @@ typedef struct FsPath { * this points to the cwd object used * for this path. We have a refCount * on the object. */ - int flags; /* Flags to describe interpretation */ + int flags; /* Flags to describe interpretation - + * see below. */ ClientData nativePathPtr; /* Native representation of this path, * which is filesystem dependent. */ int filesystemEpoch; /* Used to ensure the path representation @@ -87,16 +106,19 @@ typedef struct FsPath { * entry to use for this path. */ } FsPath; +/* + * Flag values for FsPath->flags. + */ +#define TCLPATH_APPENDED 1 + /* * Define some macros to give us convenient access to path-object * specific fields. */ -#define PATHOBJ(objPtr) (objPtr->internalRep.otherValuePtr) -#define PATHFLAGS(objPtr) \ - (((FsPath*)(objPtr->internalRep.otherValuePtr))->flags) +#define PATHOBJ(pathPtr) (pathPtr->internalRep.otherValuePtr) +#define PATHFLAGS(pathPtr) \ + (((FsPath*)(pathPtr->internalRep.otherValuePtr))->flags) -#define TCLPATH_APPENDED 1 -#define TCLPATH_RELATIVE 2 /* *--------------------------------------------------------------------------- @@ -344,10 +366,10 @@ TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr) */ Tcl_PathType -Tcl_FSGetPathType(pathObjPtr) - Tcl_Obj *pathObjPtr; +Tcl_FSGetPathType(pathPtr) + Tcl_Obj *pathPtr; { - return TclFSGetPathType(pathObjPtr, NULL, NULL); + return TclFSGetPathType(pathPtr, NULL, NULL); } /* @@ -375,24 +397,24 @@ Tcl_FSGetPathType(pathObjPtr) */ Tcl_PathType -TclFSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) - Tcl_Obj *pathObjPtr; +TclFSGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr) + Tcl_Obj *pathPtr; Tcl_Filesystem **filesystemPtrPtr; int *driveNameLengthPtr; { - if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) { - return TclGetPathType(pathObjPtr, filesystemPtrPtr, + if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } else { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); if (fsPathPtr->cwdPtr != NULL) { - if (PATHFLAGS(pathObjPtr) == 0) { + if (PATHFLAGS(pathPtr) == 0) { return TCL_PATH_RELATIVE; } return TclFSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr, driveNameLengthPtr); } else { - return TclGetPathType(pathObjPtr, filesystemPtrPtr, + return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); } } @@ -401,6 +423,205 @@ TclFSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) /* *--------------------------------------------------------------------------- * + * TclPathPart + * + * This procedure calculates the requested part of the the given + * path, which can be: + * + * - the directory above ('file dirname') + * - the tail ('file tail') + * - the extension ('file extension') + * - the root ('file root') + * + * The 'portion' parameter dictates which of these to calculate. + * There are a number of special cases both to be more efficient, + * and because the behaviour when given a path with only a single + * element is defined to require the expansion of that single + * element, where possible. + * + * Should look into integrating 'FileBasename' in tclFCmd.c into + * this function. + * + * Results: + * NULL if an error occurred, otherwise a Tcl_Obj owned by + * the caller (i.e. most likely with refCount 1). + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +Tcl_Obj* +TclPathPart(interp, pathPtr, portion) + Tcl_Interp *interp; /* Used for error reporting */ + Tcl_Obj *pathPtr; /* Path to take dirname of */ + Tcl_PathPart portion; /* Requested portion of name */ +{ + if (pathPtr->typePtr == &tclFsPathType) { + FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + if (PATHFLAGS(pathPtr) != 0) { + switch (portion) { + case TCL_PATH_DIRNAME: { + Tcl_IncrRefCount(fsPathPtr->cwdPtr); + return fsPathPtr->cwdPtr; + } + case TCL_PATH_TAIL: { + Tcl_IncrRefCount(fsPathPtr->normPathPtr); + return fsPathPtr->normPathPtr; + } + case TCL_PATH_EXTENSION: { + return GetExtension(fsPathPtr->normPathPtr); + } + case TCL_PATH_ROOT: { + /* Unimplemented */ + CONST char *fileName, *extension; + int length; + fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, + &length); + extension = TclGetExtension(fileName); + if (extension == NULL) { + /* + * There is no extension so the root is the + * same as the path we were given. + */ + Tcl_IncrRefCount(pathPtr); + return pathPtr; + } else { + /* + * Duplicate the object we were given and + * then trim off the extension of the + * tail component of the path. + */ + Tcl_Obj *root; + FsPath *fsDupPtr; + root = Tcl_DuplicateObj(pathPtr); + Tcl_IncrRefCount(root); + fsDupPtr = (FsPath*) PATHOBJ(root); + if (Tcl_IsShared(fsDupPtr->normPathPtr)) { + Tcl_DecrRefCount(fsDupPtr->normPathPtr); + fsDupPtr->normPathPtr = Tcl_NewStringObj(fileName, + (int)(length - strlen(extension))); + Tcl_IncrRefCount(fsDupPtr->normPathPtr); + } else { + Tcl_SetObjLength(fsDupPtr->normPathPtr, + (int)(length - strlen(extension))); + } + return root; + } + } + } + } else if (fsPathPtr->cwdPtr != NULL) { + /* Relative path */ + goto standardPath; + } else { + /* Absolute path */ + goto standardPath; + } + } else { + int splitElements; + Tcl_Obj *splitPtr; + Tcl_Obj *resultPtr = NULL; + standardPath: + + if (portion == TCL_PATH_EXTENSION) { + return GetExtension(pathPtr); + } else if (portion == TCL_PATH_ROOT) { + int length; + CONST char *fileName, *extension; + + fileName = Tcl_GetStringFromObj(pathPtr, &length); + extension = TclGetExtension(fileName); + if (extension == NULL) { + Tcl_IncrRefCount(pathPtr); + return pathPtr; + } else { + Tcl_Obj *root = Tcl_NewStringObj(fileName, + (int) (length - strlen(extension))); + Tcl_IncrRefCount(root); + return root; + } + } + + /* + * The behaviour we want here is slightly different to + * the standard Tcl_FSSplitPath in the handling of home + * directories; Tcl_FSSplitPath preserves the "~" while + * this code computes the actual full path name, if we + * had just a single component. + */ + splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements); + Tcl_IncrRefCount(splitPtr); + if ((splitElements == 1) && (Tcl_GetString(pathPtr)[0] == '~')) { + Tcl_Obj *norm; + + Tcl_DecrRefCount(splitPtr); + norm = Tcl_FSGetNormalizedPath(interp, pathPtr); + if (norm == NULL) { + return NULL; + } + splitPtr = Tcl_FSSplitPath(norm, &splitElements); + Tcl_IncrRefCount(splitPtr); + } + if (portion == TCL_PATH_TAIL) { + /* + * Return the last component, unless it is the only component, + * and it is the root of an absolute path. + */ + + if ((splitElements > 0) && ((splitElements > 1) + || (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) { + Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr); + } else { + resultPtr = Tcl_NewObj(); + } + } else { + /* + * Return all but the last component. If there is only one + * component, return it if the path was non-relative, otherwise + * return the current directory. + */ + + if (splitElements > 1) { + resultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); + } else if (splitElements == 0 || + (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) { + resultPtr = Tcl_NewStringObj( + ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1); + } else { + Tcl_ListObjIndex(NULL, splitPtr, 0, &resultPtr); + } + } + Tcl_IncrRefCount(resultPtr); + Tcl_DecrRefCount(splitPtr); + return resultPtr; + } +} + +/* + * Simple helper function + */ +static Tcl_Obj* +GetExtension(pathPtr) + Tcl_Obj *pathPtr; +{ + CONST char *tail, *extension; + Tcl_Obj *ret; + + tail = Tcl_GetString(pathPtr); + extension = TclGetExtension(tail); + if (extension == NULL) { + ret = Tcl_NewObj(); + } else { + ret = Tcl_NewStringObj(extension, -1); + } + Tcl_IncrRefCount(ret); + return ret; +} + +/* + *--------------------------------------------------------------------------- + * * Tcl_FSJoinPath -- * * This function takes the given Tcl_Obj, which should be a valid @@ -408,6 +629,10 @@ TclFSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) * first 'elements' elements as valid path segments. If elements < 0, * we use the entire list. * + * It is possible that the returned object is actually an element + * of the given list, so the caller should be careful to store a + * refCount to it before freeing the list. + * * Results: * Returns object with refCount of zero, (or if non-zero, it has * references elsewhere in Tcl). Either way, the caller must @@ -420,8 +645,8 @@ TclFSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) */ Tcl_Obj* Tcl_FSJoinPath(listObj, elements) - Tcl_Obj *listObj; - int elements; + Tcl_Obj *listObj; /* Path elements to join, may have refCount 0 */ + int elements; /* Number of elements to use (-1 = all) */ { Tcl_Obj *res; int i; @@ -446,7 +671,7 @@ Tcl_FSJoinPath(listObj, elements) } } - res = Tcl_NewObj(); + res = NULL; for (i = 0; i < elements; i++) { Tcl_Obj *elt; @@ -485,7 +710,7 @@ Tcl_FSJoinPath(listObj, elements) * '/'. There's no need to return a special path * object, when the base itself is just fine! */ - Tcl_DecrRefCount(res); + if (res != NULL) Tcl_DecrRefCount(res); return elt; } /* @@ -499,7 +724,7 @@ Tcl_FSJoinPath(listObj, elements) */ if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS) || (strchr(str, '\\') == NULL))) { - Tcl_DecrRefCount(res); + if (res != NULL) Tcl_DecrRefCount(res); return TclNewFSPathObj(elt, str, len); } /* @@ -509,7 +734,7 @@ Tcl_FSJoinPath(listObj, elements) */ } else { if (tclPlatform == TCL_PLATFORM_UNIX) { - Tcl_DecrRefCount(res); + if (res != NULL) Tcl_DecrRefCount(res); return tail; } else { CONST char *str; @@ -517,12 +742,12 @@ Tcl_FSJoinPath(listObj, elements) str = Tcl_GetStringFromObj(tail,&len); if (tclPlatform == TCL_PLATFORM_WINDOWS) { if (strchr(str, '\\') == NULL) { - Tcl_DecrRefCount(res); + if (res != NULL) Tcl_DecrRefCount(res); return tail; } } else if (tclPlatform == TCL_PLATFORM_MAC) { if (strchr(str, '/') == NULL) { - Tcl_DecrRefCount(res); + if (res != NULL) Tcl_DecrRefCount(res); return tail; } } @@ -533,27 +758,101 @@ Tcl_FSJoinPath(listObj, elements) type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* Zero out the current result */ - Tcl_DecrRefCount(res); + if (res != NULL) Tcl_DecrRefCount(res); + if (driveName != NULL) { + /* + * We've been given a separate drive-name object, + * because the prefix in 'elt' is not in a suitable + * format for us (e.g. it may contain irrelevant + * multiple separators, like C://///foo). + */ res = Tcl_DuplicateObj(driveName); Tcl_DecrRefCount(driveName); + /* + * Do not set driveName to NULL, because we will check + * its value below (but we won't access the contents, + * since those have been cleaned-up). + */ } else { res = Tcl_NewStringObj(strElt, driveNameLength); } strElt += driveNameLength; } - ptr = Tcl_GetStringFromObj(res, &length); + /* + * Optimisation block: if this is the last element to be + * examined, and it is absolute or the only element, and the + * drive-prefix was ok (if there is one), it might be that the + * path is already in a suitable form to be returned. Then we + * can short-cut the rest of this procedure. + */ + if ((driveName == NULL) && (i == (elements - 1)) + && (type != TCL_PATH_RELATIVE || res == NULL)) { + /* + * It's the last path segment. Perform a quick check if + * the path is already in a suitable form. + */ + int equal = 1; + + if (tclPlatform == TCL_PLATFORM_WINDOWS) { + if (strchr(strElt, '\\') != NULL) { + equal = 0; + } + } + if (equal && (tclPlatform != TCL_PLATFORM_MAC)) { + ptr = strElt; + while (*ptr != '\0') { + if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) { + equal = 0; + break; + } + ptr++; + } + } + if (equal && (tclPlatform == TCL_PLATFORM_MAC)) { + /* + * If it contains any colons, then it mustn't contain + * any duplicates. Otherwise, the path is in unix-form + * and is no good. + */ + if (strchr(strElt, ':') != NULL) { + ptr = strElt; + while (*ptr != '\0') { + if (*ptr == ':' && (ptr[1] == ':' || ptr[1] == '\0')) { + equal = 0; + break; + } + ptr++; + } + } else { + equal = 0; + } + } + if (equal) { + if (res != NULL) Tcl_DecrRefCount(res); + /* + * This element is just what we want to return already - + * no further manipulation is requred. + */ + return elt; + } + } + + if (res == NULL) { + res = Tcl_NewObj(); + ptr = Tcl_GetStringFromObj(res, &length); + } else { + ptr = Tcl_GetStringFromObj(res, &length); + } /* * Strip off any './' before a tilde, unless this is the * beginning of the path. */ - if (length > 0 && strEltLen > 0) { - if ((strElt[0] == '.') && (strElt[1] == '/') - && (strElt[2] == '~')) { - strElt += 2; - } + if (length > 0 && strEltLen > 0 + && (strElt[0] == '.') && (strElt[1] == '/') && (strElt[2] == '~')) { + strElt += 2; } /* @@ -629,10 +928,10 @@ Tcl_FSJoinPath(listObj, elements) *--------------------------------------------------------------------------- */ int -Tcl_FSConvertToPathType(interp, objPtr) +Tcl_FSConvertToPathType(interp, pathPtr) Tcl_Interp *interp; /* Interpreter in which to store error * message (if necessary). */ - Tcl_Obj *objPtr; /* Object to convert to a valid, current + Tcl_Obj *pathPtr; /* Object to convert to a valid, current * path type. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); @@ -646,39 +945,39 @@ Tcl_FSConvertToPathType(interp, objPtr) * and is a relative path, we do have to worry about the cwd. * If the cwd has changed, we must recompute the path. */ - if (objPtr->typePtr == &tclFsPathType) { - FsPath *fsPathPtr = (FsPath*) PATHOBJ(objPtr); + if (pathPtr->typePtr == &tclFsPathType) { + FsPath *fsPathPtr = (FsPath*) PATHOBJ(pathPtr); if (fsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) { - if (objPtr->bytes == NULL) { - UpdateStringOfFsPath(objPtr); + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); } - FreeFsPathInternalRep(objPtr); - objPtr->typePtr = NULL; - return Tcl_ConvertToType(interp, objPtr, &tclFsPathType); + FreeFsPathInternalRep(pathPtr); + pathPtr->typePtr = NULL; + return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); } return TCL_OK; /* - * This code is intentionally never reached. Once fs-optimisation - * is complete, it will be removed/replaced + * We used to have more complex code here: + * + * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) { + * return TCL_OK; + * } else { + * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { + * return TCL_OK; + * } else { + * if (pathPtr->bytes == NULL) { + * UpdateStringOfFsPath(pathPtr); + * } + * FreeFsPathInternalRep(pathPtr); + * pathPtr->typePtr = NULL; + * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); + * } + * } + * + * But we no longer believe this is necessary. */ -#if 0 - if (fsPathPtr->cwdPtr == NULL) { - return TCL_OK; - } else { - if (TclFSCwdPointerEquals(fsPathPtr->cwdPtr)) { - return TCL_OK; - } else { - if (objPtr->bytes == NULL) { - UpdateStringOfFsPath(objPtr); - } - FreeFsPathInternalRep(objPtr); - objPtr->typePtr = NULL; - return Tcl_ConvertToType(interp, objPtr, &tclFsPathType); - } - } -#endif } else { - return Tcl_ConvertToType(interp, objPtr, &tclFsPathType); + return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType); } } @@ -745,9 +1044,10 @@ FindSplitPos(path, separator) * * TclNewFSPathObj -- * - * Creates a path object whose string representation is - * '[file join dirPtr addStrRep]', but does so in a way that - * allows for more efficient caching of normalized paths. + * Creates a path object whose string representation is '[file join + * dirPtr addStrRep]', but does so in a way that allows for more + * efficient creation and caching of normalized paths, and more + * efficient 'file dirname', 'file tail', etc. * * Assumptions: * 'dirPtr' must be an absolute path. @@ -766,10 +1066,12 @@ Tcl_Obj* TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) { FsPath *fsPathPtr; - Tcl_Obj *objPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + Tcl_Obj *pathPtr; + ThreadSpecificData *tsdPtr; - objPtr = Tcl_NewObj(); + tsdPtr = TCL_TSD_INIT(&tclFsDataKey); + + pathPtr = Tcl_NewObj(); fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); if (tclPlatform == TCL_PLATFORM_MAC) { @@ -783,7 +1085,7 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) addStrRep++; len--; } - } + } /* Setup the path */ fsPathPtr->translatedPathPtr = NULL; fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len); @@ -794,13 +1096,13 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - PATHOBJ(objPtr) = (VOID *) fsPathPtr; - PATHFLAGS(objPtr) = TCLPATH_RELATIVE | TCLPATH_APPENDED; - objPtr->typePtr = &tclFsPathType; - objPtr->bytes = NULL; - objPtr->length = 0; + PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + PATHFLAGS(pathPtr) = TCLPATH_APPENDED; + pathPtr->typePtr = &tclFsPathType; + pathPtr->bytes = NULL; + pathPtr->length = 0; - return objPtr; + return pathPtr; } /* @@ -808,11 +1110,17 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) * * TclFSMakePathRelative -- * - * Like SetFsPathFromAny, but assumes the given object is an - * absolute normalized path. Only for internal use. + * Only for internal use. + * + * Takes a path and a directory, where we _assume_ both path and + * directory are absolute, normalized and that the path lies + * inside the directory. Returns a Tcl_Obj representing filename + * of the path relative to the directory. * * Results: - * Standard Tcl error code. + * NULL on error, otherwise a valid object, typically with + * refCount of zero, which it is assumed the caller will + * increment. * * Side effects: * The old representation may be freed, and new memory allocated. @@ -821,24 +1129,24 @@ TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep, int len) */ Tcl_Obj* -TclFSMakePathRelative(interp, objPtr, cwdPtr) +TclFSMakePathRelative(interp, pathPtr, cwdPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr; /* The object we have. */ + Tcl_Obj *pathPtr; /* The object we have. */ Tcl_Obj *cwdPtr; /* Make it relative to this. */ { int cwdLen, len; CONST char *tempStr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - if (objPtr->typePtr == &tclFsPathType) { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(objPtr); - if (PATHFLAGS(objPtr) != 0 + if (pathPtr->typePtr == &tclFsPathType) { + FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); + if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) { - objPtr = fsPathPtr->normPathPtr; + pathPtr = fsPathPtr->normPathPtr; /* Free old representation */ - if (objPtr->typePtr != NULL) { - if (objPtr->bytes == NULL) { - if (objPtr->typePtr->updateStringProc == NULL) { + if (pathPtr->typePtr != NULL) { + if (pathPtr->bytes == NULL) { + if (pathPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't find object", @@ -846,17 +1154,17 @@ TclFSMakePathRelative(interp, objPtr, cwdPtr) } return NULL; } - objPtr->typePtr->updateStringProc(objPtr); + pathPtr->typePtr->updateStringProc(pathPtr); } - if ((objPtr->typePtr->freeIntRepProc) != NULL) { - (*objPtr->typePtr->freeIntRepProc)(objPtr); + if ((pathPtr->typePtr->freeIntRepProc) != NULL) { + (*pathPtr->typePtr->freeIntRepProc)(pathPtr); } } fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); /* Circular reference, by design */ - fsPathPtr->translatedPathPtr = objPtr; + fsPathPtr->translatedPathPtr = pathPtr; fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = cwdPtr; Tcl_IncrRefCount(cwdPtr); @@ -864,11 +1172,11 @@ TclFSMakePathRelative(interp, objPtr, cwdPtr) fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - PATHOBJ(objPtr) = (VOID *) fsPathPtr; - PATHFLAGS(objPtr) = 0; - objPtr->typePtr = &tclFsPathType; + PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + PATHFLAGS(pathPtr) = 0; + pathPtr->typePtr = &tclFsPathType; - return objPtr; + return pathPtr; } } /* @@ -908,7 +1216,7 @@ TclFSMakePathRelative(interp, objPtr, cwdPtr) } break; } - tempStr = Tcl_GetStringFromObj(objPtr, &len); + tempStr = Tcl_GetStringFromObj(pathPtr, &len); return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen); } @@ -931,23 +1239,23 @@ TclFSMakePathRelative(interp, objPtr, cwdPtr) */ int -TclFSMakePathFromNormalized(interp, objPtr, nativeRep) +TclFSMakePathFromNormalized(interp, pathPtr, nativeRep) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr; /* The object to convert. */ + Tcl_Obj *pathPtr; /* The object to convert. */ ClientData nativeRep; /* The native rep for the object, if known * else NULL. */ { FsPath *fsPathPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - if (objPtr->typePtr == &tclFsPathType) { + if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } /* Free old representation */ - if (objPtr->typePtr != NULL) { - if (objPtr->bytes == NULL) { - if (objPtr->typePtr->updateStringProc == NULL) { + if (pathPtr->typePtr != NULL) { + if (pathPtr->bytes == NULL) { + if (pathPtr->typePtr->updateStringProc == NULL) { if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "can't find object", @@ -955,25 +1263,26 @@ TclFSMakePathFromNormalized(interp, objPtr, nativeRep) } return TCL_ERROR; } - objPtr->typePtr->updateStringProc(objPtr); + pathPtr->typePtr->updateStringProc(pathPtr); } - if ((objPtr->typePtr->freeIntRepProc) != NULL) { - (*objPtr->typePtr->freeIntRepProc)(objPtr); + if ((pathPtr->typePtr->freeIntRepProc) != NULL) { + (*pathPtr->typePtr->freeIntRepProc)(pathPtr); } } fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); /* It's a pure normalized absolute path */ fsPathPtr->translatedPathPtr = NULL; - fsPathPtr->normPathPtr = objPtr; + /* Circular reference by design */ + fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = nativeRep; fsPathPtr->fsRecPtr = NULL; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - PATHOBJ(objPtr) = (VOID *) fsPathPtr; - PATHFLAGS(objPtr) = 0; - objPtr->typePtr = &tclFsPathType; + PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + PATHFLAGS(pathPtr) = 0; + pathPtr->typePtr = &tclFsPathType; return TCL_OK; } @@ -1009,15 +1318,15 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) Tcl_Filesystem* fromFilesystem; ClientData clientData; { - Tcl_Obj *objPtr; + Tcl_Obj *pathPtr; FsPath *fsPathPtr; FilesystemRecord *fsFromPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - objPtr = TclFSInternalToNormalized(fromFilesystem, clientData, + pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData, &fsFromPtr); - if (objPtr == NULL) { + if (pathPtr == NULL) { return NULL; } @@ -1025,15 +1334,15 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) * Free old representation; shouldn't normally be any, * but best to be safe. */ - if (objPtr->typePtr != NULL) { - if (objPtr->bytes == NULL) { - if (objPtr->typePtr->updateStringProc == NULL) { + if (pathPtr->typePtr != NULL) { + if (pathPtr->bytes == NULL) { + if (pathPtr->typePtr->updateStringProc == NULL) { return NULL; } - objPtr->typePtr->updateStringProc(objPtr); + pathPtr->typePtr->updateStringProc(pathPtr); } - if ((objPtr->typePtr->freeIntRepProc) != NULL) { - (*objPtr->typePtr->freeIntRepProc)(objPtr); + if ((pathPtr->typePtr->freeIntRepProc) != NULL) { + (*pathPtr->typePtr->freeIntRepProc)(pathPtr); } } @@ -1041,18 +1350,18 @@ Tcl_FSNewNativePath(fromFilesystem, clientData) fsPathPtr->translatedPathPtr = NULL; /* Circular reference, by design */ - fsPathPtr->normPathPtr = objPtr; + fsPathPtr->normPathPtr = pathPtr; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = clientData; fsPathPtr->fsRecPtr = fsFromPtr; fsPathPtr->fsRecPtr->fileRefCount++; fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; - PATHOBJ(objPtr) = (VOID *) fsPathPtr; - PATHFLAGS(objPtr) = 0; - objPtr->typePtr = &tclFsPathType; + PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + PATHFLAGS(pathPtr) = 0; + pathPtr->typePtr = &tclFsPathType; - return objPtr; + return pathPtr; } /* @@ -1167,19 +1476,19 @@ Tcl_FSGetTranslatedStringPath(interp, pathPtr) */ Tcl_Obj* -Tcl_FSGetNormalizedPath(interp, pathObjPtr) +Tcl_FSGetNormalizedPath(interp, pathPtr) Tcl_Interp *interp; - Tcl_Obj* pathObjPtr; + Tcl_Obj* pathPtr; { FsPath *fsPathPtr; - if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) { + if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return NULL; } - fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + fsPathPtr = (FsPath*) PATHOBJ(pathPtr); - if (PATHFLAGS(pathObjPtr) != 0) { + if (PATHFLAGS(pathPtr) != 0) { /* * This is a special path object which is the result of * something like 'file join' @@ -1195,8 +1504,8 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) if (dir == NULL) { return NULL; } - if (pathObjPtr->bytes == NULL) { - UpdateStringOfFsPath(pathObjPtr); + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); } copy = Tcl_DuplicateObj(dir); Tcl_IncrRefCount(copy); @@ -1268,21 +1577,21 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) if (clientData != NULL) { fsPathPtr->nativePathPtr = clientData; } - PATHFLAGS(pathObjPtr) = 0; + PATHFLAGS(pathPtr) = 0; } /* Ensure cwd hasn't changed */ if (fsPathPtr->cwdPtr != NULL) { - if (!TclFSCwdPointerEquals(fsPathPtr->cwdPtr)) { - if (pathObjPtr->bytes == NULL) { - UpdateStringOfFsPath(pathObjPtr); + if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) { + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); } - FreeFsPathInternalRep(pathObjPtr); - pathObjPtr->typePtr = NULL; - if (Tcl_ConvertToType(interp, pathObjPtr, + FreeFsPathInternalRep(pathPtr); + pathPtr->typePtr = NULL; + if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) { return NULL; } - fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + fsPathPtr = (FsPath*) PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { int cwdLen; Tcl_Obj *copy; @@ -1319,7 +1628,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) } break; } - Tcl_AppendObjToObj(copy, pathObjPtr); + Tcl_AppendObjToObj(copy, pathPtr); /* * Normalize the combined string, but only starting after * the end of the previously normalized 'dir'. This should @@ -1350,7 +1659,7 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) * action, which might loop back through here. */ if (path[0] != '\0') { - Tcl_PathType type = Tcl_FSGetPathType(pathObjPtr); + Tcl_PathType type = Tcl_FSGetPathType(pathPtr); if (type == TCL_PATH_RELATIVE) { useThisCwd = Tcl_FSGetCwd(interp); @@ -1432,21 +1741,30 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) fsPathPtr->nativePathPtr = (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData); } - if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr), - Tcl_GetString(pathObjPtr))) { - /* - * The path was already normalized. - * Get rid of the duplicate. - */ - Tcl_DecrRefCount(fsPathPtr->normPathPtr); + /* + * Check if path is pure normalized (this can only be the case + * if it is an absolute path). + */ + if (useThisCwd == NULL) { + if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr), + Tcl_GetString(pathPtr))) { + /* + * The path was already normalized. + * Get rid of the duplicate. + */ + Tcl_DecrRefCount(fsPathPtr->normPathPtr); + /* + * We do *not* increment the refCount for + * this circular reference + */ + fsPathPtr->normPathPtr = pathPtr; + } + } else { /* - * We do *not* increment the refCount for - * this circular reference + * We just need to free an object we allocated above for + * relative paths (this was returned by Tcl_FSJoinToPath + * above), and then of course store the cwd. */ - fsPathPtr->normPathPtr = pathObjPtr; - } - if (useThisCwd != NULL) { - /* This was returned by Tcl_FSJoinToPath above */ Tcl_DecrRefCount(absolutePath); fsPathPtr->cwdPtr = useThisCwd; } @@ -1478,16 +1796,16 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) */ ClientData -Tcl_FSGetInternalRep(pathObjPtr, fsPtr) - Tcl_Obj* pathObjPtr; +Tcl_FSGetInternalRep(pathPtr, fsPtr) + Tcl_Obj* pathPtr; Tcl_Filesystem *fsPtr; { FsPath* srcFsPathPtr; - if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) { + if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) { return NULL; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); /* * We will only return the native representation for the caller's @@ -1514,7 +1832,7 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) * call the native filesystem directly. It is at least safer * to allow this sub-optimal routing. */ - Tcl_FSGetFileSystemForPath(pathObjPtr); + Tcl_FSGetFileSystemForPath(pathPtr); /* * If we fail through here, then the path is probably not a @@ -1522,7 +1840,7 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) * use of the empty path "" via a direct call to one of the * objectified interfaces (e.g. from the Tcl testsuite). */ - srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); if (srcFsPathPtr->fsRecPtr == NULL) { return NULL; } @@ -1536,9 +1854,9 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) * which we do care about. The way we can check for this * is we ask what filesystem this path belongs to. */ - Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr); + Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr); if (actualFs == fsPtr) { - return Tcl_FSGetInternalRep(pathObjPtr, fsPtr); + return Tcl_FSGetInternalRep(pathPtr, fsPtr); } return NULL; } @@ -1550,7 +1868,7 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) if (proc == NULL) { return NULL; } - srcFsPathPtr->nativePathPtr = (*proc)(pathObjPtr); + srcFsPathPtr->nativePathPtr = (*proc)(pathPtr); } return srcFsPathPtr->nativePathPtr; @@ -1561,7 +1879,7 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) * * TclFSEnsureEpochOk -- * - * This will ensure the pathObjPtr is up to date and can be + * This will ensure the pathPtr is up to date and can be * converted into a "path" type, and that we are able to generate a * complete normalized path which is used to determine the * filesystem match. @@ -1576,22 +1894,18 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) */ int -TclFSEnsureEpochOk(pathObjPtr, fsPtrPtr) - Tcl_Obj* pathObjPtr; +TclFSEnsureEpochOk(pathPtr, fsPtrPtr) + Tcl_Obj* pathPtr; Tcl_Filesystem **fsPtrPtr; { FsPath* srcFsPathPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - /* - * SHOULD BE ABLE TO IMPROVE EFFICIENCY HERE. - */ - - if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) { - return TCL_ERROR; + if (pathPtr->typePtr != &tclFsPathType) { + return TCL_OK; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); /* * Check if the filesystem has changed in some way since @@ -1602,15 +1916,15 @@ TclFSEnsureEpochOk(pathObjPtr, fsPtrPtr) * We have to discard the stale representation and * recalculate it */ - if (pathObjPtr->bytes == NULL) { - UpdateStringOfFsPath(pathObjPtr); + if (pathPtr->bytes == NULL) { + UpdateStringOfFsPath(pathPtr); } - FreeFsPathInternalRep(pathObjPtr); - pathObjPtr->typePtr = NULL; - if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) { + FreeFsPathInternalRep(pathPtr); + pathPtr->typePtr = NULL; + if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { return TCL_ERROR; } - srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); } /* Check whether the object is already assigned to a fs */ if (srcFsPathPtr->fsRecPtr != NULL) { @@ -1621,16 +1935,22 @@ TclFSEnsureEpochOk(pathObjPtr, fsPtrPtr) } void -TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData) - Tcl_Obj *pathObjPtr; +TclFSSetPathDetails(pathPtr, fsRecPtr, clientData) + Tcl_Obj *pathPtr; FilesystemRecord *fsRecPtr; ClientData clientData; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - /* We assume pathObjPtr is already of the correct type */ FsPath* srcFsPathPtr; - srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + /* Make sure pathPtr is of the correct type */ + if (pathPtr->typePtr != &tclFsPathType) { + if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) { + return; + } + } + + srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr); srcFsPathPtr->fsRecPtr = fsRecPtr; srcFsPathPtr->nativePathPtr = clientData; srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch; @@ -1718,9 +2038,9 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) */ static int -SetFsPathFromAny(interp, objPtr) +SetFsPathFromAny(interp, pathPtr) Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr; /* The object to convert. */ + Tcl_Obj *pathPtr; /* The object to convert. */ { int len; FsPath *fsPathPtr; @@ -1728,7 +2048,7 @@ SetFsPathFromAny(interp, objPtr) char *name; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey); - if (objPtr->typePtr == &tclFsPathType) { + if (pathPtr->typePtr == &tclFsPathType) { return TCL_OK; } @@ -1747,7 +2067,7 @@ SetFsPathFromAny(interp, objPtr) * or MacOS (fCmd.test, fileName.test and cmdAH.test exercise * most of the code). */ - name = Tcl_GetStringFromObj(objPtr,&len); + name = Tcl_GetStringFromObj(pathPtr,&len); /* * Handle tilde substitutions, if needed. @@ -1818,7 +2138,7 @@ SetFsPathFromAny(interp, objPtr) int objc; Tcl_Obj **objv; - Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL); + Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); Tcl_ListObjGetElements(NULL, parts, &objc, &objv); /* Skip '~'. It's replaced by its expansion */ objc--; objv++; @@ -1827,14 +2147,23 @@ SetFsPathFromAny(interp, objPtr) } Tcl_DecrRefCount(parts); } else { - /* Simple case. "rest" is relative path. Just join it. */ + /* + * Simple case. "rest" is relative path. Just join it. + * The "rest" object will be freed when + * Tcl_FSJoinToPath returns (unless something else + * claims a refCount on it). + */ + Tcl_Obj *joined; Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1); - transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest); + Tcl_IncrRefCount(transPtr); + joined = Tcl_FSJoinToPath(transPtr, 1, &rest); + Tcl_DecrRefCount(transPtr); + transPtr = joined; } } Tcl_DStringFree(&temp); } else { - transPtr = Tcl_FSJoinToPath(objPtr,0,NULL); + transPtr = Tcl_FSJoinToPath(pathPtr,0,NULL); } #if defined(__CYGWIN__) && defined(__WIN32__) @@ -1866,7 +2195,9 @@ SetFsPathFromAny(interp, objPtr) fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); fsPathPtr->translatedPathPtr = transPtr; - Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); + if (transPtr != pathPtr) { + Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); + } fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; @@ -1876,29 +2207,29 @@ SetFsPathFromAny(interp, objPtr) /* * Free old representation before installing our new one. */ - if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) { - (objPtr->typePtr->freeIntRepProc)(objPtr); + if (pathPtr->typePtr != NULL && pathPtr->typePtr->freeIntRepProc != NULL) { + (pathPtr->typePtr->freeIntRepProc)(pathPtr); } - PATHOBJ(objPtr) = (VOID *) fsPathPtr; - PATHFLAGS(objPtr) = 0; - objPtr->typePtr = &tclFsPathType; + PATHOBJ(pathPtr) = (VOID *) fsPathPtr; + PATHFLAGS(pathPtr) = 0; + pathPtr->typePtr = &tclFsPathType; return TCL_OK; } static void -FreeFsPathInternalRep(pathObjPtr) - Tcl_Obj *pathObjPtr; /* Path object with internal rep to free. */ +FreeFsPathInternalRep(pathPtr) + Tcl_Obj *pathPtr; /* Path object with internal rep to free. */ { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr); + FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); if (fsPathPtr->translatedPathPtr != NULL) { - if (fsPathPtr->translatedPathPtr != pathObjPtr) { + if (fsPathPtr->translatedPathPtr != pathPtr) { Tcl_DecrRefCount(fsPathPtr->translatedPathPtr); } } if (fsPathPtr->normPathPtr != NULL) { - if (fsPathPtr->normPathPtr != pathObjPtr) { + if (fsPathPtr->normPathPtr != pathPtr) { Tcl_DecrRefCount(fsPathPtr->normPathPtr); } fsPathPtr->normPathPtr = NULL; @@ -1926,7 +2257,6 @@ FreeFsPathInternalRep(pathObjPtr) ckfree((char*) fsPathPtr); } - static void DupFsPathInternalRep(srcPtr, copyPtr) Tcl_Obj *srcPtr; /* Path obj with internal rep to copy. */ @@ -2004,15 +2334,15 @@ DupFsPathInternalRep(srcPtr, copyPtr) */ static void -UpdateStringOfFsPath(objPtr) - register Tcl_Obj *objPtr; /* path obj with string rep to update. */ +UpdateStringOfFsPath(pathPtr) + register Tcl_Obj *pathPtr; /* path obj with string rep to update. */ { - FsPath* fsPathPtr = (FsPath*) PATHOBJ(objPtr); + FsPath* fsPathPtr = (FsPath*) PATHOBJ(pathPtr); CONST char *cwdStr; int cwdLen; Tcl_Obj *copy; - if (PATHFLAGS(objPtr) == 0 || fsPathPtr->cwdPtr == NULL) { + if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { Tcl_Panic("Called UpdateStringOfFsPath with invalid object"); } @@ -2055,8 +2385,8 @@ UpdateStringOfFsPath(objPtr) break; } Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr); - objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); - objPtr->length = cwdLen; + pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen); + pathPtr->length = cwdLen; copy->bytes = tclEmptyStringRep; copy->length = 0; Tcl_DecrRefCount(copy); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 737ab3b..098a44c 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.91 2003/12/15 00:49:38 davygrvy Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.92 2004/01/21 19:59:33 vincentdarley Exp $ */ #include "tclInt.h" @@ -99,7 +99,7 @@ TclIntStubs tclIntStubs = { TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ TclDeleteVars, /* 12 */ - TclDoGlob, /* 13 */ + NULL, /* 13 */ TclDumpMemoryInfo, /* 14 */ NULL, /* 15 */ TclExprFloatError, /* 16 */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 71c08a5..7c9361d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.74 2003/12/24 04:18:20 davygrvy Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.75 2004/01/21 19:59:33 vincentdarley Exp $ */ #define TCL_TEST @@ -365,7 +365,7 @@ static void TestReport _ANSI_ARGS_ ((CONST char* cmd, Tcl_Obj* arg1, Tcl_Obj* arg2)); static Tcl_Obj* TestReportGetNativePath _ANSI_ARGS_ (( - Tcl_Obj* pathObjPtr)); + Tcl_Obj* pathPtr)); static int TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path, Tcl_StatBuf *buf)); @@ -6054,8 +6054,8 @@ TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) * path object, or NULL if no such representation exists. */ static Tcl_Obj* -TestReportGetNativePath(Tcl_Obj* pathObjPtr) { - return (Tcl_Obj*) Tcl_FSGetInternalRep(pathObjPtr, &testReportingFilesystem); +TestReportGetNativePath(Tcl_Obj* pathPtr) { + return (Tcl_Obj*) Tcl_FSGetInternalRep(pathPtr, &testReportingFilesystem); } static void |