diff options
author | vincentdarley <vincentdarley> | 2001-08-23 17:37:07 (GMT) |
---|---|---|
committer | vincentdarley <vincentdarley> | 2001-08-23 17:37:07 (GMT) |
commit | f319c32167c2c52995fe53b438ef4bc34e9a4914 (patch) | |
tree | 6169e1176aad79725e33cee0d99ca91f726feed6 /generic | |
parent | 8d4c60866a8f603ab29fa193c8f4aff83f8beee7 (diff) | |
download | tcl-f319c32167c2c52995fe53b438ef4bc34e9a4914.zip tcl-f319c32167c2c52995fe53b438ef4bc34e9a4914.tar.gz tcl-f319c32167c2c52995fe53b438ef4bc34e9a4914.tar.bz2 |
fs update
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 14 | ||||
-rw-r--r-- | generic/tcl.h | 13 | ||||
-rw-r--r-- | generic/tclCmdAH.c | 182 | ||||
-rw-r--r-- | generic/tclDecls.h | 29 | ||||
-rw-r--r-- | generic/tclFCmd.c | 5 | ||||
-rw-r--r-- | generic/tclFileName.c | 866 | ||||
-rw-r--r-- | generic/tclIO.c | 12 | ||||
-rw-r--r-- | generic/tclIOUtil.c | 746 | ||||
-rw-r--r-- | generic/tclInt.h | 17 | ||||
-rw-r--r-- | generic/tclLoad.c | 17 | ||||
-rw-r--r-- | generic/tclStubInit.c | 5 | ||||
-rw-r--r-- | generic/tclTest.c | 70 |
12 files changed, 1391 insertions, 585 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 482d5fa..65ff02a 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -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: tcl.decls,v 1.51 2001/07/31 19:12:06 vincentdarley Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.52 2001/08/23 17:37:07 vincentdarley Exp $ library tcl @@ -599,7 +599,8 @@ declare 167 unix { int Tcl_GetOpenFile(Tcl_Interp *interp, char *str, int forWriting, \ int checkUsage, ClientData *filePtr) } - +# Obsolete. Should now use Tcl_FSGetPathType which is objectified +# and therefore usually faster. declare 168 generic { Tcl_PathType Tcl_GetPathType(char *path) } @@ -1562,7 +1563,7 @@ declare 445 generic { char * pattern, Tcl_GlobTypeData * types) } declare 446 generic { - Tcl_Obj* Tcl_FSReadlink(Tcl_Obj *pathPtr) + Tcl_Obj* Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr) } declare 447 generic { int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, \ @@ -1628,7 +1629,7 @@ declare 465 generic { ClientData Tcl_FSGetInternalRep(Tcl_Obj* pathObjPtr, Tcl_Filesystem *fsPtr) } declare 466 generic { - char* Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr) + Tcl_Obj* Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj* pathPtr) } declare 467 generic { int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName) @@ -1646,7 +1647,7 @@ declare 471 generic { Tcl_Obj* Tcl_FSPathSeparator(Tcl_Obj* pathObjPtr) } declare 472 generic { - int Tcl_FSListVolumes(Tcl_Interp *interp) + Tcl_Obj* Tcl_FSListVolumes(void) } declare 473 generic { int Tcl_FSRegister(ClientData clientData, Tcl_Filesystem *fsPtr) @@ -1657,6 +1658,9 @@ declare 474 generic { declare 475 generic { ClientData Tcl_FSData(Tcl_Filesystem *fsPtr) } +declare 476 generic { + char* Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj* pathPtr) +} ############################################################################## diff --git a/generic/tcl.h b/generic/tcl.h index aa7ce8a..ba7d9c5 100644 --- a/generic/tcl.h +++ b/generic/tcl.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: tcl.h,v 1.95 2001/08/08 22:28:23 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.96 2001/08/23 17:37:07 vincentdarley Exp $ */ #ifndef _TCL @@ -1533,7 +1533,7 @@ typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)); typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((ClientData clientData)); -typedef int (Tcl_FSListVolumesProc) _ANSI_ARGS_((Tcl_Interp *interp)); +typedef Tcl_Obj* (Tcl_FSListVolumesProc) _ANSI_ARGS_((void)); /* We have to declare the utime structure here. */ struct utimbuf; typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, @@ -1548,7 +1548,8 @@ typedef char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)); -typedef Tcl_Obj* (Tcl_FSReadlinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); +typedef Tcl_Obj* (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, + Tcl_Obj *toPtr)); typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj *pathPtr, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, @@ -1670,11 +1671,11 @@ typedef struct Tcl_Filesystem { * with 'file mtime', 'file atime' and * the open-r/open-w/fcopy implementation * of 'file copy'. */ - Tcl_FSReadlinkProc *readlinkProc; + Tcl_FSLinkProc *linkProc; /* Function to process a - * 'Tcl_FSReadlink()' call. Should be + * 'Tcl_FSLink()' call. Should be * implemented only if the filesystem supports - * links. */ + * links (reading or creating). */ Tcl_FSListVolumesProc *listVolumesProc; /* Function to list any filesystem volumes * added by this filesystem. Should be diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 5866ac4..0793a2e 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.13 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.14 2001/08/23 17:37:07 vincentdarley Exp $ */ #include "tclInt.h" @@ -28,8 +28,6 @@ static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_FSStatProc *statProc, struct stat *statPtr)); static char * GetTypeFromMode _ANSI_ARGS_((int mode)); -static int SplitPath _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr, int *argcPtr, char ***argvPtr)); static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp, char *varName, struct stat *statPtr)); @@ -782,7 +780,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - Tcl_Obj *resultPtr; int index; /* @@ -824,7 +821,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - resultPtr = Tcl_GetObjResult(interp); switch ((enum options) index) { case FILE_ATIME: { struct stat buf; @@ -845,7 +841,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) tval.actime = buf.st_atime; tval.modtime = buf.st_mtime; if (Tcl_FSUtime(objv[2], &tval) != 0) { - Tcl_AppendStringsToObj(resultPtr, + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not set access time for file \"", Tcl_GetString(objv[2]), "\": ", Tcl_PosixError(interp), (char *) NULL); @@ -861,7 +857,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } } - Tcl_SetLongObj(resultPtr, (long) buf.st_atime); + Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime); return TCL_OK; } case FILE_ATTRIBUTES: { @@ -882,14 +878,28 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TclFileDeleteCmd(interp, objc, objv); } case FILE_DIRNAME: { - int argc; - char ** argv; + int splitElements; + Tcl_Obj *splitPtr; + Tcl_Obj *splitResultPtr = NULL; if (objc != 3) { goto only3Args; } - if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) { - return TCL_ERROR; + /* + * 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); } /* @@ -898,22 +908,17 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) * return the current directory. */ - if (argc > 1) { - Tcl_DString ds; - - Tcl_DStringInit(&ds); - Tcl_JoinPath(argc - 1, argv, &ds); - Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); - } else if ((argc == 0) - || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) { - Tcl_SetStringObj(resultPtr, + if (splitElements > 1) { + splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1); + } else if (splitElements == 0 || + (Tcl_FSGetPathType(objv[2], NULL, NULL) == TCL_PATH_RELATIVE)) { + splitResultPtr = Tcl_NewStringObj( ((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1); } else { - Tcl_SetStringObj(resultPtr, argv[0], -1); + Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr); } - ckfree((char *) argv); + Tcl_SetObjResult(interp, splitResultPtr); + Tcl_DecrRefCount(splitPtr); return TCL_OK; } case FILE_EXECUTABLE: { @@ -936,7 +941,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) fileName = Tcl_GetString(objv[2]); extension = TclGetExtension(fileName); if (extension != NULL) { - Tcl_SetStringObj(resultPtr, extension, -1); + Tcl_SetStringObj(Tcl_GetObjResult(interp), extension, -1); } return TCL_OK; } @@ -951,7 +956,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) { value = S_ISDIR(buf.st_mode); } - Tcl_SetBooleanObj(resultPtr, value); + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value); return TCL_OK; } case FILE_ISFILE: { @@ -965,7 +970,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) { value = S_ISREG(buf.st_mode); } - Tcl_SetBooleanObj(resultPtr, value); + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value); return TCL_OK; } case FILE_JOIN: { @@ -1012,7 +1017,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) tval.actime = buf.st_atime; tval.modtime = buf.st_mtime; if (Tcl_FSUtime(objv[2], &tval) != 0) { - Tcl_AppendStringsToObj(resultPtr, + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not set modification time for file \"", Tcl_GetString(objv[2]), "\": ", Tcl_PosixError(interp), (char *) NULL); @@ -1028,7 +1033,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } } - Tcl_SetLongObj(resultPtr, (long) buf.st_mtime); + Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_mtime); return TCL_OK; } case FILE_MKDIR: { @@ -1050,7 +1055,8 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (fileName == NULL) { return TCL_ERROR; } - Tcl_SetStringObj(resultPtr, fileName, Tcl_DStringLength(&ds)); + Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName, + Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); return TCL_OK; } @@ -1086,25 +1092,23 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) value = (geteuid() == buf.st_uid); #endif } - Tcl_SetBooleanObj(resultPtr, value); + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value); return TCL_OK; } case FILE_PATHTYPE: { - char *fileName; - if (objc != 3) { goto only3Args; } - fileName = Tcl_GetString(objv[2]); - switch (Tcl_GetPathType(fileName)) { + switch (Tcl_FSGetPathType(objv[2], NULL, NULL)) { case TCL_PATH_ABSOLUTE: - Tcl_SetStringObj(resultPtr, "absolute", -1); + Tcl_SetStringObj(Tcl_GetObjResult(interp), "absolute", -1); break; case TCL_PATH_RELATIVE: - Tcl_SetStringObj(resultPtr, "relative", -1); + Tcl_SetStringObj(Tcl_GetObjResult(interp), "relative", -1); break; case TCL_PATH_VOLUME_RELATIVE: - Tcl_SetStringObj(resultPtr, "volumerelative", -1); + Tcl_SetStringObj(Tcl_GetObjResult(interp), + "volumerelative", -1); break; } return TCL_OK; @@ -1126,7 +1130,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - contents = Tcl_FSReadlink(objv[2]); + contents = Tcl_FSLink(objv[2], NULL); if (contents == NULL) { Tcl_AppendResult(interp, "could not readlink \"", @@ -1153,7 +1157,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (extension == NULL) { Tcl_SetObjResult(interp, objv[2]); } else { - Tcl_SetStringObj(resultPtr, fileName, + Tcl_SetStringObj(Tcl_GetObjResult(interp), fileName, (int) (length - strlen(extension))); } return TCL_OK; @@ -1198,7 +1202,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } - Tcl_SetLongObj(resultPtr, (long) buf.st_size); + Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_size); return TCL_OK; } case FILE_SPLIT: { @@ -1238,14 +1242,27 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } } case FILE_TAIL: { - int argc; - char **argv; + int splitElements; + Tcl_Obj *splitPtr; if (objc != 3) { goto only3Args; } - if (SplitPath(interp, objv[2], &argc, &argv) != TCL_OK) { - return TCL_ERROR; + /* + * 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); } /* @@ -1253,13 +1270,16 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) * and it is the root of an absolute path. */ - if (argc > 0) { - if ((argc > 1) - || (Tcl_GetPathType(argv[0]) == TCL_PATH_RELATIVE)) { - Tcl_SetStringObj(resultPtr, argv[argc - 1], -1); + if (splitElements > 0) { + if ((splitElements > 1) + || (Tcl_FSGetPathType(objv[2], NULL, NULL) == TCL_PATH_RELATIVE)) { + + Tcl_Obj *tail = NULL; + Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &tail); + Tcl_SetObjResult(interp, tail); } } - ckfree((char *) argv); + Tcl_DecrRefCount(splitPtr); return TCL_OK; } case FILE_TYPE: { @@ -1271,7 +1291,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) { return TCL_ERROR; } - Tcl_SetStringObj(resultPtr, + Tcl_SetStringObj(Tcl_GetObjResult(interp), GetTypeFromMode((unsigned short) buf.st_mode), -1); return TCL_OK; } @@ -1280,7 +1300,8 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - return Tcl_FSListVolumes(interp); + Tcl_SetObjResult(interp, Tcl_FSListVolumes()); + return TCL_OK; } case FILE_WRITABLE: { if (objc != 3) { @@ -1298,63 +1319,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) /* *--------------------------------------------------------------------------- * - * SplitPath -- - * - * Utility procedure used by Tcl_FileObjCmd() to split a path. - * Differs from standard Tcl_SplitPath in its handling of home - * directories; Tcl_SplitPath preserves the "~" while this - * procedure computes the actual full path name. - * - * Results: - * The return value is TCL_OK if the path could be split, TCL_ERROR - * otherwise. If TCL_ERROR was returned, an error message is left - * in interp. If TCL_OK was returned, *argvPtr is set to a newly - * allocated array of strings that represent the individual - * directories in the specified path, and *argcPtr is filled with - * the length of that array. - * - * Side effects: - * Memory allocated. The caller must eventually free this memory - * by calling ckfree() on *argvPtr. - * - *--------------------------------------------------------------------------- - */ - -static int -SplitPath(interp, objPtr, argcPtr, argvPtr) - Tcl_Interp *interp; /* Interp for error return. May be NULL. */ - Tcl_Obj *objPtr; /* Path to be split. */ - int *argcPtr; /* Filled with length of following array. */ - char ***argvPtr; /* Filled with array of strings representing - * the elements of the specified path. */ -{ - char *fileName; - - fileName = Tcl_GetString(objPtr); - - /* - * If there is only one element, and it starts with a tilde, - * perform tilde substitution and resplit the path. - */ - - Tcl_SplitPath(fileName, argcPtr, argvPtr); - if ((*argcPtr == 1) && (fileName[0] == '~')) { - Tcl_DString ds; - - ckfree((char *) *argvPtr); - fileName = Tcl_TranslateFileName(interp, fileName, &ds); - if (fileName == NULL) { - return TCL_ERROR; - } - Tcl_SplitPath(fileName, argcPtr, argvPtr); - Tcl_DStringFree(&ds); - } - return TCL_OK; -} - -/* - *--------------------------------------------------------------------------- - * * CheckAccess -- * * Utility procedure used by Tcl_FileObjCmd() to query file diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 2a0da68..8aa701d 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.53 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.54 2001/08/23 17:37:07 vincentdarley Exp $ */ #ifndef _TCLDECLS @@ -1401,7 +1401,8 @@ EXTERN int Tcl_FSMatchInDirectory _ANSI_ARGS_(( Tcl_Obj * pathPtr, char * pattern, Tcl_GlobTypeData * types)); /* 446 */ -EXTERN Tcl_Obj* Tcl_FSReadlink _ANSI_ARGS_((Tcl_Obj * pathPtr)); +EXTERN Tcl_Obj* Tcl_FSLink _ANSI_ARGS_((Tcl_Obj * pathPtr, + Tcl_Obj * toPtr)); /* 447 */ EXTERN int Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); @@ -1461,7 +1462,7 @@ EXTERN Tcl_Obj* Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj * basePtr, EXTERN ClientData Tcl_FSGetInternalRep _ANSI_ARGS_(( Tcl_Obj* pathObjPtr, Tcl_Filesystem * fsPtr)); /* 466 */ -EXTERN char* Tcl_FSGetTranslatedPath _ANSI_ARGS_(( +EXTERN Tcl_Obj* Tcl_FSGetTranslatedPath _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 467 */ EXTERN int Tcl_FSEvalFile _ANSI_ARGS_((Tcl_Interp * interp, @@ -1478,7 +1479,7 @@ EXTERN Tcl_Obj* Tcl_FSFileSystemInfo _ANSI_ARGS_(( /* 471 */ EXTERN Tcl_Obj* Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); /* 472 */ -EXTERN int Tcl_FSListVolumes _ANSI_ARGS_((Tcl_Interp * interp)); +EXTERN Tcl_Obj* Tcl_FSListVolumes _ANSI_ARGS_((void)); /* 473 */ EXTERN int Tcl_FSRegister _ANSI_ARGS_((ClientData clientData, Tcl_Filesystem * fsPtr)); @@ -1486,6 +1487,9 @@ EXTERN int Tcl_FSRegister _ANSI_ARGS_((ClientData clientData, EXTERN int Tcl_FSUnregister _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 475 */ EXTERN ClientData Tcl_FSData _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); +/* 476 */ +EXTERN char* Tcl_FSGetTranslatedStringPath _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Obj* pathPtr)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -1991,7 +1995,7 @@ typedef struct TclStubs { int (*tcl_FSDeleteFile) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 443 */ int (*tcl_FSLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr, Tcl_FSUnloadFileProc ** unloadProcPtr)); /* 444 */ int (*tcl_FSMatchInDirectory) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * result, Tcl_Obj * pathPtr, char * pattern, Tcl_GlobTypeData * types)); /* 445 */ - Tcl_Obj* (*tcl_FSReadlink) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 446 */ + Tcl_Obj* (*tcl_FSLink) _ANSI_ARGS_((Tcl_Obj * pathPtr, Tcl_Obj * toPtr)); /* 446 */ int (*tcl_FSRemoveDirectory) _ANSI_ARGS_((Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr)); /* 447 */ int (*tcl_FSRenameFile) _ANSI_ARGS_((Tcl_Obj * srcPathPtr, Tcl_Obj * destPathPtr)); /* 448 */ int (*tcl_FSLstat) _ANSI_ARGS_((Tcl_Obj * pathPtr, struct stat * buf)); /* 449 */ @@ -2011,16 +2015,17 @@ typedef struct TclStubs { 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 */ - char* (*tcl_FSGetTranslatedPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 466 */ + 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_Obj* fromFilesystem, ClientData clientData)); /* 468 */ 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 */ - int (*tcl_FSListVolumes) _ANSI_ARGS_((Tcl_Interp * interp)); /* 472 */ + 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 */ + char* (*tcl_FSGetTranslatedStringPath) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj* pathPtr)); /* 476 */ } TclStubs; #ifdef __cplusplus @@ -3845,9 +3850,9 @@ extern TclStubs *tclStubsPtr; #define Tcl_FSMatchInDirectory \ (tclStubsPtr->tcl_FSMatchInDirectory) /* 445 */ #endif -#ifndef Tcl_FSReadlink -#define Tcl_FSReadlink \ - (tclStubsPtr->tcl_FSReadlink) /* 446 */ +#ifndef Tcl_FSLink +#define Tcl_FSLink \ + (tclStubsPtr->tcl_FSLink) /* 446 */ #endif #ifndef Tcl_FSRemoveDirectory #define Tcl_FSRemoveDirectory \ @@ -3965,6 +3970,10 @@ extern TclStubs *tclStubsPtr; #define Tcl_FSData \ (tclStubsPtr->tcl_FSData) /* 475 */ #endif +#ifndef Tcl_FSGetTranslatedStringPath +#define Tcl_FSGetTranslatedStringPath \ + (tclStubsPtr->tcl_FSGetTranslatedStringPath) /* 476 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 8576ca8..7f3c590 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.9 2001/08/11 18:43:21 vincentdarley Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.10 2001/08/23 17:37:07 vincentdarley Exp $ */ #include "tclInt.h" @@ -792,8 +792,7 @@ FileBasename(interp, pathPtr) if (objc > 0) { Tcl_ListObjIndex(NULL, splitPtr, objc-1, &resultPtr); if ((objc == 1) && - (Tcl_GetPathType(Tcl_GetString(resultPtr)) - != TCL_PATH_RELATIVE)) { + (Tcl_FSGetPathType(resultPtr, NULL, NULL) != TCL_PATH_RELATIVE)) { resultPtr = NULL; } } diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 0da7299..d9d7b62 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.16 2001/08/07 01:00:02 hobbs Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.17 2001/08/23 17:37:07 vincentdarley Exp $ */ #include "tclInt.h" @@ -20,11 +20,19 @@ /* * The following regular expression matches the root portion of a Windows * absolute or volume relative path. It will match both UNC and drive relative - * paths. + * paths. This pattern is no longer used, since it has been replaced by + * the ExtractWinRoot function. */ #define WIN_ROOT_PATTERN "^(([a-zA-Z]:)|[/\\\\][/\\\\]+([^/\\\\]+)[/\\\\]+([^/\\\\]+)|([/\\\\]))([/\\\\])*" +/* + * This define is used to activate Tcl's interpretation of Unix-style + * paths (containing forward slashes) on MacOS. + */ +#define MAC_UNDERSTANDS_UNIX_PATHS + +#ifdef MAC_UNDERSTANDS_UNIX_PATHS /* * The following regular expression matches the root portion of a Macintosh * absolute path. It will match degenerate Unix-style paths, tilde paths, @@ -32,6 +40,15 @@ */ #define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$" +#else +/* + * The following regular expression and some code below needs to be updated + * to allow complete removal of unix-style path matching. For the moment + * this regular expression is the same as the one above. + */ + +#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$" +#endif /* * The following variables are used to hold precompiled regular expressions @@ -65,12 +82,9 @@ static void FileNameCleanup _ANSI_ARGS_((ClientData clientData)); static void FileNameInit _ANSI_ARGS_((void)); static int SkipToChar _ANSI_ARGS_((char **stringPtr, char *match)); -static char * SplitMacPath _ANSI_ARGS_((CONST char *path, - Tcl_DString *bufPtr)); -static char * SplitWinPath _ANSI_ARGS_((CONST char *path, - Tcl_DString *bufPtr)); -static char * SplitUnixPath _ANSI_ARGS_((CONST char *path, - Tcl_DString *bufPtr)); +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)); /* *---------------------------------------------------------------------- @@ -175,6 +189,11 @@ ExtractWinRoot(path, resultPtr, offset, typePtr) break; } if (host[hlen] == 0 || host[hlen+1] == 0) { + /* + * The path given is simply of the form + * '/foo', '//foo', '/////foo' or the same + * with backslashes. + */ *typePtr = TCL_PATH_VOLUME_RELATIVE; Tcl_DStringAppend(resultPtr, "/", 1); return &path[2]; @@ -234,6 +253,10 @@ ExtractWinRoot(path, resultPtr, offset, typePtr) * * Determines whether a given path is relative to the current * directory, relative to the current volume, or absolute. + * + * The objectified Tcl_FSGetPathType should be used in + * preference to this function (as you can see below, this + * is just a wrapper around that other function). * * Results: * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or @@ -249,58 +272,174 @@ Tcl_PathType Tcl_GetPathType(path) char *path; { - ThreadSpecificData *tsdPtr; - Tcl_PathType type = TCL_PATH_ABSOLUTE; - Tcl_RegExp re; - - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - /* - * Paths that begin with / or ~ are absolute. - */ + Tcl_PathType type; + Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1); + Tcl_IncrRefCount(tempObj); + type = Tcl_FSGetPathType(tempObj, NULL, NULL); + Tcl_DecrRefCount(tempObj); + return type; +} + +/* + *---------------------------------------------------------------------- + * + * TclpGetNativePathType -- + * + * Determines whether a given path is relative to the current + * directory, relative to the current volume, or absolute, but + * ONLY FOR THE NATIVE FILESYSTEM. This function is called from + * tclIOUtil.c (but needs to be here due to its dependence on + * static variables/functions in this file). The exported + * function Tcl_FSGetPathType should be used by extensions. + * + * Results: + * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or + * TCL_PATH_VOLUME_RELATIVE. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ - if ((path[0] != '/') && (path[0] != '~')) { - type = TCL_PATH_RELATIVE; +Tcl_PathType +TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef) + Tcl_Obj *pathObjPtr; + int *driveNameLengthPtr; + Tcl_Obj **driveNameRef; +{ + Tcl_PathType type = TCL_PATH_ABSOLUTE; + int pathLen; + char *path = Tcl_GetStringFromObj(pathObjPtr, &pathLen); + + if (path[0] == '~') { + /* + * This case is common to all platforms. + * Paths that begin with ~ are absolute. + */ + if (driveNameLengthPtr != NULL) { + char *end = path + 1; + while ((*end != '\0') && (*end != '/')) { + end++; } - break; - - case TCL_PLATFORM_MAC: - if (path[0] == ':') { - type = TCL_PATH_RELATIVE; - } else if (path[0] != '~') { - tsdPtr = TCL_TSD_INIT(&dataKey); - + *driveNameLengthPtr = end - path; + } + } else { + switch (tclPlatform) { + case TCL_PLATFORM_UNIX: { + char *origPath = path; + /* - * Since we have eliminated the easy cases, use the - * root pattern to look for the other types. + * Paths that begin with / are absolute. */ - FileNameInit(); - re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, - REG_ADVANCED); - - if (!Tcl_RegExpExec(NULL, re, path, path)) { +#ifdef __QNX__ + /* + * Check for QNX //<node id> prefix + */ + if (*path && (pathLen > 3) && (path[0] == '/') + && (path[1] == '/') && isdigit(UCHAR(path[2]))) { + path += 3; + while (isdigit(UCHAR(*path))) { + ++path; + } + } +#endif + if (path[0] == '/') { + if (driveNameLengthPtr != NULL) { + /* + * We need this addition in case the QNX code + * was used + */ + *driveNameLengthPtr = (1 + path - origPath); + } + } else { + type = TCL_PATH_RELATIVE; + } + break; + } + case TCL_PLATFORM_MAC: + if (path[0] == ':') { type = TCL_PATH_RELATIVE; } else { - char *unixRoot, *dummy; + ThreadSpecificData *tsdPtr; + Tcl_RegExp re; + + tsdPtr = TCL_TSD_INIT(&dataKey); + + /* + * Since we have eliminated the easy cases, use the + * root pattern to look for the other types. + */ - Tcl_RegExpRange(re, 2, &unixRoot, &dummy); - if (unixRoot) { + FileNameInit(); + re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, + REG_ADVANCED); + + if (!Tcl_RegExpExec(NULL, re, path, path)) { type = TCL_PATH_RELATIVE; + } else { + char *root, *end; + + Tcl_RegExpRange(re, 2, &root, &end); + if (root != NULL) { + type = TCL_PATH_RELATIVE; + } else { + if (driveNameLengthPtr != NULL) { + Tcl_RegExpRange(re, 0, &root, &end); + *driveNameLengthPtr = end - root; + } +#ifdef MAC_UNDERSTANDS_UNIX_PATHS + if (driveNameRef != NULL) { + if (*root == '/') { + char *c; + int gotColon = 0; + *driveNameRef = Tcl_NewStringObj(root + 1, end - root -1); + c = Tcl_GetString(*driveNameRef); + while (*c != '\0') { + if (*c == '/') { + gotColon++; + *c = ':'; + } + c++; + } + /* + * If there is no colon, we have just a volume name + * so we must add a colon so it is an absolute path. + */ + if (gotColon == 0) { + Tcl_AppendToObj(*driveNameRef, ":", 1); + } else if ((gotColon > 1) && (*(c-1) == ':')) { + /* We have an extra colon */ + Tcl_SetObjLength(*driveNameRef, + c - Tcl_GetString(*driveNameRef) - 1); + } + } + } +#endif + } } } - } - break; - - case TCL_PLATFORM_WINDOWS: - if (path[0] != '~') { + break; + + case TCL_PLATFORM_WINDOWS: { Tcl_DString ds; - + CONST char *rootEnd; + Tcl_DStringInit(&ds); - (VOID)ExtractWinRoot(path, &ds, 0, &type); + rootEnd = ExtractWinRoot(path, &ds, 0, &type); + if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { + *driveNameLengthPtr = rootEnd - path; + if (driveNameRef != NULL) { + *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds)); + Tcl_IncrRefCount(*driveNameRef); + } + } Tcl_DStringFree(&ds); + break; } - break; + } } return type; } @@ -308,16 +447,15 @@ Tcl_GetPathType(path) /* *--------------------------------------------------------------------------- * - * Tcl_FSSplitPath -- + * TclpNativeSplitPath -- * * This function takes the given Tcl_Obj, which should be a valid * path, and returns a Tcl List object containing each segment * of that path as an element. * - * Note this function currently calls the older Tcl_SplitPath - * routine, which therefore requires more memory allocation and - * deallocation than necessary. We could easily rewrite this for - * greater efficiency. + * Note this function currently calls the older Split(Plat)Path + * functions, which require more memory allocation than is + * desirable. * * Results: * Returns list object with refCount of zero. If the passed in @@ -331,23 +469,37 @@ Tcl_GetPathType(path) */ Tcl_Obj* -Tcl_FSSplitPath(pathPtr, lenPtr) +TclpNativeSplitPath(pathPtr, lenPtr) Tcl_Obj *pathPtr; /* Path to split. */ int *lenPtr; /* int to store number of path elements. */ { - int argc, i; - char **argv; - Tcl_Obj *resultPtr = Tcl_NewObj(); + Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ - Tcl_SplitPath(Tcl_GetString(pathPtr), &argc, &argv); - if (lenPtr != NULL) { - *lenPtr = argc; + /* + * Perform platform specific splitting. + */ + + switch (tclPlatform) { + case TCL_PLATFORM_UNIX: + resultPtr = SplitUnixPath(Tcl_GetString(pathPtr)); + break; + + case TCL_PLATFORM_WINDOWS: + resultPtr = SplitWinPath(Tcl_GetString(pathPtr)); + break; + + case TCL_PLATFORM_MAC: + resultPtr = SplitMacPath(Tcl_GetString(pathPtr)); + break; } - for (i = 0; i < argc; i++) { - Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewStringObj(argv[i], -1)); + + /* + * Compute the number of elements in the result. + */ + + if (lenPtr != NULL) { + Tcl_ListObjLength(NULL, resultPtr, lenPtr); } - ckfree((char *) argv); return resultPtr; } @@ -385,48 +537,35 @@ Tcl_SplitPath(path, argcPtr, argvPtr) char ***argvPtr; /* Pointer to place to store pointer to array * of pointers to path elements. */ { + Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ + Tcl_Obj *tmpPtr; int i, size; char *p; - Tcl_DString buffer; - - Tcl_DStringInit(&buffer); /* - * Perform platform specific splitting. These routines will leave the - * result in the specified buffer. Individual elements are terminated - * with a null character. + * Perform the splitting, using objectified, vfs-aware code. */ - p = NULL; /* Needed only to prevent gcc warnings. */ - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - p = SplitUnixPath(path, &buffer); - break; + tmpPtr = Tcl_NewStringObj(path, -1); + Tcl_IncrRefCount(tmpPtr); + resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr); + Tcl_DecrRefCount(tmpPtr); - case TCL_PLATFORM_WINDOWS: - p = SplitWinPath(path, &buffer); - break; - - case TCL_PLATFORM_MAC: - p = SplitMacPath(path, &buffer); - break; - } - - /* - * Compute the number of elements in the result. - */ - - size = Tcl_DStringLength(&buffer); - *argcPtr = 0; - for (i = 0; i < size; i++) { - if (p[i] == '\0') { - (*argcPtr)++; - } + /* Calculate space required for the result */ + + size = 1; + for (i = 0; i < *argcPtr; i++) { + int len; + Tcl_Obj *elt; + + Tcl_ListObjIndex(NULL, resultPtr, i, &elt); + Tcl_GetStringFromObj(elt, &len); + size += len + 1; } /* - * Allocate a buffer large enough to hold the contents of the - * DString plus the argv pointers and the terminating NULL pointer. + * Allocate a buffer large enough to hold the contents of all of + * the list plus the argv pointers and the terminating NULL pointer. */ *argvPtr = (char **) ckalloc((unsigned) @@ -434,23 +573,33 @@ Tcl_SplitPath(path, argcPtr, argvPtr) /* * Position p after the last argv pointer and copy the contents of - * the DString. + * the list in, piece by piece. */ p = (char *) &(*argvPtr)[(*argcPtr) + 1]; - memcpy((VOID *) p, (VOID *) Tcl_DStringValue(&buffer), (size_t) size); - + for (i = 0; i < *argcPtr; i++) { + int len; + Tcl_Obj *elt; + char *str; + + Tcl_ListObjIndex(NULL, resultPtr, i, &elt); + str = Tcl_GetStringFromObj(elt, &len); + strncpy(p, str, len+1); + p += len+1; + } + /* * Now set up the argv pointers. */ + p = (char *) &(*argvPtr)[(*argcPtr) + 1]; + for (i = 0; i < *argcPtr; i++) { (*argvPtr)[i] = p; while ((*p++) != '\0') {} } (*argvPtr)[i] = NULL; - Tcl_DStringFree(&buffer); } /* @@ -458,12 +607,11 @@ Tcl_SplitPath(path, argcPtr, argvPtr) * * SplitUnixPath -- * - * This routine is used by Tcl_SplitPath to handle splitting + * This routine is used by Tcl_(FS)SplitPath to handle splitting * Unix paths. * * Results: - * Stores a null separated array of strings in the specified - * Tcl_DString. + * Returns a newly allocated Tcl list object. * * Side effects: * None. @@ -471,13 +619,13 @@ Tcl_SplitPath(path, argcPtr, argvPtr) *---------------------------------------------------------------------- */ -static char * -SplitUnixPath(path, bufPtr) +static Tcl_Obj* +SplitUnixPath(path) CONST char *path; /* Pointer to string containing a path. */ - Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int length; CONST char *p, *elementStart; + Tcl_Obj *result = Tcl_NewObj(); /* * Deal with the root directory as a special case. @@ -497,7 +645,7 @@ SplitUnixPath(path, bufPtr) #endif if (path[0] == '/') { - Tcl_DStringAppend(bufPtr, "/", 2); + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("/",1)); p = path+1; } else { p = path; @@ -515,30 +663,33 @@ SplitUnixPath(path, bufPtr) } length = p - elementStart; if (length > 0) { + Tcl_Obj *nextElt; if ((elementStart[0] == '~') && (elementStart != path)) { - Tcl_DStringAppend(bufPtr, "./", 2); + nextElt = Tcl_NewStringObj("./",2); + Tcl_AppendToObj(nextElt, elementStart, length); + } else { + nextElt = Tcl_NewStringObj(elementStart, length); } - Tcl_DStringAppend(bufPtr, elementStart, length); - Tcl_DStringAppend(bufPtr, "", 1); + Tcl_ListObjAppendElement(NULL, result, nextElt); } if (*p++ == '\0') { break; } } - return Tcl_DStringValue(bufPtr); + return result; } + /* *---------------------------------------------------------------------- * * SplitWinPath -- * - * This routine is used by Tcl_SplitPath to handle splitting + * This routine is used by Tcl_(FS)SplitPath to handle splitting * Windows paths. * * Results: - * Stores a null separated array of strings in the specified - * Tcl_DString. + * Returns a newly allocated Tcl list object. * * Side effects: * None. @@ -546,25 +697,30 @@ SplitUnixPath(path, bufPtr) *---------------------------------------------------------------------- */ -static char * -SplitWinPath(path, bufPtr) +static Tcl_Obj* +SplitWinPath(path) CONST char *path; /* Pointer to string containing a path. */ - Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int length; CONST char *p, *elementStart; Tcl_PathType type = TCL_PATH_ABSOLUTE; - - p = ExtractWinRoot(path, bufPtr, 0, &type); + Tcl_DString buf; + Tcl_Obj *result = Tcl_NewObj(); + Tcl_DStringInit(&buf); + + p = ExtractWinRoot(path, &buf, 0, &type); /* * Terminate the root portion, if we matched something. */ if (p != path) { - Tcl_DStringAppend(bufPtr, "", 1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&buf), + Tcl_DStringLength(&buf))); } - + Tcl_DStringFree(&buf); + /* * Split on slashes. Embedded elements that start with tilde will be * prefixed with "./" so they are not affected by tilde substitution. @@ -577,15 +733,18 @@ SplitWinPath(path, bufPtr) } length = p - elementStart; if (length > 0) { + Tcl_Obj *nextElt; if ((elementStart[0] == '~') && (elementStart != path)) { - Tcl_DStringAppend(bufPtr, "./", 2); + nextElt = Tcl_NewStringObj("./",2); + Tcl_AppendToObj(nextElt, elementStart, length); + } else { + nextElt = Tcl_NewStringObj(elementStart, length); } - Tcl_DStringAppend(bufPtr, elementStart, length); - Tcl_DStringAppend(bufPtr, "", 1); + Tcl_ListObjAppendElement(NULL, result, nextElt); } } while (*p++ != '\0'); - return Tcl_DStringValue(bufPtr); + return result; } /* @@ -593,11 +752,11 @@ SplitWinPath(path, bufPtr) * * SplitMacPath -- * - * This routine is used by Tcl_SplitPath to handle splitting + * This routine is used by Tcl_(FS)SplitPath to handle splitting * Macintosh paths. * * Results: - * Returns a newly allocated argv array. + * Returns a newly allocated Tcl list object. * * Side effects: * None. @@ -605,17 +764,19 @@ SplitWinPath(path, bufPtr) *---------------------------------------------------------------------- */ -static char * -SplitMacPath(path, bufPtr) +static Tcl_Obj* +SplitMacPath(path) CONST char *path; /* Pointer to string containing a path. */ - Tcl_DString *bufPtr; /* Pointer to DString to use for the result. */ { int isMac = 0; /* 1 if is Mac-style, 0 if Unix-style path. */ int i, length; CONST char *p, *elementStart; Tcl_RegExp re; + Tcl_Obj *result; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + result = Tcl_NewObj(); + /* * Initialize the path name parser for Macintosh path names. */ @@ -632,6 +793,7 @@ SplitMacPath(path, bufPtr) if (Tcl_RegExpExec(NULL, re, path, path) == 1) { char *start, *end; + Tcl_Obj *nextElt; /* * Treat degenerate absolute paths like / and /../.. as @@ -640,10 +802,11 @@ SplitMacPath(path, bufPtr) Tcl_RegExpRange(re, 2, &start, &end); if (start) { - Tcl_DStringAppend(bufPtr, ":", 1); + Tcl_Obj *elt = Tcl_NewStringObj(":", 1); Tcl_RegExpRange(re, 0, &start, &end); - Tcl_DStringAppend(bufPtr, path, end - start + 1); - return Tcl_DStringValue(bufPtr); + Tcl_AppendToObj(elt, path, end - start); + Tcl_ListObjAppendElement(NULL, result, elt); + return result; } Tcl_RegExpRange(re, 5, &start, &end); @@ -696,8 +859,9 @@ SplitMacPath(path, bufPtr) * we are forcing the DString to contain an extra null at the end. */ - Tcl_DStringAppend(bufPtr, start, length); - Tcl_DStringAppend(bufPtr, ":", 2); + nextElt = Tcl_NewStringObj(start, length); + Tcl_AppendToObj(nextElt, ":", 1); + Tcl_ListObjAppendElement(NULL, result, nextElt); p = end; } else { isMac = (strchr(path, ':') != NULL); @@ -716,7 +880,7 @@ SplitMacPath(path, bufPtr) length = p - elementStart; if (length == 1) { while (*p == ':') { - Tcl_DStringAppend(bufPtr, "::", 3); + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj("::",2)); elementStart = p++; } } else { @@ -729,8 +893,8 @@ SplitMacPath(path, bufPtr) elementStart++; length--; } - Tcl_DStringAppend(bufPtr, elementStart, length); - Tcl_DStringAppend(bufPtr, "", 1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(elementStart, length)); elementStart = p++; } } @@ -739,8 +903,8 @@ SplitMacPath(path, bufPtr) && (strchr(elementStart+1, '/') == NULL)) { elementStart++; } - Tcl_DStringAppend(bufPtr, elementStart, -1); - Tcl_DStringAppend(bufPtr, "", 1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(elementStart, -1)); } } else { @@ -756,16 +920,21 @@ SplitMacPath(path, bufPtr) length = p - elementStart; if (length > 0) { if ((length == 1) && (elementStart[0] == '.')) { - Tcl_DStringAppend(bufPtr, ":", 2); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(":", 1)); } else if ((length == 2) && (elementStart[0] == '.') && (elementStart[1] == '.')) { - Tcl_DStringAppend(bufPtr, "::", 3); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj("::", 2)); } else { + Tcl_Obj *nextElt; if (*elementStart == '~') { - Tcl_DStringAppend(bufPtr, ":", 1); + nextElt = Tcl_NewStringObj(":",1); + Tcl_AppendToObj(nextElt, elementStart, length); + } else { + nextElt = Tcl_NewStringObj(elementStart, length); } - Tcl_DStringAppend(bufPtr, elementStart, length); - Tcl_DStringAppend(bufPtr, "", 1); + Tcl_ListObjAppendElement(NULL, result, nextElt); } } if (*p++ == '\0') { @@ -773,7 +942,7 @@ SplitMacPath(path, bufPtr) } } } - return Tcl_DStringValue(bufPtr); + return result; } /* @@ -820,20 +989,12 @@ Tcl_FSJoinToPath(basePtr, objc, objv) /* *--------------------------------------------------------------------------- * - * Tcl_FSJoinPath -- + * TclpNativeJoinPath -- * - * This function takes the given Tcl_Obj, which should be a valid - * list, and returns the path object given by considering the - * first 'elements' elements as valid path segments. If elements < 0, - * we use the entire list. - * - * Note this function currently calls the older Tcl_JoinPath - * routine, which therefore requires more memory allocation and - * deallocation than necessary. We could easily rewrite this for - * greater efficiency. + * 'prefix' is absolute, 'joining' is relative to prefix. * * Results: - * Returns object with refCount of zero. + * modifies prefix * * Side effects: * None. @@ -841,42 +1002,188 @@ Tcl_FSJoinToPath(basePtr, objc, objv) *--------------------------------------------------------------------------- */ -Tcl_Obj* -Tcl_FSJoinPath(listObj, elements) - Tcl_Obj *listObj; - int elements; +void +TclpNativeJoinPath(prefix, joining) + Tcl_Obj *prefix; + char* joining; { - char ** argv; - int count; - Tcl_DString ds; - Tcl_Obj *res; - if (elements < 0) { - if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { - return NULL; - } - } else { - /* Just make sure it is a valid list */ - int listTest; - if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { - return NULL; + int length, needsSep; + char *dest, *p, *start; + + start = Tcl_GetStringFromObj(prefix, &length); + + /* + * Remove the ./ from tilde prefixed elements unless + * it is the first component. + */ + + p = joining; + + if (length != 0) { + if ((p[0] == '.') && (p[1] == '/') && (p[2] == '~')) { + p += 2; } - /* - * It doesn't actually matter if 'elements' is greater - * than the actual number of elements. - */ } - argv = (char **)ckalloc(elements*sizeof(char*)); - - for (count = 0; count < elements; count++) { - Tcl_Obj* elt; - Tcl_ListObjIndex(NULL, listObj,count,&elt); - argv[count] = Tcl_GetString(elt); + + if (*p == '\0') { + return; } - Tcl_DStringInit(&ds); - res = Tcl_NewStringObj(Tcl_JoinPath(elements, argv, &ds),-1); - Tcl_DStringFree(&ds); - ckfree((char*)argv); - return res; + + + switch (tclPlatform) { + case TCL_PLATFORM_UNIX: + + /* + * Append a separator if needed. + */ + + if (length > 0 && (start[length-1] != '/')) { + Tcl_AppendToObj(prefix, "/", 1); + length++; + } + needsSep = 0; + + /* + * Append the element, eliminating duplicate and trailing + * slashes. + */ + + Tcl_SetObjLength(prefix, length + strlen(p)); + + dest = Tcl_GetString(prefix) + length; + for (; *p != '\0'; p++) { + if (*p == '/') { + while (p[1] == '/') { + p++; + } + if (p[1] != '\0') { + if (needsSep) { + *dest++ = '/'; + } + } + } else { + *dest++ = *p; + needsSep = 1; + } + } + length = dest - Tcl_GetString(prefix); + Tcl_SetObjLength(prefix, length); + break; + + case TCL_PLATFORM_WINDOWS: + /* + * Check to see if we need to append a separator. + */ + + if ((length > 0) && + (start[length-1] != '/') && (start[length-1] != ':')) { + Tcl_AppendToObj(prefix, "/", 1); + length++; + } + needsSep = 0; + + /* + * Append the element, eliminating duplicate and + * trailing slashes. + */ + + Tcl_SetObjLength(prefix, length + strlen(p)); + dest = Tcl_GetString(prefix) + length; + for (; *p != '\0'; p++) { + if ((*p == '/') || (*p == '\\')) { + while ((p[1] == '/') || (p[1] == '\\')) { + p++; + } + if (p[1] != '\0') { + if (needsSep) { + *dest++ = '/'; + } + } + } else { + *dest++ = *p; + needsSep = 1; + } + } + length = dest - Tcl_GetString(prefix); + Tcl_SetObjLength(prefix, length); + break; + + case TCL_PLATFORM_MAC: { + int newLength; + + /* + * Sort out separators. We basically add the object we've + * been given, but we have to make sure that there is + * exactly one separator inbetween (unless the object we're + * adding contains multiple contiguous colons, all of which + * we must add). Also if an object is just ':' we don't + * both to add it unless it's the very first element. + */ + +#ifdef MAC_UNDERSTANDS_UNIX_PATHS + int adjustedPath = 0; + if ((strchr(p, ':') == NULL) && (strchr(p, '/') != NULL)) { + char *start = p; + adjustedPath = 1; + while (*start != '\0') { + if (*start == '/') { + *start = ':'; + } + start++; + } + } +#endif + if (length > 0) { + if ((p[0] == ':') && (p[1] == '\0')) { + return; + } + if (start[length-1] != ':') { + if (*p != '\0' && *p != ':') { + Tcl_AppendToObj(prefix, ":", 1); + length++; + } + } else if (*p == ':') { + p++; + } + } else { + if (*p != '\0' && *p != ':') { + Tcl_AppendToObj(prefix, ":", 1); + length++; + } + } + + /* + * Append the element + */ + + newLength = strlen(p); + Tcl_AppendToObj(prefix, p, newLength); + + /* Remove spurious trailing single ':' */ + dest = Tcl_GetString(prefix) + length + newLength; + if (*(dest-1) == ':') { + if (dest-1 > Tcl_GetString(prefix)) { + if (*(dest-2) != ':') { + Tcl_SetObjLength(prefix, length + newLength -1); + } + } + } +#ifdef MAC_UNDERSTANDS_UNIX_PATHS + /* Revert the path to what it was */ + if (adjustedPath) { + char *start = joining; + while (*start != '\0') { + if (*start == ':') { + *start = '/'; + } + start++; + } + } +#endif + break; + } + } + return; } /* @@ -887,9 +1194,9 @@ Tcl_FSJoinPath(listObj, elements) * Combine a list of paths in a platform specific manner. * * Results: - * Appends the joined path to the end of the specified - * returning a pointer to the resulting string. Note that - * the Tcl_DString must already be initialized. + * Appends the joined path to the end of the specified + * Tcl_DString returning a pointer to the resulting string. Note + * that the Tcl_DString must already be initialized. * * Side effects: * Modifies the Tcl_DString. @@ -904,12 +1211,10 @@ Tcl_JoinPath(argc, argv, resultPtr) Tcl_DString *resultPtr; /* Pointer to previously initialized DString. */ { int oldLength, length, i, needsSep; - Tcl_DString buffer; char c, *dest; CONST char *p; Tcl_PathType type = TCL_PATH_ABSOLUTE; - Tcl_DStringInit(&buffer); oldLength = Tcl_DStringLength(resultPtr); switch (tclPlatform) { @@ -1063,17 +1368,30 @@ Tcl_JoinPath(argc, argv, resultPtr) case TCL_PLATFORM_MAC: needsSep = 1; for (i = 0; i < argc; i++) { - Tcl_DStringSetLength(&buffer, 0); - p = SplitMacPath(argv[i], &buffer); - if ((*p != ':') && (*p != '\0') - && (strchr(p, ':') != NULL)) { + Tcl_Obj *splitPtr; + Tcl_Obj *eltPtr; + int eltLen; + int splitIndex = 0; + int splitElements; + + splitPtr = SplitMacPath(argv[i]); + + Tcl_ListObjLength(NULL, splitPtr, &splitElements); + if (splitElements == 0) { + Tcl_DecrRefCount(splitPtr); + continue; + } + + Tcl_ListObjIndex(NULL, splitPtr, 0, &eltPtr); + p = Tcl_GetStringFromObj(eltPtr, &eltLen); + if ((eltLen != 0) && (*p != ':') && (strchr(p, ':') != NULL)) { Tcl_DStringSetLength(resultPtr, oldLength); length = strlen(p); - Tcl_DStringAppend(resultPtr, p, length); + Tcl_DStringAppend(resultPtr, p, eltLen); needsSep = 0; - p += length+1; + splitIndex++; } - + /* * Now append the rest of the path elements, skipping * : unless it is the first element of the path, and @@ -1081,7 +1399,9 @@ Tcl_JoinPath(argc, argv, resultPtr) * too many colons in the result. */ - for (; *p != '\0'; p += length+1) { + for (; splitIndex < splitElements; splitIndex++) { + Tcl_ListObjIndex(NULL, splitPtr, splitIndex, &eltPtr); + p = Tcl_GetStringFromObj(eltPtr, &eltLen); if (p[0] == ':' && p[1] == '\0') { if (Tcl_DStringLength(resultPtr) != oldLength) { p++; @@ -1104,11 +1424,11 @@ Tcl_JoinPath(argc, argv, resultPtr) length = strlen(p); Tcl_DStringAppend(resultPtr, p, length); } + Tcl_DecrRefCount(splitPtr); } break; } - Tcl_DStringFree(&buffer); return Tcl_DStringValue(resultPtr); } @@ -1235,11 +1555,15 @@ TclGetExtension(name) break; case TCL_PLATFORM_MAC: +#ifdef MAC_UNDERSTANDS_UNIX_PATHS if (strchr(name, ':') == NULL) { lastSep = strrchr(name, '/'); } else { lastSep = strrchr(name, ':'); } +#else + lastSep = strrchr(name, ':'); +#endif break; case TCL_PLATFORM_WINDOWS: @@ -1791,11 +2115,15 @@ TclGlob(interp, pattern, unquotedPrefix, globFlags, types) separators = "/\\:"; break; case TCL_PLATFORM_MAC: +#ifdef MAC_UNDERSTANDS_UNIX_PATHS if (unquotedPrefix == NULL) { separators = (strchr(pattern, ':') == NULL) ? "/" : ":"; } else { separators = ":"; } +#else + separators = ":"; +#endif break; } @@ -2060,12 +2388,14 @@ TclDoGlob(interp, separators, headPtr, tail, types) 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); @@ -2078,7 +2408,9 @@ TclDoGlob(interp, separators, headPtr, tail, types) Tcl_DStringAppend(headPtr, ":", 1); } } +#ifdef MAC_UNDERSTANDS_UNIX_PATHS } +#endif break; case TCL_PLATFORM_WINDOWS: /* @@ -2254,9 +2586,9 @@ TclDoGlob(interp, separators, headPtr, tail, types) Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1); if(tclPlatform == TCL_PLATFORM_MAC) { - Tcl_DStringAppend(&ds, ":",1); + Tcl_DStringAppend(&ds, ":",1); } else { - Tcl_DStringAppend(&ds, "/",1); + Tcl_DStringAppend(&ds, "/",1); } ret = TclDoGlob(interp, separators, &ds, p+1, types); Tcl_DStringFree(&ds); @@ -2274,87 +2606,83 @@ TclDoGlob(interp, separators, headPtr, tail, types) Tcl_DStringAppend(headPtr, tail, p-tail); if (*p != '\0') { return TclDoGlob(interp, separators, headPtr, p, types); - } + } else { + /* + * There are no more wildcards in the pattern and no more + * unprocessed characters in the tail, so now we can construct + * the path and verify the existence of the file. + * + * We can't use 'Tcl_(FS)Access' to verify existence because + * this fails when the file is a symlink to another file which + * doesn't actually exist. The problem is that if 'foo' is + * such a broken link, 'glob foo' and 'glob foo*' return + * different results. So, we use 'Tcl_FSLstat' below so those + * two return the same result. This fixes [Bug 434876, L. + * Virden] + */ - /* - * There are no more wildcards in the pattern and no more unprocessed - * characters in the tail, so now we can construct the path and verify - * the existence of the file. - */ + Tcl_Obj *nameObj; + struct stat buf; + /* Used to deal with one special case pertinent to MacOS */ + int macSpecialCase = 0; - switch (tclPlatform) { - case TCL_PLATFORM_MAC: { - if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) { - Tcl_DStringAppend(headPtr, ":", 1); - } - name = Tcl_DStringValue(headPtr); - if (Tcl_Access(name, F_OK) == 0) { - if ((name[1] != '\0') && (strchr(name+1, ':') == NULL)) { - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), - Tcl_NewStringObj(name + 1,-1)); - } else { - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), - Tcl_NewStringObj(name,-1)); + switch (tclPlatform) { + case TCL_PLATFORM_MAC: { + if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) { + Tcl_DStringAppend(headPtr, ":", 1); } + macSpecialCase = 1; + break; } - break; - } - case TCL_PLATFORM_WINDOWS: { - int exists; - - /* - * We need to convert slashes to backslashes before checking - * for the existence of the file. Once we are done, we need - * to convert the slashes back. - * - * This backslash/forward slash conversion may no longer - * be necessary, since we have dropped Win3.1 support. - */ - - if (Tcl_DStringLength(headPtr) == 0) { - if (((*name == '\\') && (name[1] == '/' || name[1] == '\\')) - || (*name == '/')) { - Tcl_DStringAppend(headPtr, "\\", 1); - } else { - Tcl_DStringAppend(headPtr, ".", 1); + 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); + } } - } else { + /* + * 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 = '\\'; + if (*p == '\\') { + *p = '/'; } } + break; } - name = Tcl_DStringValue(headPtr); - exists = (Tcl_Access(name, F_OK) == 0); - - for (p = name; *p != '\0'; p++) { - if (*p == '\\') { - *p = '/'; + case TCL_PLATFORM_UNIX: { + if (Tcl_DStringLength(headPtr) == 0) { + if ((*name == '\\' && name[1] == '/') || (*name == '/')) { + Tcl_DStringAppend(headPtr, "/", 1); + } else { + Tcl_DStringAppend(headPtr, ".", 1); + } } + break; } - if (exists) { - Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), - Tcl_NewStringObj(name,-1)); - } - break; } - case TCL_PLATFORM_UNIX: { - if (Tcl_DStringLength(headPtr) == 0) { - if ((*name == '\\' && name[1] == '/') || (*name == '/')) { - Tcl_DStringAppend(headPtr, "/", 1); - } else { - Tcl_DStringAppend(headPtr, ".", 1); - } - } - name = Tcl_DStringValue(headPtr); - if (Tcl_Access(name, F_OK) == 0) { + /* Common for all platforms */ + name = Tcl_DStringValue(headPtr); + nameObj = Tcl_NewStringObj(name, Tcl_DStringLength(headPtr)); + + Tcl_IncrRefCount(nameObj); + if (Tcl_FSLstat(nameObj, &buf) == 0) { + if (macSpecialCase && (name[1] != '\0') + && (strchr(name+1, ':') == NULL)) { Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), - Tcl_NewStringObj(name,-1)); + Tcl_NewStringObj(name + 1,-1)); + } else { + Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp), + nameObj); } - break; } + Tcl_DecrRefCount(nameObj); + return TCL_OK; } - - return TCL_OK; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 8ef6e12..c05f530 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.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: tclIO.c,v 1.33 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.34 2001/08/23 17:37:07 vincentdarley Exp $ */ #include "tclInt.h" @@ -876,6 +876,10 @@ Tcl_UnregisterChannel(interp, chan) * in which you need to generate a pristine channel from one * that has already been used. All ordinary purposes will almost * always want to use Tcl_UnregisterChannel instead. + * + * Provided the channel is not attached to any other interpreter, + * it can then be closed with Tcl_Close, rather than with + * Tcl_UnregisterChannel. * * Results: * A standard Tcl result. If the channel is not currently registered @@ -926,7 +930,7 @@ Tcl_DetachChannel(interp, chan) *---------------------------------------------------------------------- */ -int +static int DetachChannel(interp, chan) Tcl_Interp *interp; /* Interpreter in which channel is defined. */ Tcl_Channel chan; /* Channel to delete. */ @@ -2823,7 +2827,7 @@ Tcl_WriteChars(chan, src, len) *---------------------------------------------------------------------- */ -int +static int DoWriteChars(chanPtr, src, len) Channel* chanPtr; /* The channel to buffer output for. */ CONST char *src; /* UTF-8 characters to queue in output buffer. */ @@ -4274,7 +4278,7 @@ Tcl_ReadChars(chan, objPtr, toRead, appendFlag) *--------------------------------------------------------------------------- */ -int +static int DoReadChars(chanPtr, objPtr, toRead, appendFlag) Channel* chanPtr; /* The channel to read. */ Tcl_Obj *objPtr; /* Input data is stored in this object. */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 4dd0cfa..d191758 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.14 2001/08/11 18:43:21 vincentdarley Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.15 2001/08/23 17:37:08 vincentdarley Exp $ */ #include "tclInt.h" @@ -35,7 +35,7 @@ static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr)); static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); static Tcl_Obj* FSNormalizeAbsolutePath - _ANSI_ARGS_((Tcl_Interp* interp, char *path)); + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr)); static int TclNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr)); static int SetFsPathFromAbsoluteNormalized @@ -43,6 +43,9 @@ static int SetFsPathFromAbsoluteNormalized static int FindSplitPos _ANSI_ARGS_((char *path, char *separator)); static Tcl_Filesystem* Tcl_FSGetFileSystemForPath _ANSI_ARGS_((Tcl_Obj* pathObjPtr)); +static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, + Tcl_Filesystem **filesystemPtrPtr, + int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); /* * Define the 'path' object type, which Tcl uses to represent @@ -184,6 +187,17 @@ Tcl_EvalFile(interp, fileName) return ret; } +/* Obsolete */ +int +TclpListVolumes( + Tcl_Interp *interp) /* Interpreter for returning volume list. */ +{ + Tcl_Obj *resultPtr = TclpObjListVolumes(); + Tcl_SetObjResult(interp, resultPtr); + Tcl_DecrRefCount(resultPtr); + return TCL_OK; +} + /* * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The @@ -313,8 +327,8 @@ Tcl_FSCreateDirectoryProc TclpObjCreateDirectory; Tcl_FSCopyDirectoryProc TclpObjCopyDirectory; Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory; Tcl_FSUnloadFileProc TclpUnloadFile; -Tcl_FSReadlinkProc TclpObjReadlink; -Tcl_FSListVolumesProc TclpListVolumes; +Tcl_FSLinkProc TclpObjLink; +Tcl_FSListVolumesProc TclpObjListVolumes; /* Define the native filesystem dispatch table */ static Tcl_Filesystem nativeFilesystem = { @@ -337,9 +351,9 @@ static Tcl_Filesystem nativeFilesystem = { #ifndef S_IFLNK NULL, #else - &TclpObjReadlink, + &TclpObjLink, #endif /* S_IFLNK */ - &TclpListVolumes, + &TclpObjListVolumes, &NativeFileAttrStrings, &NativeFileAttrsGet, &NativeFileAttrsSet, @@ -406,7 +420,7 @@ TCL_DECLARE_MUTEX(filesystemMutex) * container Tcl_Obj of this FsPath. */ typedef struct FsPath { - char *translatedPathPtr; /* Name without any ~user sequences. + Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. * If this is NULL, then this is a * pure normalized, absolute path * object, in which the parent Tcl_Obj's @@ -731,31 +745,42 @@ Tcl_FSData(fsPtr) *--------------------------------------------------------------------------- */ static Tcl_Obj* -FSNormalizeAbsolutePath(interp, path) +FSNormalizeAbsolutePath(interp, pathPtr) Tcl_Interp* interp; /* Interpreter to use */ - char *path; /* Absolute path to normalize (UTF-8) */ + Tcl_Obj *pathPtr; /* Absolute path to normalize */ { - char **sp = NULL, *np[BUFSIZ]; int splen = 0, nplen, i; Tcl_Obj *retVal; + Tcl_Obj *split; - Tcl_SplitPath(path, &splen, &sp); - + /* Split has refCount zero */ + split = Tcl_FSSplitPath(pathPtr, &splen); + + /* + * Modify the list of entries in place, by removing '.', and + * removing '..' and the entry before -- unless that entry before + * is the top-level entry, i.e. the name of a volume. + */ nplen = 0; for (i = 0;i < splen;i++) { - if (strcmp(sp[i], ".") == 0) - continue; - - if (strcmp(sp[i], "..") == 0) { - if (nplen > 1) nplen--; + Tcl_Obj *elt; + Tcl_ListObjIndex(NULL, split, nplen, &elt); + + if (strcmp(Tcl_GetString(elt), ".") == 0) { + Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL); + } else if (strcmp(Tcl_GetString(elt), "..") == 0) { + if (nplen > 1) { + nplen--; + Tcl_ListObjReplace(NULL, split, nplen, 2, 0, NULL); + } else { + Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL); + } } else { - np[nplen++] = sp[i]; + nplen++; } } if (nplen > 0) { - Tcl_DString dtemp; - Tcl_DStringInit(&dtemp); - Tcl_JoinPath(nplen, np, &dtemp); + retVal = Tcl_FSJoinPath(split, nplen); /* * Now we have an absolute path, with no '..', '.' sequences, * but it still may not be in 'unique' form, depending on the @@ -767,8 +792,6 @@ FSNormalizeAbsolutePath(interp, path) * Virtual file systems which may be registered may have * other criteria for normalizing a path. */ - retVal = Tcl_NewStringObj(Tcl_DStringValue(&dtemp),-1); - Tcl_DStringFree(&dtemp); Tcl_IncrRefCount(retVal); TclNormalizeToUniquePath(interp, retVal); /* @@ -782,7 +805,17 @@ FSNormalizeAbsolutePath(interp, path) retVal = Tcl_NewStringObj("",0); Tcl_IncrRefCount(retVal); } - ckfree((char*) sp); + /* + * We increment and then decrement the refCount of split to free + * it. We do this right at the end, in case there are + * optimisations in Tcl_FSJoinPath(split, nplen) above which would + * let it make use of split more effectively if it has a refCount + * of zero. Also we can't just decrement the ref count, in case + * 'split' was actually returned by the join call above, in a + * single-element optimisation when nplen == 1. + */ + Tcl_IncrRefCount(split); + Tcl_DecrRefCount(split); /* This has a refCount of 1 for the caller */ return retVal; @@ -1258,12 +1291,18 @@ Tcl_FSStat(pathPtr, buf) Tcl_Obj *pathPtr; /* Path of file to stat (in current CP). */ struct stat *buf; /* Filled with results of stat call. */ { + Tcl_Filesystem *fsPtr; #ifdef USE_OBSOLETE_FS_HOOKS StatProc *statProcPtr; int retVal = -1; + char *path; + Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); + if (transPtr == NULL) { + path = NULL; + } else { + path = Tcl_GetString(transPtr); + } #endif /* USE_OBSOLETE_FS_HOOKS */ - Tcl_Filesystem *fsPtr; - char *path = Tcl_FSGetTranslatedPath(NULL, pathPtr); /* * Call each of the "stat" function in succession. A non-return @@ -1357,12 +1396,18 @@ Tcl_FSAccess(pathPtr, mode) Tcl_Obj *pathPtr; /* Path of file to access (in current CP). */ int mode; /* Permission setting. */ { + Tcl_Filesystem *fsPtr; #ifdef USE_OBSOLETE_FS_HOOKS AccessProc *accessProcPtr; int retVal = -1; + char *path; + Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); + if (transPtr == NULL) { + path = NULL; + } else { + path = Tcl_GetString(transPtr); + } #endif /* USE_OBSOLETE_FS_HOOKS */ - Tcl_Filesystem *fsPtr; - char *path = Tcl_FSGetTranslatedPath(NULL, pathPtr); /* * Call each of the "access" function in succession. A non-return @@ -1422,15 +1467,23 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions) * file, with what modes to create * it? */ { + Tcl_Filesystem *fsPtr; #ifdef USE_OBSOLETE_FS_HOOKS OpenFileChannelProc *openFileChannelProcPtr; Tcl_Channel retVal = NULL; + char *path; #endif /* USE_OBSOLETE_FS_HOOKS */ - Tcl_Filesystem *fsPtr; - char *path = Tcl_FSGetTranslatedPath(interp, pathPtr); - if (path == NULL) { + Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); + if (transPtr == NULL) { return NULL; } +#ifdef USE_OBSOLETE_FS_HOOKS + if (transPtr == NULL) { + path = NULL; + } else { + path = Tcl_GetString(transPtr); + } +#endif /* USE_OBSOLETE_FS_HOOKS */ /* * Call each of the "Tcl_OpenFileChannel" function in succession. @@ -1672,8 +1725,7 @@ Tcl_FSGetCwd(interp) * could be problematic. */ if (retVal != NULL) { - Tcl_Obj *norm = FSNormalizeAbsolutePath(interp, - Tcl_GetString(retVal)); + Tcl_Obj *norm = FSNormalizeAbsolutePath(interp, retVal); if (norm != NULL) { /* * We found a cwd, which is now in our global storage. @@ -1722,8 +1774,7 @@ Tcl_FSGetCwd(interp) if (proc != NULL) { Tcl_Obj *retVal = (*proc)(interp); if (retVal != NULL) { - Tcl_Obj *norm = FSNormalizeAbsolutePath(interp, - Tcl_GetString(retVal)); + Tcl_Obj *norm = FSNormalizeAbsolutePath(interp, retVal); /* * Check whether cwd has changed from the value * previously stored in cwdPathPtr. Really 'norm' @@ -1833,7 +1884,7 @@ Tcl_FSUtime (pathPtr, tval) *---------------------------------------------------------------------- */ -char** +static char** NativeFileAttrStrings(pathPtr, objPtrRef) Tcl_Obj *pathPtr; Tcl_Obj** objPtrRef; @@ -1865,16 +1916,16 @@ NativeFileAttrStrings(pathPtr, objPtrRef) *---------------------------------------------------------------------- */ -int +static int NativeFileAttrsGet(interp, index, fileName, objPtrRef) Tcl_Interp *interp; /* The interpreter for error reporting. */ int index; /* index of the attribute command. */ Tcl_Obj *fileName; /* filename we are operating on. */ Tcl_Obj **objPtrRef; /* for output. */ { + Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, fileName); return (*tclpFileAttrProcs[index].getProc)(interp, index, - Tcl_FSGetTranslatedPath(NULL, fileName), - objPtrRef); + transPtr, objPtrRef); } /* @@ -1897,16 +1948,16 @@ NativeFileAttrsGet(interp, index, fileName, objPtrRef) *---------------------------------------------------------------------- */ -int +static int NativeFileAttrsSet(interp, index, fileName, objPtr) Tcl_Interp *interp; /* The interpreter for error reporting. */ int index; /* index of the attribute command. */ Tcl_Obj *fileName; /* filename we are operating on. */ Tcl_Obj *objPtr; /* set to this value. */ { + Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, fileName); return (*tclpFileAttrProcs[index].setProc)(interp, index, - Tcl_FSGetTranslatedPath(NULL, fileName), - objPtr); + transPtr, objPtr); } /* @@ -2280,18 +2331,29 @@ FSUnloadTempFile(clientData) /* *--------------------------------------------------------------------------- * - * Tcl_FSReadlink -- + * Tcl_FSLink -- * - * This function replaces the library version of readlink(). - * The appropriate function for the filesystem to which pathPtr - * belongs will be called. + * This function replaces the library version of readlink() and + * can also be used to make links. The appropriate function for + * the filesystem to which pathPtr belongs will be called. * * Results: - * The result is a Tcl_Obj specifying the contents - * of the symbolic link given by 'path', or NULL if the symbolic - * link could not be read. The result is owned by the caller, - * which should call Tcl_DecrRefCount when the result is no longer - * needed. + * If toPtr is NULL, then the result is a Tcl_Obj specifying the + * contents of the symbolic link given by 'pathPtr', or NULL if + * the symbolic link could not be read. The result is owned by + * the caller, which should call Tcl_DecrRefCount when the result + * is no longer needed. + * + * If toPtr is non-NULL, then the result is toPtr if the link + * was successful, or NULL if not. In this case the result has no + * additional reference count, and need not be freed. + * + * Note that most filesystems will not support linking across + * to different filesystems, so this function will usually + * fail unless toPtr is in the same FS as pathPtr. + * + * Note: currently no Tcl filesystems support the 'link' action, + * so we actually always return an error for that call. * * Side effects: * See readlink() documentation. @@ -2300,14 +2362,15 @@ FSUnloadTempFile(clientData) */ Tcl_Obj * -Tcl_FSReadlink(pathPtr) - Tcl_Obj *pathPtr; /* Path of file to readlink (UTF-8). */ +Tcl_FSLink(pathPtr, toPtr) + Tcl_Obj *pathPtr; /* Path of file to readlink or link */ + Tcl_Obj *toPtr; /* NULL or path to be linked to */ { Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); if (fsPtr != NULL) { - Tcl_FSReadlinkProc *proc = fsPtr->readlinkProc; + Tcl_FSLinkProc *proc = fsPtr->linkProc; if (proc != NULL) { - return (*proc)(pathPtr); + return (*proc)(pathPtr, toPtr); } } /* @@ -2328,15 +2391,13 @@ Tcl_FSReadlink(pathPtr) * * Tcl_FSListVolumes -- * - * Lists the currently mounted volumes. - * The chain of functions that have been "inserted" into the - * filesystem will be called in succession; each may add to - * the Tcl result, until all mounted file systems are listed. + * Lists the currently mounted volumes. The chain of functions + * that have been "inserted" into the filesystem will be called in + * succession; each may return a list of volumes, all of which are + * added to the result until all mounted file systems are listed. * * Results: - * A standard Tcl result. Will always be TCL_OK, since there is no way - * that this command can fail. Also, the interpreter's result is set to - * the list of volumes. + * The list of volumes, in an object which has refCount 0. * * Side effects: * None @@ -2344,12 +2405,12 @@ Tcl_FSReadlink(pathPtr) *--------------------------------------------------------------------------- */ -int -Tcl_FSListVolumes(interp) - Tcl_Interp *interp; /* Interpreter for returning volume list. */ +Tcl_Obj* +Tcl_FSListVolumes(void) { FilesystemRecord *fsRecPtr; - + Tcl_Obj *resultPtr = Tcl_NewObj(); + /* * Call each of the "listVolumes" function in succession. * A non-NULL return value indicates the particular function has @@ -2361,14 +2422,407 @@ Tcl_FSListVolumes(interp) while (fsRecPtr != NULL) { Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc; if (proc != NULL) { - /* Ignore return value */ - (*proc)(interp); + Tcl_Obj *thisFsVolumes = (*proc)(); + if (thisFsVolumes != NULL) { + Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes); + Tcl_DecrRefCount(thisFsVolumes); + } } fsRecPtr = fsRecPtr->nextPtr; } FsReleaseIterator(); - return TCL_OK; + return resultPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_FSGetPathType -- + * + * Determines whether a given path is relative to the current + * directory, relative to the current volume, or absolute. If the + * caller wishes to know which filesystem claimed the path (in the + * case for which the path is absolute), then a reference to a + * filesystem pointer can be passed in (but passing NULL is + * acceptable). + * + * Results: + * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or + * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will + * be set if and only if it is non-NULL and the function's + * return value is TCL_PATH_ABSOLUTE. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_PathType +Tcl_FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr) + Tcl_Obj *pathObjPtr; + Tcl_Filesystem **filesystemPtrPtr; + int *driveNameLengthPtr; +{ + if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) { + return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); + } else { + FsPath *fsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; + if (fsPathPtr->cwdPtr != NULL) { + return TCL_PATH_RELATIVE; + } else { + return GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, NULL); + } + } +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_FSSplitPath -- + * + * This function takes the given Tcl_Obj, which should be a valid + * path, and returns a Tcl List object containing each segment + * of that path as an element. + * + * Note this function currently calls the older Split(Plat)Path + * functions, which require more memory allocation than is + * desirable. + * + * Results: + * Returns list object with refCount of zero. If the passed in + * lenPtr is non-NULL, we use it to return the number of elements + * in the returned list. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +Tcl_Obj* +Tcl_FSSplitPath(pathPtr, lenPtr) + Tcl_Obj *pathPtr; /* Path to split. */ + int *lenPtr; /* int to store number of path elements. */ +{ + Tcl_Obj *result = NULL; /* Needed only to prevent gcc warnings. */ + Tcl_Filesystem *fsPtr; + char separator = '/'; + int driveNameLength; + char *p; + + /* + * Perform platform specific splitting. + */ + + if (Tcl_FSGetPathType(pathPtr, &fsPtr, &driveNameLength) + == TCL_PATH_ABSOLUTE) { + if (fsPtr == &nativeFilesystem) { + return TclpNativeSplitPath(pathPtr, lenPtr); + } + } else { + return TclpNativeSplitPath(pathPtr, lenPtr); + } + + /* We assume separators are single characters */ + if (fsPtr->filesystemSeparatorProc != NULL) { + Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr); + if (sep != NULL) { + separator = Tcl_GetString(sep)[0]; + } + } + + /* + * Place the drive name as first element of the + * result list. The drive name may contain strange + * characters, like colons and multiple forward slashes + * (for example 'ftp://' is a valid vfs drive name) + */ + result = Tcl_NewObj(); + p = Tcl_GetString(pathPtr); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(p, driveNameLength)); + p+= driveNameLength; + + /* Add the remaining path elements to the list */ + for (;;) { + char *elementStart = p; + int length; + while ((*p != '\0') && (*p != separator)) { + p++; + } + length = p - elementStart; + if (length > 0) { + Tcl_Obj *nextElt; + if (elementStart[0] == '~') { + nextElt = Tcl_NewStringObj("./",2); + Tcl_AppendToObj(nextElt, elementStart, length); + } else { + nextElt = Tcl_NewStringObj(elementStart, length); + } + Tcl_ListObjAppendElement(NULL, result, nextElt); + } + if (*p++ == '\0') { + break; + } + } + + /* + * Compute the number of elements in the result. + */ + + if (lenPtr != NULL) { + Tcl_ListObjLength(NULL, result, lenPtr); + } + return result; +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_FSJoinPath -- + * + * This function takes the given Tcl_Obj, which should be a valid + * list, and returns the path object given by considering the + * first 'elements' elements as valid path segments. If elements < 0, + * we use the entire list. + * + * Note this function currently calls the older Tcl_JoinPath + * routine, which therefore requires more memory allocation and + * deallocation than necessary. We could easily rewrite this for + * greater efficiency. + * + * Results: + * Returns object with refCount of zero. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ +Tcl_Obj* +Tcl_FSJoinPath(listObj, elements) + Tcl_Obj *listObj; + int elements; +{ + Tcl_Obj *res; + int i; + Tcl_Filesystem *fsPtr = NULL; + + if (elements < 0) { + if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) { + return NULL; + } + } else { + /* Just make sure it is a valid list */ + int listTest; + if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) { + return NULL; + } + /* + * Correct this if it is too large, otherwise we will + * waste our timing joining null elements to the path + */ + if (elements > listTest) { + elements = listTest; + } + } + + res = Tcl_NewObj(); + + for (i = 0; i < elements; i++) { + Tcl_Obj *elt; + int driveNameLength; + Tcl_PathType type; + char *strElt; + Tcl_Obj *driveName = NULL; + + Tcl_ListObjIndex(NULL, listObj, i, &elt); + strElt = Tcl_GetString(elt); + type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName); + if (type != TCL_PATH_RELATIVE) { + /* Zero out the current result */ + Tcl_DecrRefCount(res); + if (driveName != NULL) { + res = Tcl_DuplicateObj(driveName); + Tcl_DecrRefCount(driveName); + } else { + res = Tcl_NewStringObj(strElt, driveNameLength); + } + strElt += driveNameLength; + } + + /* + * A NULL value for fsPtr at this stage basically means + * we're trying to join a relative path onto something + * which is also relative (or empty). There's nothing + * particularly wrong with that. + */ + if (*strElt == '\0') continue; + + if (fsPtr == &nativeFilesystem || fsPtr == NULL) { + TclpNativeJoinPath(res, strElt); + } else { + int length; + char separator = '/'; + char *ptr; + int needsSep = 0; + + if (fsPtr->filesystemSeparatorProc != NULL) { + Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(res); + if (sep != NULL) { + separator = Tcl_GetString(sep)[0]; + } + } + ptr = Tcl_GetStringFromObj(res, &length); + if (length > 0 && ptr[length -1] != '/') { + Tcl_AppendToObj(res, &separator, 1); + length++; + } + Tcl_SetObjLength(res, length + strlen(strElt)); + + ptr = Tcl_GetString(res) + length; + for (; *strElt != '\0'; strElt++) { + if (*strElt == separator) { + while (strElt[1] == separator) { + strElt++; + } + if (strElt[1] != '\0') { + if (needsSep) { + *ptr++ = separator; + } + } + } else { + *ptr++ = *strElt; + needsSep = 1; + } + } + length = ptr - Tcl_GetString(res); + Tcl_SetObjLength(res, length); + } + } + return res; +} + +/* + *---------------------------------------------------------------------- + * + * GetPathType -- + * + * Helper function used by Tcl_FSGetPathType. + * + * Results: + * Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or + * TCL_PATH_VOLUME_RELATIVE. The filesystem reference will + * be set if and only if it is non-NULL and the function's + * return value is TCL_PATH_ABSOLUTE. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static Tcl_PathType +GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef) + Tcl_Obj *pathObjPtr; + Tcl_Filesystem **filesystemPtrPtr; + int *driveNameLengthPtr; + Tcl_Obj **driveNameRef; +{ + FilesystemRecord *fsRecPtr; + int pathLen; + char *path; + Tcl_PathType type = TCL_PATH_RELATIVE; + + path = Tcl_GetStringFromObj(pathObjPtr, &pathLen); + + /* + * Call each of the "listVolumes" function in succession, checking + * whether the given path is an absolute path on any of the volumes + * returned (this is done by checking whether the path's prefix + * matches). + */ + + fsRecPtr = FsGetIterator(); + while (fsRecPtr != NULL) { + Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc; + /* + * We want to skip the native filesystem in this loop because + * otherwise we won't necessarily pass all the Tcl testsuite -- + * this is because some of the tests artificially change the + * current platform (between mac, win, unix) but the list + * of volumes we get by calling (*proc) will reflect the current + * (real) platform only and this may cause some tests to fail. + * In particular, on unix '/' will match the beginning of + * certain absolute Windows paths starting '//' and those tests + * will go wrong. + * + * Besides these test-suite issues, there is actually no + * reason to skip the native filesystem. + */ + if ((fsRecPtr->fsPtr != &nativeFilesystem) && (proc != NULL)) { + int numVolumes; + Tcl_Obj *thisFsVolumes = (*proc)(); + if (thisFsVolumes != NULL) { + if (Tcl_ListObjLength(NULL, thisFsVolumes, + &numVolumes) != TCL_OK) { + /* + * This is VERY bad; Tcl_FSListVolumes didn't + * return a valid list. Set numVolumes to -1 + * so that we skip the while loop below and + * just return with the current value of 'type'. + * + * It would be better if we could signal an error + * here (but panic seems a bit excessive). + */ + numVolumes = -1; + } + while (numVolumes > 0) { + Tcl_Obj *vol; + int len; + char *strVol; + + numVolumes--; + Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol); + strVol = Tcl_GetStringFromObj(vol,&len); + if (pathLen < len) { + continue; + } + if (strncmp(strVol, path, len) == 0) { + type = TCL_PATH_ABSOLUTE; + if (filesystemPtrPtr != NULL) { + *filesystemPtrPtr = fsRecPtr->fsPtr; + } + if (driveNameLengthPtr != NULL) { + *driveNameLengthPtr = len; + } + if (driveNameRef != NULL) { + *driveNameRef = vol; + Tcl_IncrRefCount(vol); + } + break; + } + } + Tcl_DecrRefCount(thisFsVolumes); + if (type == TCL_PATH_ABSOLUTE) { + /* We don't need to examine any more filesystems */ + break; + } + } + } + fsRecPtr = fsRecPtr->nextPtr; + } + FsReleaseIterator(); + + if (type != TCL_PATH_ABSOLUTE) { + type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef); + if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) { + *filesystemPtrPtr = &nativeFilesystem; + } + } + return type; } /* @@ -2769,7 +3223,7 @@ SetFsPathFromAny(interp, objPtr) { int len; FsPath *fsPathPtr; - Tcl_DString buffer; + Tcl_Obj *transPtr; char *name; if (objPtr->typePtr == &tclFsPathType) { @@ -2813,7 +3267,7 @@ SetFsPathFromAny(interp, objPtr) char separator='/'; if (tclPlatform==TCL_PLATFORM_MAC) { - if (strchr(name, ':') != NULL) separator = ':'; + if (strchr(name, ':') != NULL) separator = ':'; } split = FindSplitPos(name, &separator); @@ -2855,40 +3309,31 @@ SetFsPathFromAny(interp, objPtr) } if (split != len) { name[split] = separator; } } + expandedUser = Tcl_DStringValue(&temp); + transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp)); - Tcl_DStringInit(&buffer); - if (split == len) { - /* We have the result we need in the wrong DString */ - Tcl_DStringAppend(&buffer, expandedUser, Tcl_DStringLength(&temp)); - } else { + if (split != len) { /* - * Build a simple 2 element list and join it up with - * the tilde substitution in place + * Join up the tilde substitution with the rest */ - char *argv[2]; - argv[0] = expandedUser; - argv[1] = name+split+1; - Tcl_JoinPath(2, argv, &buffer); + Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1); + transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest); } Tcl_DStringFree(&temp); } else { - Tcl_DStringInit(&buffer); - Tcl_JoinPath(1, &name, &buffer); + transPtr = Tcl_FSJoinToPath(objPtr,0,NULL); } - len = Tcl_DStringLength(&buffer); - /* - * Now we have a translated filename in 'buffer', of - * length 'len'. This will have forward slashes on - * Windows, and will not contain any ~user sequences. + * Now we have a translated filename in 'transPtr'. This will have + * forward slashes on Windows, and will not contain any ~user + * sequences. */ fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath)); - fsPathPtr->translatedPathPtr = ckalloc((unsigned)(1+len)); - strcpy(fsPathPtr->translatedPathPtr, Tcl_DStringValue(&buffer)); - Tcl_DStringFree(&buffer); + fsPathPtr->translatedPathPtr = transPtr; + Tcl_IncrRefCount(fsPathPtr->translatedPathPtr); fsPathPtr->normPathPtr = NULL; fsPathPtr->cwdPtr = NULL; fsPathPtr->nativePathPtr = NULL; @@ -2983,7 +3428,7 @@ FreeFsPathInternalRep(pathObjPtr) (FsPath*) pathObjPtr->internalRep.otherValuePtr; if (fsPathPtr->translatedPathPtr != NULL) { - ckfree((char *) fsPathPtr->translatedPathPtr); + Tcl_DecrRefCount(fsPathPtr->translatedPathPtr); } if (fsPathPtr->normPathPtr != NULL) { if (fsPathPtr->normPathPtr != pathObjPtr) { @@ -3024,10 +3469,8 @@ DupFsPathInternalRep(srcPtr, copyPtr) copyPtr->internalRep.otherValuePtr = copyFsPathPtr; if (srcFsPathPtr->translatedPathPtr != NULL) { - copyFsPathPtr->translatedPathPtr = - ckalloc(1+strlen(srcFsPathPtr->translatedPathPtr)); - strcpy(copyFsPathPtr->translatedPathPtr, - srcFsPathPtr->translatedPathPtr); + copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr; + Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr); } else { copyFsPathPtr->translatedPathPtr = NULL; } @@ -3074,14 +3517,14 @@ DupFsPathInternalRep(srcPtr, copyPtr) * * Tcl_FSGetTranslatedPath -- * - * This function attempts to extract the translated path string + * This function attempts to extract the translated path * from the given Tcl_Obj. If the translation succeeds (i.e. the * object is a valid path), then it is returned. Otherwise NULL * will be returned, and an error message may be left in the - * interpreter. + * interpreter (if it is non-NULL) * * Results: - * NULL or a valid string. + * NULL or a valid Tcl_Obj pointer. * * Side effects: * Only those of 'Tcl_FSConvertToPathType' @@ -3089,7 +3532,7 @@ DupFsPathInternalRep(srcPtr, copyPtr) *--------------------------------------------------------------------------- */ -char* +Tcl_Obj* Tcl_FSGetTranslatedPath(interp, pathPtr) Tcl_Interp *interp; Tcl_Obj* pathPtr; @@ -3106,7 +3549,7 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) * object's string, translatedPath and normalizedPath * are all identical. */ - return Tcl_GetString(srcFsPathPtr->normPathPtr); + return srcFsPathPtr->normPathPtr; } else { /* It is an ordinary path object */ return srcFsPathPtr->translatedPathPtr; @@ -3116,6 +3559,38 @@ Tcl_FSGetTranslatedPath(interp, pathPtr) /* *--------------------------------------------------------------------------- * + * Tcl_FSGetTranslatedStringPath -- + * + * This function attempts to extract the translated path + * from the given Tcl_Obj. If the translation succeeds (i.e. the + * object is a valid path), then the path is returned. Otherwise NULL + * will be returned, and an error message may be left in the + * interpreter (if it is non-NULL) + * + * Results: + * NULL or a valid string. + * + * Side effects: + * Only those of 'Tcl_FSConvertToPathType' + * + *--------------------------------------------------------------------------- + */ +char* +Tcl_FSGetTranslatedStringPath(interp, pathPtr) +Tcl_Interp *interp; +Tcl_Obj* pathPtr; +{ + Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); + if (transPtr == NULL) { + return NULL; + } else { + return Tcl_GetString(transPtr); + } +} + +/* + *--------------------------------------------------------------------------- + * * Tcl_FSGetNormalizedPath -- * * This important function attempts to extract from the given Tcl_Obj @@ -3144,34 +3619,35 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; if (srcFsPathPtr->normPathPtr == NULL) { int relative = 0; - char *path = srcFsPathPtr->translatedPathPtr; - Tcl_DString atemp; + /* + * Since normPathPtr is NULL, but this is a valid path + * object, we know that the translatedPathPtr cannot be NULL. + */ + Tcl_Obj *absolutePath = srcFsPathPtr->translatedPathPtr; + char *path = Tcl_GetString(absolutePath); - if ((path[0] != '\0') && (Tcl_GetPathType(path) == TCL_PATH_RELATIVE)) { - char * pair[2]; + /* + * We have to be a little bit careful here to avoid infinite loops + * we're asking Tcl_FSGetPathType to return the path's type, but + * that call can actually result in a lot of other filesystem + * action, which might loop back through here. + */ + if ((path[0] != '\0') && + (Tcl_FSGetPathType(pathObjPtr, NULL, NULL) == TCL_PATH_RELATIVE)) { Tcl_Obj *cwd = Tcl_FSGetCwd(interp); if (cwd == NULL) { return NULL; } - - /* - * The efficiency of this piece of code could - * be improved, given the new object interfaces. - */ - pair[0] = Tcl_GetString(cwd); - pair[1] = path; - Tcl_DStringInit(&atemp); - Tcl_JoinPath(2, pair, &atemp); - path = Tcl_DStringValue(&atemp); + absolutePath = Tcl_FSJoinToPath(cwd, 1, &absolutePath); + Tcl_IncrRefCount(absolutePath); Tcl_DecrRefCount(cwd); relative = 1; } - /* Already has refCount incremented */ - srcFsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, path); + srcFsPathPtr->normPathPtr = FSNormalizeAbsolutePath(interp, absolutePath); if (!strcmp(Tcl_GetString(srcFsPathPtr->normPathPtr), Tcl_GetString(pathObjPtr))) { /* @@ -3186,7 +3662,8 @@ Tcl_FSGetNormalizedPath(interp, pathObjPtr) srcFsPathPtr->normPathPtr = pathObjPtr; } if (relative) { - Tcl_DStringFree(&atemp); + /* This was returned by Tcl_FSJoinToPath above */ + Tcl_DecrRefCount(absolutePath); /* Get a quick, temporary lock on the cwd while we copy it */ Tcl_MutexLock(&cwdMutex); @@ -3330,7 +3807,7 @@ Tcl_FSGetNativePath(pathObjPtr) * *--------------------------------------------------------------------------- */ -ClientData +static ClientData NativeCreateNativeRep(pathObjPtr) Tcl_Obj* pathObjPtr; { @@ -3411,7 +3888,7 @@ TclpNativeToNormalized(clientData) * *--------------------------------------------------------------------------- */ -ClientData +static ClientData NativeDupInternalRep(clientData) ClientData clientData; { @@ -3447,7 +3924,7 @@ NativeDupInternalRep(clientData) * *--------------------------------------------------------------------------- */ -int +static int NativePathInFilesystem(pathPtr, clientDataPtr) Tcl_Obj *pathPtr; ClientData *clientDataPtr; @@ -3477,7 +3954,7 @@ NativePathInFilesystem(pathPtr, clientDataPtr) * *--------------------------------------------------------------------------- */ -void +static void NativeFreeInternalRep(clientData) ClientData clientData; { @@ -3580,7 +4057,7 @@ Tcl_FSPathSeparator(pathObjPtr) * *--------------------------------------------------------------------------- */ -Tcl_Obj* +static Tcl_Obj* NativeFilesystemSeparator(pathObjPtr) Tcl_Obj* pathObjPtr; { @@ -3617,7 +4094,7 @@ NativeFilesystemSeparator(pathObjPtr) * *--------------------------------------------------------------------------- */ -Tcl_Obj* +static Tcl_Obj* NativeFilesystemPathType(pathObjPtr) Tcl_Obj* pathObjPtr; { @@ -3787,18 +4264,18 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) /* Wrappers */ -Tcl_Channel +static Tcl_Channel NativeOpenFileChannel(interp, pathPtr, modeString, permissions) Tcl_Interp *interp; Tcl_Obj *pathPtr; char *modeString; int permissions; { - char *trans = Tcl_FSGetTranslatedPath(interp, pathPtr); + Tcl_Obj *trans = Tcl_FSGetTranslatedPath(interp, pathPtr); if (trans == NULL) { return NULL; } - return TclpOpenFileChannel(interp, trans, modeString, permissions); + return TclpOpenFileChannel(interp, Tcl_GetString(trans), modeString, permissions); } /* @@ -3811,7 +4288,7 @@ NativeOpenFileChannel(interp, pathPtr, modeString, permissions) * This seems rather strange when compared with stat, lstat, access, etc. * all of which want a native path. */ -int +static int NativeUtime(pathPtr, tval) Tcl_Obj *pathPtr; struct utimbuf *tval; @@ -3827,7 +4304,7 @@ NativeUtime(pathPtr, tval) #endif } -int +static int NativeLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp * interp; Tcl_Obj *pathPtr; @@ -3837,7 +4314,14 @@ NativeLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_PackageInitProc ** proc2Ptr; ClientData * clientDataPtr; { - return TclpLoadFile(interp, Tcl_FSGetTranslatedPath(NULL, pathPtr), + char *path; + Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); + if (transPtr == NULL) { + path = NULL; + } else { + path = Tcl_GetString(transPtr); + } + return TclpLoadFile(interp, path, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr); } diff --git a/generic/tclInt.h b/generic/tclInt.h index ddb8fd4..984f795 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.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: tclInt.h,v 1.58 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.59 2001/08/23 17:37:08 vincentdarley Exp $ */ #ifndef _TCLINT @@ -1486,9 +1486,9 @@ typedef struct List { */ typedef int (TclGetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, CONST char *fileName, Tcl_Obj **attrObjPtrPtr)); + int objIndex, Tcl_Obj *fileName, Tcl_Obj **attrObjPtrPtr)); typedef int (TclSetFileAttrProc) _ANSI_ARGS_((Tcl_Interp *interp, - int objIndex, CONST char *fileName, Tcl_Obj *attrObjPtr)); + int objIndex, Tcl_Obj *fileName, Tcl_Obj *attrObjPtr)); typedef struct TclFileAttrProcs { TclGetFileAttrProc *getProc; /* The procedure for getting attrs. */ @@ -1805,6 +1805,7 @@ EXTERN void TclpInitLock _ANSI_ARGS_((void)); EXTERN void TclpInitPlatform _ANSI_ARGS_((void)); EXTERN void TclpInitUnlock _ANSI_ARGS_((void)); EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN Tcl_Obj* TclpObjListVolumes _ANSI_ARGS_((void)); EXTERN void TclpMasterLock _ANSI_ARGS_((void)); EXTERN void TclpMasterUnlock _ANSI_ARGS_((void)); EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp *interp, @@ -1813,6 +1814,14 @@ EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp *interp, EXTERN int TclpObjNormalizePath _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint)); EXTERN int TclpObjCreateDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr)); +EXTERN Tcl_PathType Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr, + Tcl_Filesystem **fsPtrPtr, int *driveNameLengthPtr)); +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, + int *driveNameLengthPtr, Tcl_Obj **driveNameRef)); EXTERN int TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr)); EXTERN int TclpObjCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr)); @@ -1826,7 +1835,7 @@ EXTERN int TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *resul EXTERN int TclpChdir _ANSI_ARGS_((CONST char *dirName)); EXTERN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *bufferPtr)); EXTERN Tcl_Obj* TclpObjGetCwd _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN Tcl_Obj* TclpObjReadlink _ANSI_ARGS_((Tcl_Obj *pathPtr)); +EXTERN Tcl_Obj* TclpObjLink _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj *toPtr)); EXTERN int TclpObjChdir _ANSI_ARGS_((Tcl_Obj *pathPtr)); EXTERN int TclpObjStat _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)); EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 9dd9975..1fdd0b9 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.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: tclLoad.c,v 1.5 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclLoad.c,v 1.6 2001/08/23 17:37:08 vincentdarley Exp $ */ #include "tclInt.h" @@ -272,8 +272,10 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) */ retc = TclGuessPackageName(fullFileName, &pkgName); if (!retc) { - int pargc; - char **pargv, *pkgGuess; + Tcl_Obj *splitPtr; + Tcl_Obj *pkgGuessPtr; + int pElements; + char *pkgGuess; /* * The platform-specific code couldn't figure out the @@ -283,8 +285,9 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) * characters that follow that. */ - Tcl_SplitPath(fullFileName, &pargc, &pargv); - pkgGuess = pargv[pargc-1]; + splitPtr = Tcl_FSSplitPath(objv[1], &pElements); + Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr); + pkgGuess = Tcl_GetString(pkgGuessPtr); if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i') && (pkgGuess[2] == 'b')) { pkgGuess += 3; @@ -298,7 +301,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) } } if (p == pkgGuess) { - ckfree((char *)pargv); + Tcl_DecrRefCount(splitPtr); Tcl_AppendResult(interp, "couldn't figure out package name for ", fullFileName, (char *) NULL); @@ -306,7 +309,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) goto done; } Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); - ckfree((char *)pargv); + Tcl_DecrRefCount(splitPtr); } } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 54f55c6..647b3c3 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.54 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.55 2001/08/23 17:37:08 vincentdarley Exp $ */ #include "tclInt.h" @@ -848,7 +848,7 @@ TclStubs tclStubs = { Tcl_FSDeleteFile, /* 443 */ Tcl_FSLoadFile, /* 444 */ Tcl_FSMatchInDirectory, /* 445 */ - Tcl_FSReadlink, /* 446 */ + Tcl_FSLink, /* 446 */ Tcl_FSRemoveDirectory, /* 447 */ Tcl_FSRenameFile, /* 448 */ Tcl_FSLstat, /* 449 */ @@ -878,6 +878,7 @@ TclStubs tclStubs = { Tcl_FSRegister, /* 473 */ Tcl_FSUnregister, /* 474 */ Tcl_FSData, /* 475 */ + Tcl_FSGetTranslatedStringPath, /* 476 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 08925bd..f6fe969 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -13,7 +13,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.26 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.27 2001/08/23 17:37:08 vincentdarley Exp $ */ #define TCL_TEST @@ -324,7 +324,7 @@ static Tcl_FSCopyDirectoryProc TestReportCopyDirectory; static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory; static Tcl_FSLoadFileProc TestReportLoadFile; static Tcl_FSUnloadFileProc TestReportUnloadFile; -static Tcl_FSReadlinkProc TestReportReadlink; +static Tcl_FSLinkProc TestReportLink; static Tcl_FSListVolumesProc TestReportListVolumes; static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings; static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet; @@ -349,7 +349,7 @@ static Tcl_Filesystem testReportingFilesystem = { &TestReportOpenFileChannel, &TestReportMatchInDirectory, &TestReportUtime, - &TestReportReadlink, + &TestReportLink, &TestReportListVolumes, &TestReportFileAttrStrings, &TestReportFileAttrsGet, @@ -2624,7 +2624,7 @@ TestparsevarnameObjCmd(clientData, interp, objc, objv) */ /* ARGSUSED */ -int +static int TestregexpObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ @@ -4427,7 +4427,7 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions) */ /* ARGSUSED */ -int +static int TestChannelCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Interpreter for result. */ @@ -4855,7 +4855,7 @@ TestChannelCmd(clientData, interp, argc, argv) */ /* ARGSUSED */ -int +static int TestChannelEventCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ @@ -5212,7 +5212,7 @@ TestFilesystemObjCmd(dummy, interp, objc, objv) return res; } -void +static void TestReport(cmd, arg1, arg2) CONST char* cmd; Tcl_Obj* arg1; @@ -5241,7 +5241,7 @@ TestReport(cmd, arg1, arg2) Tcl_RestoreResult(interp, &savedResult); } } -int +static int TestReportStat(path, buf) Tcl_Obj *path; /* Path of file to stat (in current CP). */ struct stat *buf; /* Filled with results of stat call. */ @@ -5249,7 +5249,7 @@ TestReportStat(path, buf) TestReport("stat",path, NULL); return -1; } -int +static int TestReportLstat(path, buf) Tcl_Obj *path; /* Path of file to stat (in current CP). */ struct stat *buf; /* Filled with results of stat call. */ @@ -5257,7 +5257,7 @@ TestReportLstat(path, buf) TestReport("lstat",path, NULL); return -1; } -int +static int TestReportAccess(path, mode) Tcl_Obj *path; /* Path of file to access (in current CP). */ int mode; /* Permission setting. */ @@ -5265,7 +5265,7 @@ TestReportAccess(path, mode) TestReport("access",path,NULL); return -1; } -Tcl_Channel +static Tcl_Channel TestReportOpenFileChannel(interp, fileName, modeString, permissions) Tcl_Interp *interp; /* Interpreter for error reporting; * can be NULL. */ @@ -5280,7 +5280,7 @@ TestReportOpenFileChannel(interp, fileName, modeString, permissions) return NULL; } -int +static int TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types) Tcl_Interp *interp; /* Interpreter to receive results. */ Tcl_Obj *resultPtr; /* Directory separators to pass to TclDoGlob. */ @@ -5292,21 +5292,21 @@ TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types) TestReport("matchindirectory",dirPtr, NULL); return -1; } -Tcl_Obj * +static Tcl_Obj * TestReportGetCwd(interp) Tcl_Interp *interp; { TestReport("cwd",NULL,NULL); return NULL; } -int +static int TestReportChdir(dirName) Tcl_Obj *dirName; { TestReport("chdir",dirName,NULL); return -1; } -int +static int TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Obj *fileName; /* Name of the file containing the desired @@ -5323,7 +5323,7 @@ TestReportLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataP TestReport("loadfile",fileName,NULL); return -1; } -void +static void TestReportUnloadFile(clientData) ClientData clientData; /* ClientData returned by a previous call * to TclpLoadFile(). The clientData is @@ -5332,21 +5332,21 @@ TestReportUnloadFile(clientData) { TestReport("unloadfile",NULL,NULL); } -Tcl_Obj * -TestReportReadlink(path) - Tcl_Obj *path; /* Path of file to readlink (UTF-8). */ +static Tcl_Obj * +TestReportLink(path, to) + Tcl_Obj *path; /* Path of file to readlink or link */ + Tcl_Obj *to; /* Path of file to link to, or NULL */ { - TestReport("readlink",path,NULL); + TestReport("link",path,NULL); return NULL; } -int -TestReportListVolumes(interp) - Tcl_Interp *interp; /* Interpreter for returning volume list. */ +static Tcl_Obj * +TestReportListVolumes() { TestReport("listvolumes",NULL,NULL); - return TCL_OK; + return NULL; } -int +static int TestReportRenameFile(src, dst) Tcl_Obj *src; /* Pathname of file or dir to be renamed * (UTF-8). */ @@ -5356,7 +5356,7 @@ TestReportRenameFile(src, dst) TestReport("renamefile",src,dst); return -1; } -int +static int TestReportCopyFile(src, dst) Tcl_Obj *src; /* Pathname of file to be copied (UTF-8). */ Tcl_Obj *dst; /* Pathname of file to copy to (UTF-8). */ @@ -5364,21 +5364,21 @@ TestReportCopyFile(src, dst) TestReport("copyfile",src,dst); return -1; } -int +static int TestReportDeleteFile(path) Tcl_Obj *path; /* Pathname of file to be removed (UTF-8). */ { TestReport("deletefile",path,NULL); return -1; } -int +static int TestReportCreateDirectory(path) Tcl_Obj *path; /* Pathname of directory to create (UTF-8). */ { TestReport("createdirectory",path,NULL); return -1; } -int +static int TestReportCopyDirectory(src, dst, errorPtr) Tcl_Obj *src; /* Pathname of directory to be copied * (UTF-8). */ @@ -5390,7 +5390,7 @@ TestReportCopyDirectory(src, dst, errorPtr) TestReport("copydirectory",src,dst); return -1; } -int +static int TestReportRemoveDirectory(path, recursive, errorPtr) Tcl_Obj *path; /* Pathname of directory to be removed * (UTF-8). */ @@ -5404,7 +5404,7 @@ TestReportRemoveDirectory(path, recursive, errorPtr) TestReport("removedirectory",path,NULL); return -1; } -char** +static char** TestReportFileAttrStrings(fileName, objPtrRef) Tcl_Obj* fileName; Tcl_Obj** objPtrRef; @@ -5412,7 +5412,7 @@ TestReportFileAttrStrings(fileName, objPtrRef) TestReport("fileattributestrings",fileName,NULL); return NULL; } -int +static int TestReportFileAttrsGet(interp, index, fileName, objPtrRef) Tcl_Interp *interp; /* The interpreter for error reporting. */ int index; /* index of the attribute command. */ @@ -5422,7 +5422,7 @@ TestReportFileAttrsGet(interp, index, fileName, objPtrRef) TestReport("fileattributesget",fileName,NULL); return -1; } -int +static int TestReportFileAttrsSet(interp, index, fileName, objPtr) Tcl_Interp *interp; /* The interpreter for error reporting. */ int index; /* index of the attribute command. */ @@ -5432,7 +5432,7 @@ TestReportFileAttrsSet(interp, index, fileName, objPtr) TestReport("fileattributesset",fileName,objPtr); return -1; } -int +static int TestReportUtime (fileName, tval) Tcl_Obj* fileName; struct utimbuf *tval; @@ -5440,7 +5440,7 @@ TestReportUtime (fileName, tval) TestReport("utime",fileName,NULL); return -1; } -int +static int TestReportNormalizePath(interp, pathPtr, nextCheckpoint) Tcl_Interp *interp; Tcl_Obj *pathPtr; |