diff options
36 files changed, 1319 insertions, 1876 deletions
@@ -1,3 +1,48 @@ +2001-08-30 Vince Darley <vincentdarley@users.sourceforge.net> + + Further fs updates. After examining the most common Tcl + extensions (TclX, BLT, Tk, TclPro, Mktclapp), it has been + determined that only TclpGetCwd and the Access/Stat/Open + insert/delete hooks of the internal fs functions are ever used. + The remaining functions from Tcl's internal interfaces have + therefore been removed, since Tcl now exports a more suitable + public API (Tcl_FS...) + + * generic/tclInt.stubs: + * generic/tclInt.h: updated for removed internal functions. + Some new internal functions have been put in tclInt.h (and + not exported in the stub table because good public equivalents + exist). + * generic/tclTest.c: some test functions used the internal private + APIs. These tests have been retained, but modified to use + public APIs. Also objectified the internal filesystem tests. + * win/tclWinFile.c: removed TclpStat, TclpAccess and refactored + code to use NativeAccess, NativeStat. This should speed up + stat, access and glob commands. + * win/tclWinFCmd.c: removed all TclpCopy/Rename/Delete + File/Directory string-based procedures which aren't used any more. + Improved efficiency of some other procedures. Ensure that filename + conversions with a NULL interp do not crash Tcl. + * mac/tclMacFCmd.c: wrapped long lines and cleaned up + TclpObjNormalizePath, removed all TclpCopy/Rename/Delete + File/Directory string-based procedures which aren't used any more. + * mac/tclMacFile.c: removed obsolete TclpStat, TclpAccess, TclpChdir, + etc. + * unix/tclUnixFCmd.c: removed use of TclpAccess, removed all + TclpCopy/Rename/Delete File/Directory string-based procedures which + aren't used any more. + * unix/tclUnixFile.c: removed obsolete TclpStat, TclpAccess, TclpChdir, + etc. + * tcl(Unix|Mac|Win)Chan.c: objectified TclpOpenFileChannel. + * various 'load' implementations all objectified. + * generic/tclFileName.c: removed redundant code. + * generic/tclIOUtil.c: removed TclStat, TclAccess, TclpListVolumes. + Fix to MatchInDirectory at the root of a volume. Also improved + some documentation, and improved default path joining behaviour + for virtual filesystems, especially regarding '~'. + * tests/fileName.test: added tests to check for bugs fixed above. + * doc/FileName.3: improved documentation + 2001-08-30 David Gravereaux <davygrvy@pobox.com> * generic/tclAsync.c: diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 7e49235..9836dea 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -4,13 +4,13 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: FileSystem.3,v 1.3 2001/08/23 17:37:07 vincentdarley Exp $ +'\" RCS: @(#) $Id: FileSystem.3,v 1.4 2001/08/30 08:53:14 vincentdarley Exp $ '\" .so man.macros .TH Tcl_FSCopyFile 3 8.4 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSReadlink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo \- procedures to interact with any filesystem +Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo \- procedures to interact with any filesystem .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -589,7 +589,7 @@ typedef struct Tcl_Filesystem { Tcl_FSOpenFileChannelProc *\fIopenFileChannelProc\fR; Tcl_FSMatchInDirectoryProc *\fImatchInDirectoryProc\fR; Tcl_FSUtimeProc *\fIutimeProc\fR; - Tcl_FSReadlinkProc *\fIreadlinkProc\fR; + Tcl_FSLinkProc *\fIlinkProc\fR; Tcl_FSListVolumesProc *\fIlistVolumesProc\fR; Tcl_FSFileAttrStringsProc *\fIfileAttrStringsProc\fR; Tcl_FSFileAttrsGetProc *\fIfileAttrsGetProc\fR; @@ -917,20 +917,25 @@ should be changed to the values given in the \fItval\fR structure. The return value is a standard Tcl result indicating whether an error occurred in the process. .PP -.SH READLINKPROC +.SH LINKPROC .PP -Function to process a 'Tcl_FSReadlink()' call. Should be implemented +Function to process a 'Tcl_FSLink()' call. Should be implemented only if the filesystem supports links, and may otherwise be NULL. .PP .CS -typedef Tcl_Obj* Tcl_FSReadlinkProc( - Tcl_Obj *\fIpathPtr\fR); +typedef Tcl_Obj* Tcl_FSLinkProc( + Tcl_Obj *\fIpathPtr\fR, + Tcl_Obj *\fItoPtr\fR); .CE .PP -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 \fItoPtr\fR is NULL, the function is being asked to read the +contents of a link. 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 \fItoPtr\fR +is not NULL, the function should attempt to create a link. The result +in this case should be \fItoPtr\fR if the link was successful and NULL +otherwise. In this case the result is not owned by the caller. .PP .SH LISTVOLUMESPROC .PP diff --git a/generic/tcl.decls b/generic/tcl.decls index 65ff02a..7a93099 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.52 2001/08/23 17:37:07 vincentdarley Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.53 2001/08/30 08:53:14 vincentdarley Exp $ library tcl @@ -468,6 +468,7 @@ declare 128 generic { declare 129 generic { int Tcl_Eval(Tcl_Interp *interp, char *string) } +# This is obsolete, use Tcl_FSEvalFile declare 130 generic { int Tcl_EvalFile(Tcl_Interp *interp, char *fileName) } @@ -656,6 +657,7 @@ declare 184 generic { declare 185 generic { int Tcl_IsSafe(Tcl_Interp *interp) } +# Obsolete, use Tcl_FSJoinPath declare 186 generic { char * Tcl_JoinPath(int argc, char **argv, Tcl_DString *resultPtr) } @@ -698,6 +700,7 @@ declare 197 {unix win} { Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, \ char **argv, int flags) } +# This is obsolete, use Tcl_FSOpenFileChannel declare 198 generic { Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, char *fileName, \ char *modeString, int permissions) @@ -845,6 +848,7 @@ declare 242 generic { int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr, \ char ***argvPtr) } +# Obsolete, use Tcl_FSSplitPath declare 243 generic { void Tcl_SplitPath(CONST char *path, int *argcPtr, char ***argvPtr) } @@ -1279,6 +1283,8 @@ declare 364 generic { int Tcl_ParseVarName (Tcl_Interp *interp, char *string, \ int numBytes, Tcl_Parse *parsePtr, int append) } +# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, +# Tcl_FSAccess and Tcl_FSStat declare 365 generic { char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 7f3c590..035446f 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.10 2001/08/23 17:37:07 vincentdarley Exp $ + * RCS: @(#) $Id: tclFCmd.c,v 1.11 2001/08/30 08:53:14 vincentdarley Exp $ */ #include "tclInt.h" @@ -544,8 +544,8 @@ CopyRenameOneFile(interp, source, target, copyFlag, force) /* * The rename failed because the move was across file systems. * Fall through to copy file and then remove original. Note that - * the low-level TclpRenameFile is allowed to implement - * cross-filesystem moves itself. + * the low-level Tcl_FSRenameFileProc in the filesystem is allowed + * to implement cross-filesystem moves itself, if it desires. */ } diff --git a/generic/tclFileName.c b/generic/tclFileName.c index e4c484d..1839564 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.18 2001/08/23 18:20:50 hobbs Exp $ + * RCS: @(#) $Id: tclFileName.c,v 1.19 2001/08/30 08:53:14 vincentdarley Exp $ */ #include "tclInt.h" @@ -1110,7 +1110,7 @@ TclpNativeJoinPath(prefix, joining) * 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. + * bother to add it unless it's the very first element. */ #ifdef MAC_UNDERSTANDS_UNIX_PATHS @@ -1184,7 +1184,9 @@ TclpNativeJoinPath(prefix, joining) * * Tcl_JoinPath -- * - * Combine a list of paths in a platform specific manner. + * Combine a list of paths in a platform specific manner. The + * function 'Tcl_FSJoinPath' should be used in preference where + * possible. * * Results: * Appends the joined path to the end of the specified @@ -1203,225 +1205,28 @@ Tcl_JoinPath(argc, argv, resultPtr) char **argv; Tcl_DString *resultPtr; /* Pointer to previously initialized DString. */ { - int oldLength, length, i, needsSep; - char c, *dest; - CONST char *p; - Tcl_PathType type = TCL_PATH_ABSOLUTE; - - oldLength = Tcl_DStringLength(resultPtr); - - switch (tclPlatform) { - case TCL_PLATFORM_UNIX: - for (i = 0; i < argc; i++) { - p = argv[i]; - /* - * If the path is absolute, reset the result buffer. - * Consume any duplicate leading slashes or a ./ in - * front of a tilde prefixed path that isn't at the - * beginning of the path. - */ - -#ifdef __QNX__ - /* - * Check for QNX //<node id> prefix - */ - if (*p && (strlen(p) > 3) && (p[0] == '/') && (p[1] == '/') - && isdigit(UCHAR(p[2]))) { /* INTL: digit */ - p += 3; - while (isdigit(UCHAR(*p))) { /* INTL: digit */ - ++p; - } - } -#endif - if (*p == '/') { - Tcl_DStringSetLength(resultPtr, oldLength); - Tcl_DStringAppend(resultPtr, "/", 1); - while (*p == '/') { - p++; - } - } else if (*p == '~') { - Tcl_DStringSetLength(resultPtr, oldLength); - } else if ((Tcl_DStringLength(resultPtr) != oldLength) - && (p[0] == '.') && (p[1] == '/') - && (p[2] == '~')) { - p += 2; - } - - if (*p == '\0') { - continue; - } - - /* - * Append a separator if needed. - */ - - length = Tcl_DStringLength(resultPtr); - if ((length != oldLength) - && (Tcl_DStringValue(resultPtr)[length-1] != '/')) { - Tcl_DStringAppend(resultPtr, "/", 1); - length++; - } - - /* - * Append the element, eliminating duplicate and trailing - * slashes. - */ - - Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p))); - dest = Tcl_DStringValue(resultPtr) + length; - for (; *p != '\0'; p++) { - if (*p == '/') { - while (p[1] == '/') { - p++; - } - if (p[1] != '\0') { - *dest++ = '/'; - } - } else { - *dest++ = *p; - } - } - length = dest - Tcl_DStringValue(resultPtr); - Tcl_DStringSetLength(resultPtr, length); - } - break; - - case TCL_PLATFORM_WINDOWS: - /* - * Iterate over all of the components. If a component is - * absolute, then reset the result and start building the - * path from the current component on. - */ - - for (i = 0; i < argc; i++) { - p = ExtractWinRoot(argv[i], resultPtr, oldLength, &type); - length = Tcl_DStringLength(resultPtr); - - /* - * If the pointer didn't move, then this is a relative path - * or a tilde prefixed path. - */ - - if (p == argv[i]) { - /* - * Remove the ./ from tilde prefixed elements unless - * it is the first component. - */ - - if ((length != oldLength) - && (p[0] == '.') - && ((p[1] == '/') || (p[1] == '\\')) - && (p[2] == '~')) { - p += 2; - } else if (*p == '~') { - Tcl_DStringSetLength(resultPtr, oldLength); - length = oldLength; - } - } - - if (*p != '\0') { - /* - * Check to see if we need to append a separator. - */ - - - if (length != oldLength) { - c = Tcl_DStringValue(resultPtr)[length-1]; - if ((c != '/') && (c != ':')) { - Tcl_DStringAppend(resultPtr, "/", 1); - } - } - - /* - * Append the element, eliminating duplicate and - * trailing slashes. - */ - - length = Tcl_DStringLength(resultPtr); - Tcl_DStringSetLength(resultPtr, (int) (length + strlen(p))); - dest = Tcl_DStringValue(resultPtr) + length; - for (; *p != '\0'; p++) { - if ((*p == '/') || (*p == '\\')) { - while ((p[1] == '/') || (p[1] == '\\')) { - p++; - } - if (p[1] != '\0') { - *dest++ = '/'; - } - } else { - *dest++ = *p; - } - } - length = dest - Tcl_DStringValue(resultPtr); - Tcl_DStringSetLength(resultPtr, length); - } - } - break; - - case TCL_PLATFORM_MAC: - needsSep = 1; - for (i = 0; i < argc; i++) { - 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, eltLen); - needsSep = 0; - splitIndex++; - } - - /* - * Now append the rest of the path elements, skipping - * : unless it is the first element of the path, and - * watching out for :: et al. so we don't end up with - * too many colons in the result. - */ - - 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++; - } else { - needsSep = 0; - } - } else { - c = p[1]; - if (*p == ':') { - if (!needsSep) { - p++; - } - } else { - if (needsSep) { - Tcl_DStringAppend(resultPtr, ":", 1); - } - } - needsSep = (c == ':') ? 0 : 1; - } - length = strlen(p); - Tcl_DStringAppend(resultPtr, p, length); - } - Tcl_DecrRefCount(splitPtr); - } - break; - + int i, len; + Tcl_Obj *listObj = Tcl_NewObj(); + Tcl_Obj *resultObj; + char *resultStr; + + /* Build the list of paths */ + for (i = 0; i < argc; i++) { + Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewStringObj(argv[i],-1)); } + + /* Ask the objectified code to join the paths */ + Tcl_IncrRefCount(listObj); + resultObj = Tcl_FSJoinPath(listObj, argc); + Tcl_IncrRefCount(resultObj); + Tcl_DecrRefCount(listObj); + + /* Store the result */ + resultStr = Tcl_GetStringFromObj(resultObj, &len); + Tcl_DStringAppend(resultPtr, resultStr, len); + Tcl_DecrRefCount(resultObj); + + /* Return a pointer to the result */ return Tcl_DStringValue(resultPtr); } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index d5fa64c..2406215 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.16 2001/08/23 18:20:50 hobbs Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.17 2001/08/30 08:53:14 vincentdarley Exp $ */ #include "tclInt.h" @@ -71,29 +71,11 @@ extern CONST TclFileAttrProcs tclpFileAttrProcs[]; /* * The following functions are obsolete string based APIs, and should - * be removed in a future release. + * be removed in a future release (Tcl 9 would be a good time). */ /* Obsolete */ int -TclStat(path, buf) - CONST char *path; /* Path of file to stat (in current CP). */ - struct stat *buf; /* Filled with results of stat call. */ -{ - return Tcl_Stat(path,buf); -} - -/* Obsolete */ -int -TclAccess(path, mode) - CONST char *path; /* Path of file to access (in current CP). */ - int mode; /* Permission setting. */ -{ - return Tcl_Access(path, mode); -} - -/* Obsolete */ -int Tcl_Stat(path, buf) CONST char *path; /* Path of file to stat (in current CP). */ struct stat *buf; /* Filled with results of stat call. */ @@ -187,17 +169,6 @@ 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 @@ -207,6 +178,9 @@ TclpListVolumes( * from stubs/tclInt. The only known users of these APIs are prowrap * and mktclapp. New code/extensions should not use them, since they * do not provide as full support as the full filesystem API. + * + * As soon as prowrap and mktclapp are updated to use the full + * filesystem support, I suggest all these hooks are removed. */ #define USE_OBSOLETE_FS_HOOKS @@ -299,8 +273,6 @@ static Tcl_FSCreateInternalRepProc NativeCreateNativeRep; static Tcl_FSFileAttrStringsProc NativeFileAttrStrings; static Tcl_FSFileAttrsGetProc NativeFileAttrsGet; static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; -static Tcl_FSLoadFileProc NativeLoadFile; -static Tcl_FSOpenFileChannelProc NativeOpenFileChannel; static Tcl_FSUtimeProc NativeUtime; /* @@ -345,7 +317,7 @@ static Tcl_Filesystem nativeFilesystem = { &NativeFilesystemSeparator, &TclpObjStat, &TclpObjAccess, - &NativeOpenFileChannel, + &TclpOpenFileChannel, &TclpMatchInDirectory, &NativeUtime, #ifndef S_IFLNK @@ -364,7 +336,7 @@ static Tcl_Filesystem nativeFilesystem = { &TclpObjCopyFile, &TclpObjRenameFile, &TclpObjCopyDirectory, - &NativeLoadFile, + &TclpLoadFile, &TclpUnloadFile, &TclpObjGetCwd, &TclpObjChdir @@ -1602,19 +1574,33 @@ Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types) if (proc != NULL) { int cwdLen; Tcl_Obj *cwdDir; + char *cwdStr; +#ifdef MAC_TCL + char sep = ':'; +#else + char sep = '/'; +#endif Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL); /* * We know the cwd is a normalised object which does - * not end in a directory delimiter. + * not end in a directory delimiter, unless the cwd + * is the name of a volume, in which case it will + * end in a delimiter! We handle this situation here. + * A better test than the '!= sep' might be to simply + * check if 'cwd' is a root volume. + * + * Note that if we get this wrong, we will strip off + * either too much or too little below, leading to + * wrong answers returned by glob. */ cwdDir = Tcl_DuplicateObj(cwd); -#ifdef MAC_TCL - Tcl_AppendToObj(cwdDir, ":", 1); -#else - Tcl_AppendToObj(cwdDir, "/", 1); -#endif - Tcl_GetStringFromObj(cwdDir, &cwdLen); Tcl_IncrRefCount(cwdDir); + cwdStr = Tcl_GetStringFromObj(cwdDir, &cwdLen); + if (cwdStr[cwdLen-1] != sep) { + Tcl_AppendToObj(cwdDir, &sep, 1); + cwdLen++; + /* Note: cwdStr may no longer be a valid pointer */ + } ret = (*proc)(interp, tmpResultPtr, cwdDir, pattern, types); Tcl_DecrRefCount(cwdDir); if (ret == TCL_OK) { @@ -2636,10 +2622,13 @@ Tcl_FSJoinPath(listObj, elements) int driveNameLength; Tcl_PathType type; char *strElt; + int strEltLen; + int length; + char *ptr; Tcl_Obj *driveName = NULL; Tcl_ListObjIndex(NULL, listObj, i, &elt); - strElt = Tcl_GetString(elt); + strElt = Tcl_GetStringFromObj(elt, &strEltLen); type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName); if (type != TCL_PATH_RELATIVE) { /* Zero out the current result */ @@ -2653,6 +2642,19 @@ Tcl_FSJoinPath(listObj, elements) strElt += driveNameLength; } + ptr = Tcl_GetStringFromObj(res, &length); + + /* + * Strip off any './' before a tilde, unless this is the + * beginning of the path. + */ + if (length > 0 && strEltLen > 0) { + if ((strElt[0] == '.') && (strElt[1] == '/') + && (strElt[2] == '~')) { + strElt += 2; + } + } + /* * A NULL value for fsPtr at this stage basically means * we're trying to join a relative path onto something @@ -2664,9 +2666,7 @@ Tcl_FSJoinPath(listObj, elements) if (fsPtr == &nativeFilesystem || fsPtr == NULL) { TclpNativeJoinPath(res, strElt); } else { - int length; char separator = '/'; - char *ptr; int needsSep = 0; if (fsPtr->filesystemSeparatorProc != NULL) { @@ -2675,7 +2675,7 @@ Tcl_FSJoinPath(listObj, elements) separator = Tcl_GetString(sep)[0]; } } - ptr = Tcl_GetStringFromObj(res, &length); + if (length > 0 && ptr[length -1] != '/') { Tcl_AppendToObj(res, &separator, 1); length++; @@ -3735,6 +3735,17 @@ Tcl_FSGetInternalRep(pathObjPtr, fsPtr) * to allow this sub-optimal routing. */ Tcl_FSGetFileSystemForPath(pathObjPtr); + + /* + * If we fail through here, then the path is probably not a + * valid path in the filesystsem, and is most likely to be a + * use of the empty path "" via a direct call to one of the + * objectified interfaces (e.g. from the Tcl testsuite). + */ + srcFsPathPtr = (FsPath*) pathObjPtr->internalRep.otherValuePtr; + if (srcFsPathPtr->fsRecPtr == NULL) { + return NULL; + } } if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) { @@ -3915,6 +3926,11 @@ NativeDupInternalRep(clientData) * Any path object is acceptable to the native filesystem, by * default (we will throw errors when illegal paths are actually * tried to be used). + * + * However, this behavior means the native filesystem must be + * the last filesystem in the lookup list (otherwise it will + * claim all files belong to it, and other filesystems will + * never get a look in). * * Results: * TCL_OK, to indicate 'yes', -1 to indicate no. @@ -4262,22 +4278,6 @@ Tcl_FSEqualPaths(firstPtr, secondPtr) return 0; } -/* Wrappers */ - -static Tcl_Channel -NativeOpenFileChannel(interp, pathPtr, modeString, permissions) - Tcl_Interp *interp; - Tcl_Obj *pathPtr; - char *modeString; - int permissions; -{ - Tcl_Obj *trans = Tcl_FSGetTranslatedPath(interp, pathPtr); - if (trans == NULL) { - return NULL; - } - return TclpOpenFileChannel(interp, Tcl_GetString(trans), modeString, permissions); -} - /* * utime wants a normalized, NOT native path. I assume a native * version of 'utime' doesn't exist (at least under that name) on NT/2000. @@ -4304,27 +4304,6 @@ NativeUtime(pathPtr, tval) #endif } -static int -NativeLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) - Tcl_Interp * interp; - Tcl_Obj *pathPtr; - char * sym1; - char * sym2; - Tcl_PackageInitProc ** proc1Ptr; - Tcl_PackageInitProc ** proc2Ptr; - ClientData * clientDataPtr; -{ - 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); -} - /* Everything from here on is contained in this obsolete ifdef */ #ifdef USE_OBSOLETE_FS_HOOKS diff --git a/generic/tclInt.decls b/generic/tclInt.decls index b0b883b..7b1dac5 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.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: tclInt.decls,v 1.29 2001/07/31 19:12:06 vincentdarley Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.30 2001/08/30 08:53:14 vincentdarley Exp $ library tcl @@ -23,9 +23,10 @@ interface tclInt # Use at your own risk. Note that the position of functions should not # be changed between versions to avoid gratuitous incompatibilities. -declare 0 generic { - int TclAccess(CONST char *path, int mode) -} +# Replaced by Tcl_FSAccess in 8.4: +#declare 0 generic { +# int TclAccess(CONST char *path, int mode) +#} declare 1 generic { int TclAccessDeleteProc(TclAccessProc_ *proc) } @@ -268,9 +269,10 @@ declare 66 generic { declare 67 generic { int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc) } -declare 68 generic { - int TclpAccess(CONST char *path, int mode) -} +# Replaced by Tcl_FSAccess in 8.4: +#declare 68 generic { +# int TclpAccess(CONST char *path, int mode) +#} declare 69 generic { char * TclpAlloc(unsigned int size) } @@ -302,13 +304,15 @@ declare 77 generic { declare 78 generic { int TclpGetTimeZone(unsigned long time) } -declare 79 generic { - int TclpListVolumes(Tcl_Interp *interp) -} -declare 80 generic { - Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, \ - char *modeString, int permissions) -} +# Replaced by Tcl_FSListVolumes in 8.4: +#declare 79 generic { +# int TclpListVolumes(Tcl_Interp *interp) +#} +# Replaced by Tcl_FSOpenFileChannel in 8.4: +#declare 80 generic { +# Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, \ +# char *modeString, int permissions) +#} declare 81 generic { char * TclpRealloc(char *ptr, unsigned int size) } @@ -362,9 +366,10 @@ declare 94 generic { int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, \ int argc, char **argv) } -declare 95 generic { - int TclpStat(CONST char *path, struct stat *buf) -} +# Replaced by Tcl_FSStat in 8.4: +#declare 95 generic { +# int TclpStat(CONST char *path, struct stat *buf) +#} declare 96 generic { int TclRenameCommand(Tcl_Interp *interp, char *oldName, char *newName) } @@ -395,9 +400,10 @@ declare 103 generic { declare 104 {unix win} { int TclSockMinimumBuffers(int sock, int size) } -declare 105 generic { - int TclStat(CONST char *path, struct stat *buf) -} +# Replaced by Tcl_FSStat in 8.4: +#declare 105 generic { +# int TclStat(CONST char *path, struct stat *buf) +#} declare 106 generic { int TclStatDeleteProc(TclStatProc_ *proc) } @@ -520,17 +526,18 @@ declare 135 generic { declare 138 generic { char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) } -declare 139 generic { - int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \ - char *sym2, Tcl_PackageInitProc **proc1Ptr, \ - Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr) -} +#declare 139 generic { +# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \ +# char *sym2, Tcl_PackageInitProc **proc1Ptr, \ +# Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr) +#} declare 140 generic { int TclLooksLikeInt(char *bytes, int length) } -#declare 141 generic { -# char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) -#} +# This is used by TclX, but should otherwise be considered private +declare 141 generic { + char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) +} declare 142 generic { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, \ CompileHookProc *hookProc, ClientData clientData) @@ -616,29 +623,8 @@ declare 161 generic { declare 162 generic { void TclChannelEventScriptInvoker(ClientData clientData, int flags) } -# for virtual filesystem support. These should eventually be moved to -# Tcl's external API and properly documented, to allow extension writers -# to use them easily (hence providing automatic VFS support to all -# extensions) +# These functions are vfs aware, but are generally only useful internally. declare 163 generic { - int TclFileCopyCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 164 generic { - int TclFileRenameCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 165 generic { - int TclFileDeleteCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 166 generic { - int TclFileMakeDirsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 167 generic { - int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) -} -declare 168 generic { - Tcl_Obj* TclpTempFileName(void) -} -declare 169 generic { void TclpSetInitialEncodings(void) } diff --git a/generic/tclInt.h b/generic/tclInt.h index daa8a7d..049ab71 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.60 2001/08/30 07:50:18 davygrvy Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.61 2001/08/30 08:53:14 vincentdarley Exp $ */ #ifndef _TCLINT @@ -1773,12 +1773,7 @@ EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, struct stat *buf)); EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size)); EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); -EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char *source, - CONST char *dest)); -EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char *source, - CONST char *dest, Tcl_DString *errorPtr)); -EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char *path)); -EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char *path)); +EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void)); EXTERN void TclpExit _ANSI_ARGS_((int status)); EXTERN void TclpFinalizeCondition _ANSI_ARGS_(( Tcl_Condition *condPtr)); @@ -1805,7 +1800,11 @@ EXTERN void TclpInitLibraryPath _ANSI_ARGS_((CONST char *argv0)); 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 int TclpLoadFile _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *pathPtr, char *sym1, char *sym2, + Tcl_PackageInitProc **proc1Ptr, + Tcl_PackageInitProc **proc2Ptr, + ClientData *clientDataPtr)); EXTERN Tcl_Obj* TclpObjListVolumes _ANSI_ARGS_((void)); EXTERN void TclpMasterLock _ANSI_ARGS_((void)); EXTERN void TclpMasterUnlock _ANSI_ARGS_((void)); @@ -1833,14 +1832,12 @@ EXTERN int TclpObjRemoveDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr, EXTERN int TclpObjRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr)); EXTERN int TclpMatchInDirectory _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, char *pattern, Tcl_GlobTypeData *types)); -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* 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, - char *fileName, char *modeString, + Tcl_Obj *pathPtr, char *modeString, int permissions)); EXTERN void TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format)); @@ -1849,10 +1846,6 @@ EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName, EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr, unsigned int size)); EXTERN void TclpReleaseFile _ANSI_ARGS_((TclFile file)); -EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char *path, - int recursive, Tcl_DString *errorPtr)); -EXTERN int TclpRenameFile _ANSI_ARGS_((CONST char *source, - CONST char *dest)); EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void)); EXTERN void TclpSetVariables _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN VOID * TclpSysAlloc _ANSI_ARGS_((long size, int isBin)); diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 8d55864..47e08ad 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.25 2001/07/31 19:12:06 vincentdarley Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.26 2001/08/30 08:53:14 vincentdarley Exp $ */ #ifndef _TCLINTDECLS @@ -29,8 +29,7 @@ * Exported function declarations: */ -/* 0 */ -EXTERN int TclAccess _ANSI_ARGS_((CONST char * path, int mode)); +/* Slot 0 is reserved */ /* 1 */ EXTERN int TclAccessDeleteProc _ANSI_ARGS_(( TclAccessProc_ * proc)); @@ -236,8 +235,7 @@ EXTERN int TclOpenFileChannelDeleteProc _ANSI_ARGS_(( /* 67 */ EXTERN int TclOpenFileChannelInsertProc _ANSI_ARGS_(( TclOpenFileChannelProc_ * proc)); -/* 68 */ -EXTERN int TclpAccess _ANSI_ARGS_((CONST char * path, int mode)); +/* Slot 68 is reserved */ /* 69 */ EXTERN char * TclpAlloc _ANSI_ARGS_((unsigned int size)); /* Slot 70 is reserved */ @@ -254,12 +252,8 @@ EXTERN unsigned long TclpGetSeconds _ANSI_ARGS_((void)); EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time * time)); /* 78 */ EXTERN int TclpGetTimeZone _ANSI_ARGS_((unsigned long time)); -/* 79 */ -EXTERN int TclpListVolumes _ANSI_ARGS_((Tcl_Interp * interp)); -/* 80 */ -EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp, - char * fileName, char * modeString, - int permissions)); +/* Slot 79 is reserved */ +/* Slot 80 is reserved */ /* 81 */ EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr, unsigned int size)); @@ -289,9 +283,7 @@ EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData)); /* 94 */ EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); -/* 95 */ -EXTERN int TclpStat _ANSI_ARGS_((CONST char * path, - struct stat * buf)); +/* Slot 95 is reserved */ /* 96 */ EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); @@ -331,9 +323,7 @@ EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock, EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock, int size)); #endif /* __WIN32__ */ -/* 105 */ -EXTERN int TclStat _ANSI_ARGS_((CONST char * path, - struct stat * buf)); +/* Slot 105 is reserved */ /* 106 */ EXTERN int TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ * proc)); /* 107 */ @@ -437,16 +427,13 @@ EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); /* 138 */ EXTERN char * TclGetEnv _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); -/* 139 */ -EXTERN int TclpLoadFile _ANSI_ARGS_((Tcl_Interp * interp, - char * fileName, char * sym1, char * sym2, - Tcl_PackageInitProc ** proc1Ptr, - Tcl_PackageInitProc ** proc2Ptr, - ClientData * clientDataPtr)); +/* Slot 139 is reserved */ /* 140 */ EXTERN int TclLooksLikeInt _ANSI_ARGS_((char * bytes, int length)); -/* Slot 141 is reserved */ +/* 141 */ +EXTERN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp, + Tcl_DString * cwdPtr)); /* 142 */ EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Obj * objPtr, @@ -500,30 +487,13 @@ EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp, EXTERN void TclChannelEventScriptInvoker _ANSI_ARGS_(( ClientData clientData, int flags)); /* 163 */ -EXTERN int TclFileCopyCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 164 */ -EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 165 */ -EXTERN int TclFileDeleteCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 166 */ -EXTERN int TclFileMakeDirsCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 167 */ -EXTERN int TclFileAttrsCmd _ANSI_ARGS_((Tcl_Interp * interp, - int objc, Tcl_Obj *CONST objv[])); -/* 168 */ -EXTERN Tcl_Obj* TclpTempFileName _ANSI_ARGS_((void)); -/* 169 */ EXTERN void TclpSetInitialEncodings _ANSI_ARGS_((void)); typedef struct TclIntStubs { int magic; struct TclIntStubHooks *hooks; - int (*tclAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 0 */ + void *reserved0; int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 1 */ int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 2 */ void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */ @@ -607,7 +577,7 @@ typedef struct TclIntStubs { int (*tclObjInvokeGlobal) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 65 */ int (*tclOpenFileChannelDeleteProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 66 */ int (*tclOpenFileChannelInsertProc) _ANSI_ARGS_((TclOpenFileChannelProc_ * proc)); /* 67 */ - int (*tclpAccess) _ANSI_ARGS_((CONST char * path, int mode)); /* 68 */ + void *reserved68; char * (*tclpAlloc) _ANSI_ARGS_((unsigned int size)); /* 69 */ void *reserved70; void *reserved71; @@ -618,8 +588,8 @@ typedef struct TclIntStubs { unsigned long (*tclpGetSeconds) _ANSI_ARGS_((void)); /* 76 */ void (*tclpGetTime) _ANSI_ARGS_((Tcl_Time * time)); /* 77 */ int (*tclpGetTimeZone) _ANSI_ARGS_((unsigned long time)); /* 78 */ - int (*tclpListVolumes) _ANSI_ARGS_((Tcl_Interp * interp)); /* 79 */ - Tcl_Channel (*tclpOpenFileChannel) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * modeString, int permissions)); /* 80 */ + void *reserved79; + void *reserved80; char * (*tclpRealloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 81 */ void *reserved82; void *reserved83; @@ -634,7 +604,7 @@ typedef struct TclIntStubs { int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */ void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */ int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 94 */ - int (*tclpStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 95 */ + void *reserved95; int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */ void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */ int (*tclServiceIdle) _ANSI_ARGS_((void)); /* 98 */ @@ -660,7 +630,7 @@ typedef struct TclIntStubs { #ifdef MAC_TCL void *reserved104; #endif /* MAC_TCL */ - int (*tclStat) _ANSI_ARGS_((CONST char * path, struct stat * buf)); /* 105 */ + void *reserved105; int (*tclStatDeleteProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 106 */ int (*tclStatInsertProc) _ANSI_ARGS_((TclStatProc_ * proc)); /* 107 */ void (*tclTeardownNamespace) _ANSI_ARGS_((Namespace * nsPtr)); /* 108 */ @@ -694,9 +664,9 @@ typedef struct TclIntStubs { void *reserved136; void *reserved137; char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */ - int (*tclpLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr, ClientData * clientDataPtr)); /* 139 */ + void *reserved139; int (*tclLooksLikeInt) _ANSI_ARGS_((char * bytes, int length)); /* 140 */ - void *reserved141; + char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */ int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)); /* 142 */ int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)); /* 143 */ void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp * interp, struct CompileEnv * envPtr, int index)); /* 144 */ @@ -718,13 +688,7 @@ typedef struct TclIntStubs { void *reserved160; int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */ void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */ - int (*tclFileCopyCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 163 */ - int (*tclFileRenameCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 164 */ - int (*tclFileDeleteCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 165 */ - int (*tclFileMakeDirsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 166 */ - int (*tclFileAttrsCmd) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 167 */ - Tcl_Obj* (*tclpTempFileName) _ANSI_ARGS_((void)); /* 168 */ - void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 169 */ + void (*tclpSetInitialEncodings) _ANSI_ARGS_((void)); /* 163 */ } TclIntStubs; #ifdef __cplusplus @@ -741,10 +705,7 @@ extern TclIntStubs *tclIntStubsPtr; * Inline function declarations: */ -#ifndef TclAccess -#define TclAccess \ - (tclIntStubsPtr->tclAccess) /* 0 */ -#endif +/* Slot 0 is reserved */ #ifndef TclAccessDeleteProc #define TclAccessDeleteProc \ (tclIntStubsPtr->tclAccessDeleteProc) /* 1 */ @@ -993,10 +954,7 @@ extern TclIntStubs *tclIntStubsPtr; #define TclOpenFileChannelInsertProc \ (tclIntStubsPtr->tclOpenFileChannelInsertProc) /* 67 */ #endif -#ifndef TclpAccess -#define TclpAccess \ - (tclIntStubsPtr->tclpAccess) /* 68 */ -#endif +/* Slot 68 is reserved */ #ifndef TclpAlloc #define TclpAlloc \ (tclIntStubsPtr->tclpAlloc) /* 69 */ @@ -1025,14 +983,8 @@ extern TclIntStubs *tclIntStubsPtr; #define TclpGetTimeZone \ (tclIntStubsPtr->tclpGetTimeZone) /* 78 */ #endif -#ifndef TclpListVolumes -#define TclpListVolumes \ - (tclIntStubsPtr->tclpListVolumes) /* 79 */ -#endif -#ifndef TclpOpenFileChannel -#define TclpOpenFileChannel \ - (tclIntStubsPtr->tclpOpenFileChannel) /* 80 */ -#endif +/* Slot 79 is reserved */ +/* Slot 80 is reserved */ #ifndef TclpRealloc #define TclpRealloc \ (tclIntStubsPtr->tclpRealloc) /* 81 */ @@ -1068,10 +1020,7 @@ extern TclIntStubs *tclIntStubsPtr; #define TclProcInterpProc \ (tclIntStubsPtr->tclProcInterpProc) /* 94 */ #endif -#ifndef TclpStat -#define TclpStat \ - (tclIntStubsPtr->tclpStat) /* 95 */ -#endif +/* Slot 95 is reserved */ #ifndef TclRenameCommand #define TclRenameCommand \ (tclIntStubsPtr->tclRenameCommand) /* 96 */ @@ -1124,10 +1073,7 @@ extern TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */ #endif #endif /* __WIN32__ */ -#ifndef TclStat -#define TclStat \ - (tclIntStubsPtr->tclStat) /* 105 */ -#endif +/* Slot 105 is reserved */ #ifndef TclStatDeleteProc #define TclStatDeleteProc \ (tclIntStubsPtr->tclStatDeleteProc) /* 106 */ @@ -1251,15 +1197,15 @@ extern TclIntStubs *tclIntStubsPtr; #define TclGetEnv \ (tclIntStubsPtr->tclGetEnv) /* 138 */ #endif -#ifndef TclpLoadFile -#define TclpLoadFile \ - (tclIntStubsPtr->tclpLoadFile) /* 139 */ -#endif +/* Slot 139 is reserved */ #ifndef TclLooksLikeInt #define TclLooksLikeInt \ (tclIntStubsPtr->tclLooksLikeInt) /* 140 */ #endif -/* Slot 141 is reserved */ +#ifndef TclpGetCwd +#define TclpGetCwd \ + (tclIntStubsPtr->tclpGetCwd) /* 141 */ +#endif #ifndef TclSetByteCodeFromAny #define TclSetByteCodeFromAny \ (tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */ @@ -1335,33 +1281,9 @@ extern TclIntStubs *tclIntStubsPtr; #define TclChannelEventScriptInvoker \ (tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */ #endif -#ifndef TclFileCopyCmd -#define TclFileCopyCmd \ - (tclIntStubsPtr->tclFileCopyCmd) /* 163 */ -#endif -#ifndef TclFileRenameCmd -#define TclFileRenameCmd \ - (tclIntStubsPtr->tclFileRenameCmd) /* 164 */ -#endif -#ifndef TclFileDeleteCmd -#define TclFileDeleteCmd \ - (tclIntStubsPtr->tclFileDeleteCmd) /* 165 */ -#endif -#ifndef TclFileMakeDirsCmd -#define TclFileMakeDirsCmd \ - (tclIntStubsPtr->tclFileMakeDirsCmd) /* 166 */ -#endif -#ifndef TclFileAttrsCmd -#define TclFileAttrsCmd \ - (tclIntStubsPtr->tclFileAttrsCmd) /* 167 */ -#endif -#ifndef TclpTempFileName -#define TclpTempFileName \ - (tclIntStubsPtr->tclpTempFileName) /* 168 */ -#endif #ifndef TclpSetInitialEncodings #define TclpSetInitialEncodings \ - (tclIntStubsPtr->tclpSetInitialEncodings) /* 169 */ + (tclIntStubsPtr->tclpSetInitialEncodings) /* 163 */ #endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c index 5228292..97b18b8 100644 --- a/generic/tclLoadNone.c +++ b/generic/tclLoadNone.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: tclLoadNone.c,v 1.4 1999/05/07 20:07:40 stanton Exp $ + * RCS: @(#) $Id: tclLoadNone.c,v 1.5 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -35,9 +35,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 647b3c3..932a61b 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.55 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.56 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -47,7 +47,7 @@ TclIntStubs tclIntStubs = { TCL_STUB_MAGIC, NULL, - TclAccess, /* 0 */ + NULL, /* 0 */ TclAccessDeleteProc, /* 1 */ TclAccessInsertProc, /* 2 */ TclAllocateFreeObjects, /* 3 */ @@ -131,7 +131,7 @@ TclIntStubs tclIntStubs = { TclObjInvokeGlobal, /* 65 */ TclOpenFileChannelDeleteProc, /* 66 */ TclOpenFileChannelInsertProc, /* 67 */ - TclpAccess, /* 68 */ + NULL, /* 68 */ TclpAlloc, /* 69 */ NULL, /* 70 */ NULL, /* 71 */ @@ -142,8 +142,8 @@ TclIntStubs tclIntStubs = { TclpGetSeconds, /* 76 */ TclpGetTime, /* 77 */ TclpGetTimeZone, /* 78 */ - TclpListVolumes, /* 79 */ - TclpOpenFileChannel, /* 80 */ + NULL, /* 79 */ + NULL, /* 80 */ TclpRealloc, /* 81 */ NULL, /* 82 */ NULL, /* 83 */ @@ -158,7 +158,7 @@ TclIntStubs tclIntStubs = { TclProcCompileProc, /* 92 */ TclProcDeleteProc, /* 93 */ TclProcInterpProc, /* 94 */ - TclpStat, /* 95 */ + NULL, /* 95 */ TclRenameCommand, /* 96 */ TclResetShadowedCmdRefs, /* 97 */ TclServiceIdle, /* 98 */ @@ -184,7 +184,7 @@ TclIntStubs tclIntStubs = { #ifdef MAC_TCL NULL, /* 104 */ #endif /* MAC_TCL */ - TclStat, /* 105 */ + NULL, /* 105 */ TclStatDeleteProc, /* 106 */ TclStatInsertProc, /* 107 */ TclTeardownNamespace, /* 108 */ @@ -218,9 +218,9 @@ TclIntStubs tclIntStubs = { NULL, /* 136 */ NULL, /* 137 */ TclGetEnv, /* 138 */ - TclpLoadFile, /* 139 */ + NULL, /* 139 */ TclLooksLikeInt, /* 140 */ - NULL, /* 141 */ + TclpGetCwd, /* 141 */ TclSetByteCodeFromAny, /* 142 */ TclAddLiteralObj, /* 143 */ TclHideLiteral, /* 144 */ @@ -242,13 +242,7 @@ TclIntStubs tclIntStubs = { NULL, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ - TclFileCopyCmd, /* 163 */ - TclFileRenameCmd, /* 164 */ - TclFileDeleteCmd, /* 165 */ - TclFileMakeDirsCmd, /* 166 */ - TclFileAttrsCmd, /* 167 */ - TclpTempFileName, /* 168 */ - TclpSetInitialEncodings, /* 169 */ + TclpSetInitialEncodings, /* 163 */ }; TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclTest.c b/generic/tclTest.c index f6fe969..f88412a 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.27 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.28 2001/08/30 08:53:15 vincentdarley Exp $ */ #define TCL_TEST @@ -167,6 +167,8 @@ static void SpecialFree _ANSI_ARGS_((char *blockPtr)); static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp)); static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); +static int PretendTclpAccess _ANSI_ARGS_((CONST char *path, + int mode)); static int TestAccessProc1 _ANSI_ARGS_((CONST char *path, int mode)); static int TestAccessProc2 _ANSI_ARGS_((CONST char *path, @@ -212,7 +214,7 @@ static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy, static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestfileCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestfeventCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); static int TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy, @@ -237,6 +239,8 @@ static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData, Tcl_Value *resultPtr)); static int TestmainthreadCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); +static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp, + char *filename, char *modeString, int permissions)); static Tcl_Channel TestOpenFileChannelProc1 _ANSI_ARGS_((Tcl_Interp *interp, char *filename, char *modeString, int permissions)); static Tcl_Channel TestOpenFileChannelProc2 _ANSI_ARGS_((Tcl_Interp *interp, @@ -279,6 +283,8 @@ static int TestsetrecursionlimitCmd _ANSI_ARGS_(( int objc, Tcl_Obj *CONST objv[])); static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, char **argv)); +static int PretendTclpStat _ANSI_ARGS_((CONST char *path, + struct stat *buf)); static int TestStatProc1 _ANSI_ARGS_((CONST char *path, struct stat *buf)); static int TestStatProc2 _ANSI_ARGS_((CONST char *path, @@ -466,7 +472,7 @@ Tcltest_Init(interp) (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testfile", TestfileCmd, + Tcl_CreateObjCommand(interp, "testfile", TestfileCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); @@ -3445,11 +3451,12 @@ static int TestfileCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int argc; /* Number of arguments. */ + Tcl_Obj *CONST argv[]; /* The argument objects. */ { int force, i, j, result; - Tcl_DString error, name[2]; + Tcl_Obj *error = NULL; + char *subcmd; if (argc < 3) { return TCL_ERROR; @@ -3457,54 +3464,51 @@ TestfileCmd(dummy, interp, argc, argv) force = 0; i = 2; - if (strcmp(argv[2], "-force") == 0) { + if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) { force = 1; i = 3; } - Tcl_DStringInit(&name[0]); - Tcl_DStringInit(&name[1]); - Tcl_DStringInit(&error); - if (argc - i > 2) { return TCL_ERROR; } for (j = i; j < argc; j++) { - argv[j] = Tcl_TranslateFileName(interp, argv[j], &name[j - i]); - if (argv[j] == NULL) { + if (Tcl_FSGetTranslatedPath(interp, argv[j]) == NULL) { return TCL_ERROR; } } - if (strcmp(argv[1], "mv") == 0) { - result = TclpRenameFile(argv[i], argv[i + 1]); - } else if (strcmp(argv[1], "cp") == 0) { - result = TclpCopyFile(argv[i], argv[i + 1]); - } else if (strcmp(argv[1], "rm") == 0) { - result = TclpDeleteFile(argv[i]); - } else if (strcmp(argv[1], "mkdir") == 0) { - result = TclpCreateDirectory(argv[i]); - } else if (strcmp(argv[1], "cpdir") == 0) { - result = TclpCopyDirectory(argv[i], argv[i + 1], &error); - } else if (strcmp(argv[1], "rmdir") == 0) { - result = TclpRemoveDirectory(argv[i], force, &error); + subcmd = Tcl_GetString(argv[1]); + + if (strcmp(subcmd, "mv") == 0) { + result = TclpObjRenameFile(argv[i], argv[i + 1]); + } else if (strcmp(subcmd, "cp") == 0) { + result = TclpObjCopyFile(argv[i], argv[i + 1]); + } else if (strcmp(subcmd, "rm") == 0) { + result = TclpObjDeleteFile(argv[i]); + } else if (strcmp(subcmd, "mkdir") == 0) { + result = TclpObjCreateDirectory(argv[i]); + } else if (strcmp(subcmd, "cpdir") == 0) { + result = TclpObjCopyDirectory(argv[i], argv[i + 1], &error); + } else if (strcmp(subcmd, "rmdir") == 0) { + result = TclpObjRemoveDirectory(argv[i], force, &error); } else { result = TCL_ERROR; goto end; } if (result != TCL_OK) { - if (Tcl_DStringValue(&error)[0] != '\0') { - Tcl_AppendResult(interp, Tcl_DStringValue(&error), " ", NULL); + if (error != NULL) { + if (Tcl_GetString(error)[0] != '\0') { + Tcl_AppendResult(interp, Tcl_GetString(error), " ", NULL); + } + Tcl_DecrRefCount(error); } Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL); } end: - Tcl_DStringFree(&error); - Tcl_DStringFree(&name[0]); - Tcl_DStringFree(&name[1]); return result; } @@ -4040,7 +4044,7 @@ TeststatprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[2], "TclpStat") == 0) { - proc = TclpStat; + proc = PretendTclpStat; } else if (strcmp(argv[2], "TestStatProc1") == 0) { proc = TestStatProc1; } else if (strcmp(argv[2], "TestStatProc2") == 0) { @@ -4056,7 +4060,7 @@ TeststatprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[1], "insert") == 0) { - if (proc == TclpStat) { + if (proc == PretendTclpStat) { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", "TestStatProc1, TestStatProc2, or TestStatProc3", @@ -4080,11 +4084,23 @@ TeststatprocCmd (dummy, interp, argc, argv) return retVal; } +static int PretendTclpStat(path, buf) + CONST char *path; + struct stat *buf; +{ + int ret; + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); + Tcl_IncrRefCount(pathPtr); + ret = Tcl_FSStat(pathPtr, buf); + Tcl_DecrRefCount(pathPtr); + return ret; +} + /* Be careful in the compares in these tests, since the Macintosh puts a * leading : in the beginning of non-absolute paths before passing them * into the file command procedures. */ - + static int TestStatProc1(path, buf) CONST char *path; @@ -4182,7 +4198,7 @@ TestaccessprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[2], "TclpAccess") == 0) { - proc = TclpAccess; + proc = PretendTclpAccess; } else if (strcmp(argv[2], "TestAccessProc1") == 0) { proc = TestAccessProc1; } else if (strcmp(argv[2], "TestAccessProc2") == 0) { @@ -4198,7 +4214,7 @@ TestaccessprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[1], "insert") == 0) { - if (proc == TclpAccess) { + if (proc == PretendTclpAccess) { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", "TestAccessProc1, TestAccessProc2, or TestAccessProc3", @@ -4222,6 +4238,17 @@ TestaccessprocCmd (dummy, interp, argc, argv) return retVal; } +static int PretendTclpAccess(path, mode) + CONST char *path; + int mode; +{ + int ret; + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); + Tcl_IncrRefCount(pathPtr); + ret = Tcl_FSAccess(pathPtr, mode); + Tcl_DecrRefCount(pathPtr); + return ret; +} static int TestAccessProc1(path, mode) @@ -4283,7 +4310,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[2], "TclpOpenFileChannel") == 0) { - proc = TclpOpenFileChannel; + proc = PretendTclpOpenFileChannel; } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) { proc = TestOpenFileChannelProc1; } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) { @@ -4300,7 +4327,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) } if (strcmp(argv[1], "insert") == 0) { - if (proc == TclpOpenFileChannel) { + if (proc == PretendTclpOpenFileChannel) { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ", @@ -4325,6 +4352,24 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) return retVal; } +static Tcl_Channel +PretendTclpOpenFileChannel(interp, fileName, modeString, permissions) + Tcl_Interp *interp; /* Interpreter for error reporting; + * can be NULL. */ + char *fileName; /* Name of file to open. */ + char *modeString; /* A list of POSIX open modes or + * a string such as "rw". */ + int permissions; /* If the open involves creating a + * file, with what modes to create + * it? */ +{ + Tcl_Channel ret; + Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName, -1); + Tcl_IncrRefCount(pathPtr); + ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions); + Tcl_DecrRefCount(pathPtr); + return ret; +} static Tcl_Channel TestOpenFileChannelProc1(interp, fileName, modeString, permissions) @@ -4337,18 +4382,18 @@ TestOpenFileChannelProc1(interp, fileName, modeString, permissions) * file, with what modes to create * it? */ { - char *expectname="testOpenFileChannel1%.fil"; + char *expectname="testOpenFileChannel1%.fil"; Tcl_DString ds; - Tcl_DStringInit(&ds); - Tcl_JoinPath(1, &expectname, &ds); + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); if (!strcmp(Tcl_DStringValue(&ds), fileName)) { - Tcl_DStringFree(&ds); - return (TclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil", + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel1%__.fil", modeString, permissions)); } else { - Tcl_DStringFree(&ds); + Tcl_DStringFree(&ds); return (NULL); } } @@ -4365,18 +4410,18 @@ TestOpenFileChannelProc2(interp, fileName, modeString, permissions) * file, with what modes to create * it? */ { - char *expectname="testOpenFileChannel2%.fil"; + char *expectname="testOpenFileChannel2%.fil"; Tcl_DString ds; - Tcl_DStringInit(&ds); - Tcl_JoinPath(1, &expectname, &ds); + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); if (!strcmp(Tcl_DStringValue(&ds), fileName)) { - Tcl_DStringFree(&ds); - return (TclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil", + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel2%__.fil", modeString, permissions)); } else { - Tcl_DStringFree(&ds); + Tcl_DStringFree(&ds); return (NULL); } } @@ -4393,18 +4438,18 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions) * file, with what modes to create * it? */ { - char *expectname="testOpenFileChannel3%.fil"; + char *expectname="testOpenFileChannel3%.fil"; Tcl_DString ds; - Tcl_DStringInit(&ds); - Tcl_JoinPath(1, &expectname, &ds); + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); if (!strcmp(Tcl_DStringValue(&ds), fileName)) { - Tcl_DStringFree(&ds); - return (TclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil", + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil", modeString, permissions)); } else { - Tcl_DStringFree(&ds); + Tcl_DStringFree(&ds); return (NULL); } } diff --git a/mac/tclMacChan.c b/mac/tclMacChan.c index 2fbac8f..e728c7f 100644 --- a/mac/tclMacChan.c +++ b/mac/tclMacChan.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: tclMacChan.c,v 1.6 1999/04/16 00:47:19 stanton Exp $ + * RCS: @(#) $Id: tclMacChan.c,v 1.7 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -753,7 +753,7 @@ Tcl_Channel TclpOpenFileChannel( Tcl_Interp *interp, /* Interpreter for error reporting; * can be NULL. */ - char *fileName, /* Name of file to open. */ + Tcl_Obj *pathPtr, /* Name of file to open. */ char *modeString, /* A list of POSIX open modes or * a string such as "rw". */ int permissions) /* If the open involves creating a @@ -763,7 +763,6 @@ TclpOpenFileChannel( Tcl_Channel chan; int mode; char *native; - Tcl_DString ds, buffer; int errorCode; mode = GetOpenMode(interp, modeString); @@ -771,20 +770,18 @@ TclpOpenFileChannel( return NULL; } - if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) { + native = Tcl_FSGetNativePath(pathPtr); + if (native == NULL) { return NULL; } - native = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer), - Tcl_DStringLength(&buffer), &ds); chan = OpenFileChannel(native, mode, permissions, &errorCode); - Tcl_DStringFree(&ds); - Tcl_DStringFree(&buffer); if (chan == NULL) { Tcl_SetErrno(errorCode); if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_AppendResult(interp, "couldn't open \"", + Tcl_GetString(pathPtr), "\": ", + Tcl_PosixError(interp), (char *) NULL); } return NULL; } diff --git a/mac/tclMacFCmd.c b/mac/tclMacFCmd.c index e3c2366..ebc9319 100644 --- a/mac/tclMacFCmd.c +++ b/mac/tclMacFCmd.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: tclMacFCmd.c,v 1.9 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclMacFCmd.c,v 1.10 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -98,77 +98,10 @@ static OSErr MoveRename _ANSI_ARGS_((const FSSpec *srcSpecPtr, static int Pstrequal _ANSI_ARGS_((ConstStr255Param stringA, ConstStr255Param stringB)); -int -TclpObjCreateDirectory(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjDeleteFile(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - ret = DoCopyDirectory(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr), &ds); - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjCopyFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); -} - -int -TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_Obj *pathPtr; - int recursive; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - ret = DoRemoveDirectory(Tcl_FSGetNativePath(pathPtr),recursive, &ds); - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjRenameFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); -} - /* *--------------------------------------------------------------------------- * - * TclpRenameFile, DoRenameFile -- + * TclpObjRenameFile, DoRenameFile -- * * Changes the name of an existing file or directory, from src to dst. * If src and dst refer to the same file or directory, does nothing @@ -200,23 +133,13 @@ TclpObjRenameFile(srcPathPtr, destPathPtr) *--------------------------------------------------------------------------- */ -int -TclpRenameFile( - CONST char *src, /* Pathname of file or dir to be renamed - * (UTF-8). */ - CONST char *dst) /* New pathname of file or directory - * (UTF-8). */ +int +TclpObjRenameFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - Tcl_DString srcString, dstString; - - Tcl_UtfToExternalDString(NULL, src, -1, &srcString); - Tcl_UtfToExternalDString(NULL, dst, -1, &dstString); - result = DoRenameFile(Tcl_DStringValue(&srcString), - Tcl_DStringValue(&dstString)); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -451,7 +374,7 @@ MoveRename( /* *--------------------------------------------------------------------------- * - * TclpCopyFile, DoCopyFile -- + * TclpObjCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and * is not a directory, it is removed. @@ -476,20 +399,12 @@ MoveRename( */ int -TclpCopyFile( - CONST char *src, /* Pathname of file to be copied (UTF-8). */ - CONST char *dst) /* Pathname of file to copy to (UTF-8). */ +TclpObjCopyFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - Tcl_DString srcString, dstString; - - Tcl_UtfToExternalDString(NULL, src, -1, &srcString); - Tcl_UtfToExternalDString(NULL, dst, -1, &dstString); - result = DoCopyFile(Tcl_DStringValue(&srcString), - Tcl_DStringValue(&dstString)); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -564,7 +479,7 @@ DoCopyFile( /* *--------------------------------------------------------------------------- * - * TclpDeleteFile, DoDeleteFile -- + * TclpObjDeleteFile, DoDeleteFile -- * * Removes a single file (not a directory). * @@ -583,17 +498,11 @@ DoCopyFile( *--------------------------------------------------------------------------- */ -int -TclpDeleteFile( - CONST char *path) /* Pathname of file to be removed (UTF-8). */ +int +TclpObjDeleteFile(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_UtfToExternalDString(NULL, path, -1, &pathString); - result = DoDeleteFile(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); } static int @@ -636,7 +545,7 @@ DoDeleteFile( /* *--------------------------------------------------------------------------- * - * TclpCreateDirectory, DoCreateDirectory -- + * TclpObjCreateDirectory, DoCreateDirectory -- * * Creates the specified directory. All parent directories of the * specified directory must already exist. The directory is @@ -659,17 +568,11 @@ DoDeleteFile( *--------------------------------------------------------------------------- */ -int -TclpCreateDirectory( - CONST char *path) /* Pathname of directory to create (UTF-8). */ +int +TclpObjCreateDirectory(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_UtfToExternalDString(NULL, path, -1, &pathString); - result = DoCreateDirectory(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int @@ -697,7 +600,7 @@ DoCreateDirectory( /* *--------------------------------------------------------------------------- * - * TclpCopyDirectory, DoCopyDirectory -- + * TclpObjCopyDirectory, DoCopyDirectory -- * * Recursively copies a directory. The target directory dst must * not already exist. Note that this function does not merge two @@ -720,25 +623,22 @@ DoCreateDirectory( *--------------------------------------------------------------------------- */ -int -TclpCopyDirectory( - CONST char *src, /* Pathname of directory to be copied - * (UTF-8). */ - CONST char *dst, /* Pathname of target directory (UTF-8). */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; + Tcl_Obj **errorPtr; { - int result; - Tcl_DString srcString, dstString; - - Tcl_UtfToExternalDString(NULL, src, -1, &srcString); - Tcl_UtfToExternalDString(NULL, dst, -1, &dstString); - result = DoCopyDirectory(Tcl_DStringValue(&srcString), - Tcl_DStringValue(&dstString), errorPtr); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + Tcl_DString ds; + int ret; + ret = DoCopyDirectory(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr), &ds); + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; } static int @@ -900,7 +800,7 @@ CopyErrHandler( /* *--------------------------------------------------------------------------- * - * TclpRemoveDirectory, DoRemoveDirectory -- + * TclpObjRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * @@ -923,26 +823,21 @@ CopyErrHandler( *--------------------------------------------------------------------------- */ -int -TclpRemoveDirectory( - CONST char *path, /* Pathname of directory to be removed - * (UTF-8). */ - int recursive, /* If non-zero, removes directories that - * are nonempty. Otherwise, will only remove - * empty directories. */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) + Tcl_Obj *pathPtr; + int recursive; + Tcl_Obj **errorPtr; { - int result; - Tcl_DString pathString; - - Tcl_UtfToExternalDString(NULL, path, -1, &pathString); - result = DoRemoveDirectory(Tcl_DStringValue(&pathString), recursive, - errorPtr); - Tcl_DStringFree(&pathString); - - return result; + Tcl_DString ds; + int ret; + ret = DoRemoveDirectory(Tcl_FSGetNativePath(pathPtr),recursive, &ds); + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; } static int @@ -1642,7 +1537,7 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) Tcl_Obj *pathPtr; int nextCheckpoint; { - #define MAXMACFILENAMELEN 31 /* assumed to be < sizeof(StrFileName) */ + #define MAXMACFILENAMELEN 31 /* assumed to be < sizeof(StrFileName) */ StrFileName fileName; StringPtr fileNamePtr; @@ -1653,134 +1548,157 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) long dirID; Boolean isDirectory; Boolean wasAlias; - FSSpec fileSpec; - - Tcl_DString nativeds; + FSSpec fileSpec; + + Tcl_DString nativeds; - char cur; - int firstCheckpoint=nextCheckpoint, lastCheckpoint; - int origPathLen; + char cur; + int firstCheckpoint=nextCheckpoint, lastCheckpoint; + int origPathLen; char *path = Tcl_GetStringFromObj(pathPtr,&origPathLen); - - { - int currDirValid=0; - /* - * check if substring to first ':' after initial - * nextCheckpoint is a valid relative or absolute - * path to a directory, if not we return without - * normalizing anything - */ - while (1) { - cur = path[nextCheckpoint]; - if (cur == ':' || cur == 0) { - if (cur == ':') { nextCheckpoint++; cur = path[nextCheckpoint]; } /* jump over separator */ - Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds); - err = FSpLocationFromPath(Tcl_DStringLength(&nativeds), Tcl_DStringValue(&nativeds), &fileSpec); - Tcl_DStringFree(&nativeds); - if (err == noErr) { - err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); - currDirValid = ((err == noErr) && isDirectory); - vRefNum = fileSpec.vRefNum; - } + { + int currDirValid=0; + /* + * check if substring to first ':' after initial + * nextCheckpoint is a valid relative or absolute + * path to a directory, if not we return without + * normalizing anything + */ + + while (1) { + cur = path[nextCheckpoint]; + if (cur == ':' || cur == 0) { + if (cur == ':') { + /* jump over separator */ + nextCheckpoint++; cur = path[nextCheckpoint]; + } + Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds); + err = FSpLocationFromPath(Tcl_DStringLength(&nativeds), + Tcl_DStringValue(&nativeds), + &fileSpec); + Tcl_DStringFree(&nativeds); + if (err == noErr) { + err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); + currDirValid = ((err == noErr) && isDirectory); + vRefNum = fileSpec.vRefNum; + } break; + } + nextCheckpoint++; } - nextCheckpoint++; - } - - if(!currDirValid) return firstCheckpoint; /* can't determine root dir, bail out */ + + if(!currDirValid) { + /* can't determine root dir, bail out */ + return firstCheckpoint; } + } - /* - * Now vRefNum and dirID point to a valid - * directory, so walk the rest of the path - * ( code adapted from FSpLocationFromPath() ) - */ + /* + * Now vRefNum and dirID point to a valid + * directory, so walk the rest of the path + * ( code adapted from FSpLocationFromPath() ) + */ - lastCheckpoint=nextCheckpoint; + lastCheckpoint=nextCheckpoint; while (1) { cur = path[nextCheckpoint]; if (cur == ':' || cur == 0) { - fileNameLen=nextCheckpoint-lastCheckpoint; - fileNamePtr=fileName; - if(fileNameLen==0) { - if (cur == ':') { - /* - * special case for empty dirname i.e. encountered - * a '::' path component: get parent dir of currDir - */ - fileName[0]=2; - strcpy((char *) fileName + 1, "::"); - lastCheckpoint--; - } else { - /* - * empty filename, i.e. want FSSpec for currDir - */ - fileNamePtr=NULL; - } + fileNameLen=nextCheckpoint-lastCheckpoint; + fileNamePtr=fileName; + if(fileNameLen==0) { + if (cur == ':') { + /* + * special case for empty dirname i.e. encountered + * a '::' path component: get parent dir of currDir + */ + fileName[0]=2; + strcpy((char *) fileName + 1, "::"); + lastCheckpoint--; } else { - Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint],fileNameLen,&nativeds); - fileNameLen=Tcl_DStringLength(&nativeds); - if(fileNameLen > MAXMACFILENAMELEN) fileNameLen=MAXMACFILENAMELEN; - fileName[0]=fileNameLen; - strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds), fileNameLen); - Tcl_DStringFree(&nativeds); + /* + * empty filename, i.e. want FSSpec for currDir + */ + fileNamePtr=NULL; + } + } else { + Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint], + fileNameLen,&nativeds); + fileNameLen=Tcl_DStringLength(&nativeds); + if(fileNameLen > MAXMACFILENAMELEN) + fileNameLen=MAXMACFILENAMELEN; + fileName[0]=fileNameLen; + strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds), + fileNameLen); + Tcl_DStringFree(&nativeds); + } + err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec); + if(err != noErr) { + if(err != fnfErr) { + /* + * this can if trying to get parent of a root + * volume via '::' or when using an illegal + * filename revert to last checkpoint and stop + * processing path further + */ + err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec); + if(err != noErr) { + /* should never happen, bail out */ + return firstCheckpoint; + } + nextCheckpoint=lastCheckpoint; + cur = path[lastCheckpoint]; } - err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec); - if(err != noErr) { - if(err != fnfErr) { - /* - * this can if trying to get parent of a root volume via '::' - * or when using an illegal filename - * revert to last checkpoint and stop processing path further - */ - err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec); - if(err != noErr) return firstCheckpoint; /* should never happen, bail out */ - nextCheckpoint=lastCheckpoint; - cur = path[lastCheckpoint]; - } break; /* arrived at nonexistent file or dir */ - } else { - /* fileSpec could point to an alias, resolve it */ - err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias); - if (err != noErr || !isDirectory) break; /* fileSpec doesn't point to a dir */ + } else { + /* fileSpec could point to an alias, resolve it */ + err = ResolveAliasFile(&fileSpec, true, &isDirectory, + &wasAlias); + if (err != noErr || !isDirectory) { + break; /* fileSpec doesn't point to a dir */ } - if (cur == 0) break; /* arrived at end of path */ - - /* fileSpec points to possibly nonexisting subdirectory; validate */ - err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); - if (err != noErr || !isDirectory) break; /* fileSpec doesn't point to existing dir */ - vRefNum = fileSpec.vRefNum; + } + if (cur == 0) break; /* arrived at end of path */ + + /* fileSpec points to possibly nonexisting subdirectory; validate */ + err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); + if (err != noErr || !isDirectory) { + break; /* fileSpec doesn't point to existing dir */ + } + vRefNum = fileSpec.vRefNum; - /* found a new valid subdir in path, continue processing path */ - lastCheckpoint=nextCheckpoint+1; + /* found a new valid subdir in path, continue processing path */ + lastCheckpoint=nextCheckpoint+1; } nextCheckpoint++; } - - /* - * fileSpec now points to a possibly nonexisting file or dir - * inside a valid dir; get full path name to it - */ - - err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle); - if(err != noErr) return firstCheckpoint; /* should not see any errors here, bail out */ - - HLock(newPathHandle); - Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds); + + /* + * fileSpec now points to a possibly nonexisting file or dir + * inside a valid dir; get full path name to it + */ + + err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle); + if(err != noErr) { + return firstCheckpoint; /* should not see any errors here, bail out */ + } + + HLock(newPathHandle); + Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds); if (cur != 0) { - /* not at end, append remaining path */ + /* not at end, append remaining path */ if ( newPathLen==0 || *(*newPathHandle+(newPathLen-1))!=':') { - Tcl_DStringAppend(&nativeds, ":" , 1); - } - Tcl_DStringAppend(&nativeds, &path[nextCheckpoint+1], strlen(&path[nextCheckpoint+1])); + Tcl_DStringAppend(&nativeds, ":" , 1); + } + Tcl_DStringAppend(&nativeds, &path[nextCheckpoint+1], + strlen(&path[nextCheckpoint+1])); } - DisposeHandle(newPathHandle); - - fileNameLen=Tcl_DStringLength(&nativeds); - Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen); - Tcl_DStringFree(&nativeds); + DisposeHandle(newPathHandle); + + fileNameLen=Tcl_DStringLength(&nativeds); + Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen); + Tcl_DStringFree(&nativeds); - return nextCheckpoint+(fileNameLen-origPathLen); + return nextCheckpoint+(fileNameLen-origPathLen); } diff --git a/mac/tclMacFile.c b/mac/tclMacFile.c index c8aaf85..cb85d59 100644 --- a/mac/tclMacFile.c +++ b/mac/tclMacFile.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: tclMacFile.c,v 1.11 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclMacFile.c,v 1.12 2001/08/30 08:53:15 vincentdarley Exp $ */ /* @@ -31,9 +31,10 @@ #include <MoreFilesExtras.h> #include <FSpCompat.h> -static OSErr FspLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr, FSSpec* specPtr)); +static OSErr FspLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr, + FSSpec* specPtr)); -OSErr +static OSErr FspLocationFromFsPath(pathPtr, specPtr) Tcl_Obj *pathPtr; FSSpec* specPtr; @@ -164,15 +165,17 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig), Tcl_DStringLength(&dsOrig), &fileString); - err = FSpLocationFromPath(Tcl_DStringLength(&fileString), Tcl_DStringValue(&fileString), &dirSpec); + err = FSpLocationFromPath(Tcl_DStringLength(&fileString), + Tcl_DStringValue(&fileString), &dirSpec); Tcl_DStringFree(&fileString); if (err == noErr) err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory); if ((err != noErr) || !isDirectory) { /* - * Check if we had a relative path (unix style rel path compatibility for glob) + * Check if we had a relative path (unix style relative path + * compatibility for glob) */ - Tcl_DStringFree(&dsOrig); + Tcl_DStringFree(&dsOrig); Tcl_DStringAppend(&dsOrig, ":", 1); Tcl_DStringAppend(&dsOrig, fileName2, -1); baseLength = Tcl_DStringLength(&dsOrig); @@ -180,7 +183,8 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig), Tcl_DStringLength(&dsOrig), &fileString); - err = FSpLocationFromPath(Tcl_DStringLength(&fileString), Tcl_DStringValue(&fileString), &dirSpec); + err = FSpLocationFromPath(Tcl_DStringLength(&fileString), + Tcl_DStringValue(&fileString), &dirSpec); Tcl_DStringFree(&fileString); if (err == noErr) err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory); @@ -232,8 +236,16 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) int typeOk = 1; Tcl_DStringSetLength(&dsOrig, baseLength); Tcl_DStringAppend(&dsOrig, Tcl_DStringValue(&fileString), -1); + Tcl_Obj *tempName; fname = Tcl_DStringValue(&dsOrig); fnameLen = Tcl_DStringLength(&dsOrig); + + /* + * We use this tempName in calls to check the file's + * type below. We may also use it for the result. + */ + tempName = Tcl_NewStringObj(fname, fnameLen); + Tcl_IncrRefCount(tempName); if (types == NULL) { /* If invisible, don't return the file */ @@ -242,7 +254,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } } else { struct stat buf; - + if (pb.hFileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) { /* If invisible */ if ((types->perm == 0) || @@ -260,11 +272,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) ((types->perm & TCL_GLOB_PERM_RONLY) && !(pb.hFileInfo.ioFlAttrib & 1)) || ((types->perm & TCL_GLOB_PERM_R) && - (TclpAccess(fname, R_OK) != 0)) || + (TclpObjAccess(tempName, R_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_W) && - (TclpAccess(fname, W_OK) != 0)) || + (TclpObjAccess(tempName, W_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_X) && - (TclpAccess(fname, X_OK) != 0)) + (TclpObjAccess(tempName, X_OK) != 0)) ) { typeOk = 0; } @@ -272,7 +284,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if (typeOk == 1 && types->type != 0) { if (types->perm == 0) { /* We haven't yet done a stat on the file */ - if (TclpStat(fname, &buf) != 0) { + if (TclpObjStat(tempName, &buf) != 0) { /* Posix error occurred */ typeOk = 0; } @@ -302,7 +314,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) typeOk = 0; #ifdef S_ISLNK if (types->type & TCL_GLOB_TYPE_LINK) { - if (TclpLstat(fname, &buf) == 0) { + if (TclpObjLstat(tempName, &buf) == 0) { if (S_ISLNK(buf.st_mode)) { typeOk = 1; } @@ -325,10 +337,14 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(fname+1, fnameLen-1)); } else { - Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(fname, fnameLen)); + Tcl_ListObjAppendElement(interp, resultPtr, tempName); } } + /* + * This will free the object, unless it was inserted in + * the result list above. + */ + Tcl_DecrRefCount(tempName); } Tcl_DStringFree(&fileString); itemIndex++; @@ -341,7 +357,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) /* *---------------------------------------------------------------------- * - * TclpAccess -- + * TclpObjAccess -- * * This function replaces the library version of access(). * @@ -354,23 +370,89 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) *---------------------------------------------------------------------- */ -int -TclpAccess( - CONST char *path, /* Path of file to access (UTF-8). */ - int mode) /* Permission setting. */ +int +TclpObjAccess(pathPtr, mode) + Tcl_Obj *pathPtr; + int mode; { - int ret; - Tcl_Obj *obj = Tcl_NewStringObj(path,-1); - Tcl_IncrRefCount(obj); - ret = TclpObjAccess(obj,mode); - Tcl_DecrRefCount(obj); - return ret; + HFileInfo fpb; + HVolumeParam vpb; + OSErr err; + FSSpec fileSpec; + Boolean isDirectory; + long dirID; + int full_mode = 0; + + err = FspLocationFromFsPath(pathPtr, &fileSpec); + + if (err != noErr) { + errno = TclMacOSErrorToPosixError(err); + return -1; + } + + /* + * Fill the fpb & vpb struct up with info about file or directory. + */ + FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); + vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum; + vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name; + if (isDirectory) { + fpb.ioDirID = fileSpec.parID; + } else { + fpb.ioDirID = dirID; + } + + fpb.ioFDirIndex = 0; + err = PBGetCatInfoSync((CInfoPBPtr)&fpb); + if (err == noErr) { + vpb.ioVolIndex = 0; + err = PBHGetVInfoSync((HParmBlkPtr)&vpb); + if (err == noErr) { + /* + * Use the Volume Info & File Info to determine + * access information. If we have got this far + * we know the directory is searchable or the file + * exists. (We have F_OK) + */ + + /* + * Check to see if the volume is hardware or + * software locked. If so we arn't W_OK. + */ + if (mode & W_OK) { + if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) { + errno = EROFS; + return -1; + } + if (fpb.ioFlAttrib & 0x01) { + errno = EACCES; + return -1; + } + } + + /* + * Directories are always searchable and executable. But only + * files of type 'APPL' are executable. + */ + if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK) + && (fpb.ioFlFndrInfo.fdType != 'APPL')) { + return -1; + } + } + } + + if (err != noErr) { + errno = TclMacOSErrorToPosixError(err); + return -1; + } + + return 0; } /* *---------------------------------------------------------------------- * - * TclpChdir -- + * TclpObjChdir -- * * This function replaces the library version of chdir(). * @@ -379,27 +461,57 @@ TclpAccess( * * Side effects: * See chdir() documentation. Also the cache maintained used by - * TclGetCwd() is deallocated and set to NULL. + * Tcl_FSGetCwd() is deallocated and set to NULL. * *---------------------------------------------------------------------- */ -int -TclpChdir( - CONST char *dirName) /* Path to new working directory (UTF-8). */ +int +TclpObjChdir(pathPtr) + Tcl_Obj *pathPtr; { - int ret; - Tcl_Obj *obj = Tcl_NewStringObj(dirName,-1); - Tcl_IncrRefCount(obj); - ret = TclpObjChdir(obj); - Tcl_DecrRefCount(obj); - return ret; + FSSpec spec; + OSErr err; + Boolean isFolder; + long dirID; + + err = FspLocationFromFsPath(pathPtr, &spec); + + if (err != noErr) { + errno = ENOENT; + return -1; + } + + err = FSpGetDirectoryID(&spec, &dirID, &isFolder); + if (err != noErr) { + errno = ENOENT; + return -1; + } + + if (isFolder != true) { + errno = ENOTDIR; + return -1; + } + + err = FSpSetDefaultDir(&spec); + if (err != noErr) { + switch (err) { + case afpAccessDenied: + errno = EACCES; + break; + default: + errno = ENOENT; + } + return -1; + } + + return 0; } /* *---------------------------------------------------------------------- * - * TclpGetCwd -- + * TclpObjGetCwd -- * * This function replaces the library version of getcwd(). * @@ -417,6 +529,21 @@ TclpChdir( *---------------------------------------------------------------------- */ +Tcl_Obj* +TclpObjGetCwd(interp) + Tcl_Interp *interp; +{ + Tcl_DString ds; + if (TclpGetCwd(interp, &ds) != NULL) { + Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(cwdPtr); + Tcl_DStringFree(&ds); + return cwdPtr; + } else { + return NULL; + } +} + char * TclpGetCwd( Tcl_Interp *interp, /* If non-NULL, used for error reporting. */ @@ -585,35 +712,32 @@ TclpReadlink( /* *---------------------------------------------------------------------- * - * TclpLstat -- + * TclpObjLstat -- * * This function replaces the library version of lstat(). * * Results: - * See stat() documentation. + * See lstat() documentation. * * Side effects: - * See stat() documentation. + * See lstat() documentation. * *---------------------------------------------------------------------- */ -int -TclpLstat( - CONST char *path, /* Path of file to stat (in UTF-8). */ - struct stat *bufPtr) /* Filled with results of stat call. */ +int +TclpObjLstat(pathPtr, buf) + Tcl_Obj *pathPtr; + struct stat *buf; { - /* - * FIXME: Emulate TclpLstat - */ - - return TclpStat(path, bufPtr); + /* This needs to be enhanced to deal with aliases */ + return TclpObjStat(pathPtr, buf); } /* *---------------------------------------------------------------------- * - * TclpStat -- + * TclpObjStat -- * * This function replaces the library version of stat(). * @@ -626,17 +750,107 @@ TclpLstat( *---------------------------------------------------------------------- */ -int -TclpStat( - CONST char *path, /* Path of file to stat (in UTF-8). */ - struct stat *bufPtr) /* Filled with results of stat call. */ +int +TclpObjStat(pathPtr, bufPtr) + Tcl_Obj *pathPtr; + struct stat *bufPtr; { - int ret; - Tcl_Obj *obj = Tcl_NewStringObj(path,-1); - Tcl_IncrRefCount(obj); - ret = TclpObjStat(obj,bufPtr); - Tcl_DecrRefCount(obj); - return ret; + HFileInfo fpb; + HVolumeParam vpb; + OSErr err; + FSSpec fileSpec; + Boolean isDirectory; + long dirID; + + err = FspLocationFromFsPath(pathPtr, &fileSpec); + + if (err != noErr) { + errno = TclMacOSErrorToPosixError(err); + return -1; + } + + /* + * Fill the fpb & vpb struct up with info about file or directory. + */ + + FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); + vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum; + vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name; + if (isDirectory) { + fpb.ioDirID = fileSpec.parID; + } else { + fpb.ioDirID = dirID; + } + + fpb.ioFDirIndex = 0; + err = PBGetCatInfoSync((CInfoPBPtr)&fpb); + if (err == noErr) { + vpb.ioVolIndex = 0; + err = PBHGetVInfoSync((HParmBlkPtr)&vpb); + if (err == noErr && bufPtr != NULL) { + /* + * Files are always readable by everyone. + */ + + bufPtr->st_mode = S_IRUSR | S_IRGRP | S_IROTH; + + /* + * Use the Volume Info & File Info to fill out stat buf. + */ + if (fpb.ioFlAttrib & 0x10) { + bufPtr->st_mode |= S_IFDIR; + bufPtr->st_nlink = 2; + } else { + bufPtr->st_nlink = 1; + if (fpb.ioFlFndrInfo.fdFlags & 0x8000) { + bufPtr->st_mode |= S_IFLNK; + } else { + bufPtr->st_mode |= S_IFREG; + } + } + if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) { + /* + * Directories and applications are executable by everyone. + */ + + bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH; + } + if ((fpb.ioFlAttrib & 0x01) == 0){ + /* + * If not locked, then everyone has write acces. + */ + + bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH; + } + bufPtr->st_ino = fpb.ioDirID; + bufPtr->st_dev = fpb.ioVRefNum; + bufPtr->st_uid = -1; + bufPtr->st_gid = -1; + bufPtr->st_rdev = 0; + bufPtr->st_size = fpb.ioFlLgLen; + bufPtr->st_blksize = vpb.ioVAlBlkSiz; + bufPtr->st_blocks = (bufPtr->st_size + bufPtr->st_blksize - 1) + / bufPtr->st_blksize; + + /* + * The times returned by the Mac file system are in the + * local time zone. We convert them to GMT so that the + * epoch starts from GMT. This is also consistent with + * what is returned from "clock seconds". + */ + + bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat + - TclpGetGMTOffset() + tcl_mac_epoch_offset; + bufPtr->st_ctime = fpb.ioFlCrDat - TclpGetGMTOffset() + + tcl_mac_epoch_offset; + } + } + + if (err != noErr) { + errno = TclMacOSErrorToPosixError(err); + } + + return (err == noErr ? 0 : -1); } /* @@ -822,251 +1036,6 @@ TclMacChmod( return 0; } -int -TclpObjStat(pathPtr, bufPtr) - Tcl_Obj *pathPtr; - struct stat *bufPtr; -{ - HFileInfo fpb; - HVolumeParam vpb; - OSErr err; - FSSpec fileSpec; - Boolean isDirectory; - long dirID; - - err = FspLocationFromFsPath(pathPtr, &fileSpec); - - if (err != noErr) { - errno = TclMacOSErrorToPosixError(err); - return -1; - } - - /* - * Fill the fpb & vpb struct up with info about file or directory. - */ - - FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); - vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum; - vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name; - if (isDirectory) { - fpb.ioDirID = fileSpec.parID; - } else { - fpb.ioDirID = dirID; - } - - fpb.ioFDirIndex = 0; - err = PBGetCatInfoSync((CInfoPBPtr)&fpb); - if (err == noErr) { - vpb.ioVolIndex = 0; - err = PBHGetVInfoSync((HParmBlkPtr)&vpb); - if (err == noErr && bufPtr != NULL) { - /* - * Files are always readable by everyone. - */ - - bufPtr->st_mode = S_IRUSR | S_IRGRP | S_IROTH; - - /* - * Use the Volume Info & File Info to fill out stat buf. - */ - if (fpb.ioFlAttrib & 0x10) { - bufPtr->st_mode |= S_IFDIR; - bufPtr->st_nlink = 2; - } else { - bufPtr->st_nlink = 1; - if (fpb.ioFlFndrInfo.fdFlags & 0x8000) { - bufPtr->st_mode |= S_IFLNK; - } else { - bufPtr->st_mode |= S_IFREG; - } - } - if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) { - /* - * Directories and applications are executable by everyone. - */ - - bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH; - } - if ((fpb.ioFlAttrib & 0x01) == 0){ - /* - * If not locked, then everyone has write acces. - */ - - bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH; - } - bufPtr->st_ino = fpb.ioDirID; - bufPtr->st_dev = fpb.ioVRefNum; - bufPtr->st_uid = -1; - bufPtr->st_gid = -1; - bufPtr->st_rdev = 0; - bufPtr->st_size = fpb.ioFlLgLen; - bufPtr->st_blksize = vpb.ioVAlBlkSiz; - bufPtr->st_blocks = (bufPtr->st_size + bufPtr->st_blksize - 1) - / bufPtr->st_blksize; - - /* - * The times returned by the Mac file system are in the - * local time zone. We convert them to GMT so that the - * epoch starts from GMT. This is also consistant with - * what is returned from "clock seconds". - */ - - bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat - TclpGetGMTOffset() + tcl_mac_epoch_offset; - bufPtr->st_ctime = fpb.ioFlCrDat - TclpGetGMTOffset() + tcl_mac_epoch_offset; - } - } - - if (err != noErr) { - errno = TclMacOSErrorToPosixError(err); - } - - return (err == noErr ? 0 : -1); -} - -Tcl_Obj* -TclpObjGetCwd(interp) - Tcl_Interp *interp; -{ - Tcl_DString ds; - if (TclpGetCwd(interp, &ds) != NULL) { - Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_IncrRefCount(cwdPtr); - Tcl_DStringFree(&ds); - return cwdPtr; - } else { - return NULL; - } -} - -int -TclpObjChdir(pathPtr) - Tcl_Obj *pathPtr; -{ - FSSpec spec; - OSErr err; - Boolean isFolder; - long dirID; - - err = FspLocationFromFsPath(pathPtr, &spec); - - if (err != noErr) { - errno = ENOENT; - return -1; - } - - err = FSpGetDirectoryID(&spec, &dirID, &isFolder); - if (err != noErr) { - errno = ENOENT; - return -1; - } - - if (isFolder != true) { - errno = ENOTDIR; - return -1; - } - - err = FSpSetDefaultDir(&spec); - if (err != noErr) { - switch (err) { - case afpAccessDenied: - errno = EACCES; - break; - default: - errno = ENOENT; - } - return -1; - } - - return 0; -} - -int -TclpObjAccess(pathPtr, mode) - Tcl_Obj *pathPtr; - int mode; -{ - HFileInfo fpb; - HVolumeParam vpb; - OSErr err; - FSSpec fileSpec; - Boolean isDirectory; - long dirID; - int full_mode = 0; - - err = FspLocationFromFsPath(pathPtr, &fileSpec); - - if (err != noErr) { - errno = TclMacOSErrorToPosixError(err); - return -1; - } - - /* - * Fill the fpb & vpb struct up with info about file or directory. - */ - FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory); - vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum; - vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name; - if (isDirectory) { - fpb.ioDirID = fileSpec.parID; - } else { - fpb.ioDirID = dirID; - } - - fpb.ioFDirIndex = 0; - err = PBGetCatInfoSync((CInfoPBPtr)&fpb); - if (err == noErr) { - vpb.ioVolIndex = 0; - err = PBHGetVInfoSync((HParmBlkPtr)&vpb); - if (err == noErr) { - /* - * Use the Volume Info & File Info to determine - * access information. If we have got this far - * we know the directory is searchable or the file - * exists. (We have F_OK) - */ - - /* - * Check to see if the volume is hardware or - * software locked. If so we arn't W_OK. - */ - if (mode & W_OK) { - if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) { - errno = EROFS; - return -1; - } - if (fpb.ioFlAttrib & 0x01) { - errno = EACCES; - return -1; - } - } - - /* - * Directories are always searchable and executable. But only - * files of type 'APPL' are executable. - */ - if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK) - && (fpb.ioFlFndrInfo.fdType != 'APPL')) { - return -1; - } - } - } - - if (err != noErr) { - errno = TclMacOSErrorToPosixError(err); - return -1; - } - - return 0; -} - -int -TclpObjLstat(pathPtr, buf) - Tcl_Obj *pathPtr; - struct stat *buf; -{ - return TclpObjStat(pathPtr, buf); -} - /* *---------------------------------------------------------------------- @@ -1089,7 +1058,7 @@ TclpTempFileName() { char fileName[L_tmpnam]; - if (tmpnam(fileName) == NULL) { /* INTL: Native. */ + if (tmpnam(fileName) == NULL) { /* INTL: Native. */ return NULL; } diff --git a/mac/tclMacLoad.c b/mac/tclMacLoad.c index daf87ca..fd355ae 100644 --- a/mac/tclMacLoad.c +++ b/mac/tclMacLoad.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: tclMacLoad.c,v 1.4 1999/10/15 04:47:12 jingham Exp $ + * RCS: @(#) $Id: tclMacLoad.c,v 1.5 2001/08/30 08:53:15 vincentdarley Exp $ */ #include <CodeFragments.h> @@ -99,7 +99,7 @@ typedef struct CfrgItem CfrgItem; int TclpLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ - char *fileName, /* Name of the file containing the desired + Tcl_Obj *pathPtr, /* Name of the file containing the desired * code. */ char *sym1, char *sym2, /* Names of two procedures to look up in * the file's symbol table. */ @@ -122,7 +122,6 @@ TclpLoadFile( UInt32 length = kCFragGoesToEOF; char packageName[255]; Str255 errName; - Tcl_DString ds; char *native; /* @@ -134,9 +133,8 @@ TclpLoadFile( Tcl_UtfToLower(packageName); *(Tcl_UtfAtIndex(packageName, Tcl_NumUtfChars(packageName, -1) - 5)) = 0; - native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); + native = Tcl_FSGetNativePath(pathPtr); err = FSpLocationFromPath(strlen(native), native, &fileSpec); - Tcl_DStringFree(&ds); if (err != noErr) { Tcl_SetResult(interp, "could not locate shared library", TCL_STATIC); @@ -199,8 +197,9 @@ TclpLoadFile( kLoadCFrag, &connID, &dummy, errName); if (err != fragNoErr) { p2cstr(errName); - Tcl_AppendResult(interp, "couldn't load file \"", fileName, - "\": ", errName, (char *) NULL); + Tcl_AppendResult(interp, "couldn't load file \"", + Tcl_GetString(pathPtr), + "\": ", errName, (char *) NULL); return TCL_ERROR; } diff --git a/mac/tclMacPort.h b/mac/tclMacPort.h index 1336f87..142a570 100644 --- a/mac/tclMacPort.h +++ b/mac/tclMacPort.h @@ -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: tclMacPort.h,v 1.12 2001/07/31 19:12:07 vincentdarley Exp $ + * RCS: @(#) $Id: tclMacPort.h,v 1.13 2001/08/30 08:53:15 vincentdarley Exp $ */ @@ -248,14 +248,6 @@ extern char **environ; #define TclSetSystemEnv(a,b) #define tzset() -/* - * The following defines replace the Macintosh version of the POSIX - * functions "stat" and "access". The various compilier vendors - * don't implement this function well nor consistantly. - */ -/* int TclpStat(const char *path, struct stat *bufPtr); */ -int TclpLstat(const char *path, struct stat *bufPtr); - char *TclpFindExecutable(const char *argv0); int TclpFindVariable(CONST char *name, int *lengthPtr); diff --git a/mac/tclMacShLib.exp b/mac/tclMacShLib.exp index 020380f..8ada490 100644 --- a/mac/tclMacShLib.exp +++ b/mac/tclMacShLib.exp @@ -197,7 +197,6 @@ SetIsStationery SetNameLocked Share StrToAddr -TclAccess TclAllocateFreeObjects TclChdir TclCleanupByteCode @@ -303,7 +302,6 @@ TclIsProc TclLoadFile TclLooksLikeInt TclLookupVar -TclpAccess TclMacCreateEnv TclMacExitHandler TclMacFOpenHack @@ -313,7 +311,6 @@ TclMacOSErrorToPosixError TclMacReadlink TclMacRemoveTimer TclMacStartTimer -TclpStat TclMacTimerExpired TclMatchFiles TclNeedSpace @@ -338,7 +335,6 @@ TclSetEnv TclSetIndexedScalar TclSetupEnv TclSockGetPort -TclStat TclTeardownNamespace TclTestChannelCmd TclTestChannelEventCmd diff --git a/tests/fileName.test b/tests/fileName.test index a1a0011..5545cb1 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -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: fileName.test,v 1.12 2001/08/23 17:37:08 vincentdarley Exp $ +# RCS: @(#) $Id: fileName.test,v 1.13 2001/08/30 08:53:15 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -304,6 +304,26 @@ test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo/bar~/baz } {foo bar~ baz} +test filename-4.19 {Tcl_SplitPath} { + set oldDir [pwd] + set res [catch { + file mkdir tildetmp + set nastydir [file join tildetmp ./~tilde] + file mkdir $nastydir + set norm [file normalize $nastydir] + cd tildetmp + cd ./~tilde + glob -nocomplain * + set idx [string first tildetmp $norm] + set norm [string range $norm $idx end] + # fix path away so all platforms are the same + regsub -all ":" $norm "/" norm + file delete -force $nastydir + set norm + } err] + cd $oldDir + list $res $err +} {0 tildetmp/~tilde} test filename-5.1 {Tcl_SplitPath: mac} {testsetplatform} { testsetplatform mac @@ -1367,6 +1387,20 @@ test filename-11.43 {Tcl_GlobCmd} { test filename-11.44 {Tcl_GlobCmd} { list [catch {glob -tails -path hello -directory hello *} msg] $msg } {1 {"-directory" cannot be used with "-path"}} +test filename-11.45 {Tcl_GlobCmd on root volume} { + set res1 "" + set res2 "" + catch { + set res1 [glob -dir [lindex [file volumes] 0] -tails *] + } + catch { + set tmpd [pwd] + cd [lindex [file volumes] 0] + set res2 [glob *] + cd $tmpd + } + expr {$res1 == $res2} +} {1} file rename $horribleglobname globTest set globname globTest diff --git a/tests/winFCmd.test b/tests/winFCmd.test index b26f385..1e63666 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -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: winFCmd.test,v 1.10 2001/07/31 19:12:07 vincentdarley Exp $ +# RCS: @(#) $Id: winFCmd.test,v 1.11 2001/08/30 08:53:15 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -529,7 +529,7 @@ test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {pcOnly} { test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {pcOnly} { cleanup file mkdir td1/td2 - list [catch {testfile rmdir td1} msg] $msg + list [catch {testfile rmdir td1} msg] [file tail $msg] } {1 {td1 EEXIST}} test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {pcOnly} { # can't test this w/o removing everything on your hard disk first! @@ -537,7 +537,7 @@ test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {pcOnly} { } {} test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} { cleanup - list [catch {testfile rmdir td1} msg] $msg + list [catch {testfile rmdir td1} msg] [file tail $msg] } {1 {td1 ENOENT}} test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} { cleanup @@ -546,7 +546,7 @@ test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} { test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {pcOnly} { cleanup createfile tf1 - list [catch {testfile rmdir tf1} msg] $msg + list [catch {testfile rmdir tf1} msg] [file tail $msg] } {1 {tf1 ENOTDIR}} test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {pcOnly} { cleanup @@ -557,7 +557,7 @@ test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {pcOnly} { test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {pcOnly} { cleanup createfile tf1 - list [catch {testfile rmdir tf1} msg] $msg + list [catch {testfile rmdir tf1} msg] [file tail $msg] } {1 {tf1 ENOTDIR}} test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {pcOnly} { cleanup @@ -573,7 +573,7 @@ test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {95} { test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {nt} { cleanup list [catch {testfile rmdir /} msg] $msg -} {1 {\ EACCES}} +} {1 {/ EACCES}} test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {95} { cleanup createfile tf1 @@ -594,7 +594,7 @@ test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {95} { test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {pcOnly} { cleanup file mkdir td1/td2 - list [catch {testfile rmdir td1} msg] $msg + list [catch {testfile rmdir td1} msg] [file tail $msg] } {1 {td1 EEXIST}} test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {pcOnly} { cleanup @@ -688,12 +688,12 @@ test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {95} { cleanup file mkdir td1 list [catch {testfile cpdir td1 /} msg] $msg -} {1 {\ EEXIST}} +} {1 {/ EEXIST}} test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {nt} { cleanup file mkdir td1 list [catch {testfile cpdir td1 /} msg] $msg -} {1 {\ EACCES}} +} {1 {/ EACCES}} test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {pcOnly} { cleanup file mkdir td1 diff --git a/unix/tclLoadAout.c b/unix/tclLoadAout.c index da85d16..51e38b3 100644 --- a/unix/tclLoadAout.c +++ b/unix/tclLoadAout.c @@ -14,7 +14,7 @@ * and Design Engineering (MADE) Initiative through ARPA contract * F33615-94-C-4400. * - * RCS: @(#) $Id: tclLoadAout.c,v 1.4 2000/03/27 18:34:32 ericm Exp $ + * RCS: @(#) $Id: tclLoadAout.c,v 1.5 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -136,9 +136,9 @@ static void UnlinkSymbolTable _ANSI_ARGS_((void)); */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code (UTF-8). */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -189,13 +189,13 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1); #endif Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1); - TclGuessPackageName(fileName, &linkCommandBuf); + TclGuessPackageName(Tcl_GetString(pathPtr), &linkCommandBuf); Tcl_DStringAppend (&linkCommandBuf, " -A ", -1); Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1); Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1); - Tcl_DStringAppend (&linkCommandBuf, fileName, -1); + Tcl_DStringAppend (&linkCommandBuf, Tcl_GetString(pathPtr), -1); Tcl_DStringAppend (&linkCommandBuf, " ", -1); - if (FindLibraries (interp, fileName, &linkCommandBuf) != TCL_OK) { + if (FindLibraries (interp, Tcl_GetString(pathPtr), &linkCommandBuf) != TCL_OK) { Tcl_DStringFree (&linkCommandBuf); return TCL_ERROR; } diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 2a868d8..bfe52e9 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.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: tclLoadDl.c,v 1.3 1999/04/16 00:48:04 stanton Exp $ + * RCS: @(#) $Id: tclLoadDl.c,v 1.4 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -57,9 +57,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -74,15 +74,15 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_DString newName, ds; char *native; - native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); + native = Tcl_FSGetNativePath(pathPtr); handle = dlopen(native, RTLD_NOW | RTLD_GLOBAL); /* INTL: Native. */ - Tcl_DStringFree(&ds); *clientDataPtr = (ClientData) handle; if (handle == NULL) { - Tcl_AppendResult(interp, "couldn't load file \"", fileName, - "\": ", dlerror(), (char *) NULL); + Tcl_AppendResult(interp, "couldn't load file \"", + Tcl_GetString(pathPtr), + "\": ", dlerror(), (char *) NULL); return TCL_ERROR; } diff --git a/unix/tclLoadDld.c b/unix/tclLoadDld.c index 1f9e702..2b15148 100644 --- a/unix/tclLoadDld.c +++ b/unix/tclLoadDld.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadDld.c,v 1.3 1999/04/16 00:48:04 stanton Exp $ + * RCS: @(#) $Id: tclLoadDld.c,v 1.4 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -49,9 +49,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -64,7 +64,8 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) { static int firstTime = 1; int returnCode; - + char *fileName = Tcl_GetString(pathPtr); + /* * The dld package needs to know the pathname to the tcl binary. * If that's not know, return an error. @@ -87,9 +88,10 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) firstTime = 0; } - if ((returnCode = dld_link(fileName)) != 0) { - Tcl_AppendResult(interp, "couldn't load file \"", fileName, - "\": ", dld_strerror(returnCode), (char *) NULL); + if ((returnCode = dld_link(Tcl_GetString(pathPtr)) != 0) { + Tcl_AppendResult(interp, "couldn't load file \"", + Tcl_GetString(pathPtr), + "\": ", dld_strerror(returnCode), (char *) NULL); return TCL_ERROR; } *proc1Ptr = (Tcl_PackageInitProc *) dld_get_func(sym1); diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 9acaaa5..58eb5a5 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadDyld.c,v 1.2 2000/04/25 17:55:45 hobbs Exp $ + * RCS: @(#) $Id: tclLoadDyld.c,v 1.3 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -40,9 +40,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -59,6 +59,7 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) NSSymbol symbol; char *name; + char *fileName = Tcl_GetString(pathPtr); err = NSCreateObjectFileImageFromFile(fileName, &image); if (err != NSObjectFileImageSuccess) { switch (err) { diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index f29c996..f460524 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.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: tclLoadNext.c,v 1.3 1999/04/16 00:48:04 stanton Exp $ + * RCS: @(#) $Id: tclLoadNext.c,v 1.4 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -39,9 +39,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -57,7 +57,8 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) int len, maxlen; char *files[]={fileName,NULL}; NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE); - + char *fileName = Tcl_GetString(pathPtr); + if(!rld_load(errorStream,&header,files,NULL)) { NXGetMemoryBuffer(errorStream,&data,&len,&maxlen); Tcl_AppendResult(interp,"couldn't load file \"",fileName,"\": ",data,NULL); diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 9e8b3ad..cd6a393 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -31,7 +31,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoadOSF.c,v 1.3 1999/04/16 00:48:04 stanton Exp $ + * RCS: @(#) $Id: tclLoadOSF.c,v 1.4 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" @@ -60,9 +60,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -75,7 +75,8 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) { ldr_module_t lm; char *pkg; - + char *fileName = Tcl_GetString(pathPtr); + lm = (Tcl_PackageInitProc *) load(fileName, LDR_NOFLAGS); if (lm == LDR_NULL_MODULE) { Tcl_AppendResult(interp, "couldn't load file \"", fileName, diff --git a/unix/tclLoadShl.c b/unix/tclLoadShl.c index 0623986..0d7c648 100644 --- a/unix/tclLoadShl.c +++ b/unix/tclLoadShl.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: tclLoadShl.c,v 1.4 2001/04/09 23:09:58 kennykb Exp $ + * RCS: @(#) $Id: tclLoadShl.c,v 1.5 2001/08/30 08:53:15 vincentdarley Exp $ */ #include <dl.h> @@ -47,9 +47,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -62,7 +62,8 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) { shl_t handle; Tcl_DString newName; - + char *fileName = Tcl_GetString(pathPtr); + /* * The flags below used to be BIND_IMMEDIATE; they were changed at * the suggestion of Wolfgang Kechel (wolfgang@prs.de): "This diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index d31cc6c..9f31e8f 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.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: tclUnixChan.c,v 1.20 2001/06/18 13:13:23 dkf Exp $ + * RCS: @(#) $Id: tclUnixChan.c,v 1.21 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ @@ -1281,10 +1281,10 @@ TtyInit(fd, initialize) */ Tcl_Channel -TclpOpenFileChannel(interp, fileName, modeString, permissions) +TclpOpenFileChannel(interp, pathPtr, modeString, permissions) Tcl_Interp *interp; /* Interpreter for error reporting; * can be NULL. */ - char *fileName; /* Name of file to open. */ + Tcl_Obj *pathPtr; /* Name of file to open. */ char *modeString; /* A list of POSIX open modes or * a string such as "rw". */ int permissions; /* If the open involves creating a @@ -1295,7 +1295,6 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) FileState *fsPtr; char *native, *translation; char channelName[16 + TCL_INTEGER_SPACE]; - Tcl_DString ds, buffer; Tcl_ChannelType *channelTypePtr; #ifdef DEPRECATED ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -1323,19 +1322,17 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) return NULL; } - native = Tcl_TranslateFileName(interp, fileName, &buffer); + native = Tcl_FSGetNativePath(pathPtr); if (native == NULL) { return NULL; } - native = Tcl_UtfToExternalDString(NULL, native, -1, &ds); - fd = open(native, mode, permissions); /* INTL: Native. */ - Tcl_DStringFree(&ds); - Tcl_DStringFree(&buffer); + fd = open(native, mode, permissions); if (fd < 0) { if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_AppendResult(interp, "couldn't open \"", + Tcl_GetString(pathPtr), "\": ", + Tcl_PosixError(interp), (char *) NULL); } return NULL; } diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 23eeda6..264a7a6 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.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: tclUnixFCmd.c,v 1.10 2001/08/23 18:20:50 hobbs Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.11 2001/08/30 08:53:15 vincentdarley Exp $ * * Portions of this code were derived from NetBSD source code which has * the following copyright notice: @@ -150,77 +150,10 @@ static int TraverseUnixTree _ANSI_ARGS_(( Tcl_DString *sourcePtr, Tcl_DString *destPtr, Tcl_DString *errorPtr)); -int -TclpObjCreateDirectory(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjDeleteFile(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - ret = TclpCopyDirectory(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), - Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), &ds); - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjCopyFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); -} - -int -TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_Obj *pathPtr; - int recursive; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - ret = TclpRemoveDirectory(Tcl_FSGetTranslatedStringPath(NULL, pathPtr),recursive, &ds); - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjRenameFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); -} - /* *--------------------------------------------------------------------------- * - * TclpRenameFile, DoRenameFile -- + * TclpObjRenameFile, DoRenameFile -- * * Changes the name of an existing file or directory, from src to dst. * If src and dst refer to the same file or directory, does nothing @@ -252,23 +185,14 @@ TclpObjRenameFile(srcPathPtr, destPathPtr) *--------------------------------------------------------------------------- */ -int -TclpRenameFile(src, dst) - CONST char *src; /* Pathname of file or dir to be renamed - * (UTF-8). */ - CONST char *dst; /* New pathname of file or directory - * (UTF-8). */ -{ - int result; - Tcl_DString srcString, dstString; - Tcl_UtfToExternalDString(NULL, src, -1, &srcString); - Tcl_UtfToExternalDString(NULL, dst, -1, &dstString); - result = DoRenameFile(Tcl_DStringValue(&srcString), - Tcl_DStringValue(&dstString)); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; +int +TclpObjRenameFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; +{ + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -355,7 +279,7 @@ DoRenameFile(src, dst) /* *--------------------------------------------------------------------------- * - * TclpCopyFile, DoCopyFile -- + * TclpObjCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and * is not a directory, it is removed. @@ -380,20 +304,12 @@ DoRenameFile(src, dst) */ int -TclpCopyFile(src, dst) - CONST char *src; /* Pathname of file to be copied (UTF-8). */ - CONST char *dst; /* Pathname of file to copy to (UTF-8). */ +TclpObjCopyFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - Tcl_DString srcString, dstString; - - Tcl_UtfToExternalDString(NULL, src, -1, &srcString); - Tcl_UtfToExternalDString(NULL, dst, -1, &dstString); - result = DoCopyFile(Tcl_DStringValue(&srcString), - Tcl_DStringValue(&dstString)); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -561,7 +477,7 @@ CopyFile(src, dst, statBufPtr) /* *--------------------------------------------------------------------------- * - * TclpDeleteFile, DoDeleteFile -- + * TclpObjDeleteFile, DoDeleteFile -- * * Removes a single file (not a directory). * @@ -580,17 +496,11 @@ CopyFile(src, dst, statBufPtr) *--------------------------------------------------------------------------- */ -int -TclpDeleteFile(path) - CONST char *path; /* Pathname of file to be removed (UTF-8). */ +int +TclpObjDeleteFile(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_UtfToExternalDString(NULL, path, -1, &pathString); - result = DoDeleteFile(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); } static int @@ -629,17 +539,11 @@ DoDeleteFile(path) *--------------------------------------------------------------------------- */ -int -TclpCreateDirectory(path) - CONST char *path; /* Pathname of directory to create (UTF-8). */ +int +TclpObjCreateDirectory(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_UtfToExternalDString(NULL, path, -1, &pathString); - result = DoCreateDirectory(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int @@ -666,7 +570,7 @@ DoCreateDirectory(path) /* *--------------------------------------------------------------------------- * - * TclpCopyDirectory -- + * TclpObjCopyDirectory -- * * Recursively copies a directory. The target directory dst must * not already exist. Note that this function does not merge two @@ -677,8 +581,8 @@ DoCreateDirectory(path) * If the directory was successfully copied, returns TCL_OK. * Otherwise the return value is TCL_ERROR, errno is set to indicate * the error, and the pathname of the file that caused the error - * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile - * for a description of possible values for errno. + * is stored in errorPtr. See TclpObjCreateDirectory and + * TclpObjCopyFile for a description of possible values for errno. * * Side effects: * An exact copy of the directory hierarchy src will be created @@ -689,27 +593,36 @@ DoCreateDirectory(path) *--------------------------------------------------------------------------- */ -int -TclpCopyDirectory(src, dst, errorPtr) - CONST char *src; /* Pathname of directory to be copied - * (UTF-8). */ - CONST char *dst; /* Pathname of target directory (UTF-8). */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; + Tcl_Obj **errorPtr; { + Tcl_DString ds; Tcl_DString srcString, dstString; - int result; + int ret; - Tcl_UtfToExternalDString(NULL, src, -1, &srcString); - Tcl_UtfToExternalDString(NULL, dst, -1, &dstString); + Tcl_UtfToExternalDString(NULL, + Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), + -1, &srcString); + Tcl_UtfToExternalDString(NULL, + Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), + -1, &dstString); - result = TraverseUnixTree(TraversalCopy, &srcString, &dstString, errorPtr); + ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); - return result; + + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; } + /* *--------------------------------------------------------------------------- @@ -737,25 +650,27 @@ TclpCopyDirectory(src, dst, errorPtr) *--------------------------------------------------------------------------- */ -int -TclpRemoveDirectory(path, recursive, errorPtr) - CONST char *path; /* Pathname of directory to be removed - * (UTF-8). */ - int recursive; /* If non-zero, removes directories that - * are nonempty. Otherwise, will only remove - * empty directories. */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) + Tcl_Obj *pathPtr; + int recursive; + Tcl_Obj **errorPtr; { - int result; + Tcl_DString ds; Tcl_DString pathString; + int ret; - Tcl_UtfToExternalDString(NULL, path, -1, &pathString); - result = DoRemoveDirectory(&pathString, recursive, errorPtr); + Tcl_UtfToExternalDString(NULL, Tcl_FSGetTranslatedStringPath(NULL, pathPtr), + -1, &pathString); + ret = DoRemoveDirectory(&pathString, recursive, &ds); Tcl_DStringFree(&pathString); - return result; + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; } static int @@ -1696,24 +1611,34 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) Tcl_Obj *pathPtr; int nextCheckpoint; { + char *currentPathEndPosition; char *path = Tcl_GetString(pathPtr); - + + currentPathEndPosition = path + nextCheckpoint; + while (1) { - char cur = path[nextCheckpoint]; - if (cur == 0) { - break; - } - if (cur == '/') { - int access; - path[nextCheckpoint] = 0; - access = TclpAccess(path, F_OK); - path[nextCheckpoint] = '/'; - if (access != 0) { + char cur = *currentPathEndPosition; + if (cur == '/' || cur == 0) { + /* Reached directory separator, or end of string */ + Tcl_DString ds; + char *nativePath; + int accessOk; + + nativePath = Tcl_UtfToExternalDString(NULL, path, + currentPathEndPosition - path, &ds); + accessOk = access(nativePath, F_OK); + Tcl_DStringFree(&ds); + if (accessOk != 0) { /* File doesn't exist */ break; } + if (cur == 0) { + break; + } } - nextCheckpoint++; + currentPathEndPosition++; } + nextCheckpoint = currentPathEndPosition - path; + /* We should really now convert this to a canonical path */ return nextCheckpoint; } diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index bbfebf1..befa699 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -9,14 +9,12 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFile.c,v 1.11 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.12 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclInt.h" #include "tclPort.h" -char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *bufferPtr)); - /* *--------------------------------------------------------------------------- @@ -208,6 +206,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_DString ds; struct stat statBuf; int matchHidden; + int nativeDirLen; int result = TCL_OK; Tcl_DString dsOrig; Tcl_Obj *fileNamePtr; @@ -241,12 +240,6 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) } } - if ((TclpStat(dirName, &statBuf) != 0) /* INTL: UTF-8. */ - || !S_ISDIR(statBuf.st_mode)) { - Tcl_DStringFree(&dsOrig); - return TCL_OK; - } - /* * Check to see if the pattern needs to compare with hidden files. */ @@ -263,11 +256,19 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) */ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds); + + if ((stat(native, &statBuf) != 0) /* INTL: UTF-8. */ + || !S_ISDIR(statBuf.st_mode)) { + Tcl_DStringFree(&dsOrig); + Tcl_DStringFree(&ds); + return TCL_OK; + } + d = opendir(native); /* INTL: Native. */ - Tcl_DStringFree(&ds); if (d == NULL) { char savedChar = '\0'; Tcl_ResetResult(interp); + Tcl_DStringFree(&ds); /* * Strip off a trailing '/' if necessary, before reporting the error. @@ -289,7 +290,10 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) return TCL_ERROR; } + nativeDirLen = Tcl_DStringLength(&ds); + while (1) { + Tcl_DString utfDs; char *utf; struct dirent *entryPtr; @@ -319,7 +323,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) * and pattern. If so, add the file to the result. */ - utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &ds); + utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs); if (Tcl_StringMatch(utf, pattern) != 0) { int typeOk = 1; @@ -328,15 +332,23 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) fname = Tcl_DStringValue(&dsOrig); if (types != NULL) { struct stat buf; - + char *nativeEntry; + Tcl_DStringSetLength(&ds, nativeDirLen); + Tcl_DStringAppend(&ds, entryPtr->d_name, -1); + nativeEntry = Tcl_DStringValue(&ds); + /* + * The native name of the file is in entryPtr->d_name. + * We can use this below. + */ + if (types->perm != 0) { - if (TclpStat(fname, &buf) != 0) { + if (stat(nativeEntry, &buf) != 0) { /* * Either the file has disappeared between the - * 'readdir' call and the 'TclpStat' call, or + * 'readdir' call and the 'stat' call, or * the file is a link to a file which doesn't * exist (which we could ascertain with - * TclpLstat), or there is some other strange + * lstat), or there is some other strange * problem. In all these cases, we define this * to mean the file does not match any defined * permission, and therefore it is not @@ -353,11 +365,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) ((types->perm & TCL_GLOB_PERM_RONLY) && (buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) || ((types->perm & TCL_GLOB_PERM_R) && - (TclpAccess(fname, R_OK) != 0)) || + (access(entryPtr->d_name, R_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_W) && - (TclpAccess(fname, W_OK) != 0)) || + (access(entryPtr->d_name, W_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_X) && - (TclpAccess(fname, X_OK) != 0)) + (access(entryPtr->d_name, X_OK) != 0)) )) { typeOk = 0; } @@ -365,7 +377,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if (typeOk && (types->type != 0)) { if (types->perm == 0) { /* We haven't yet done a stat on the file */ - if (TclpStat(fname, &buf) != 0) { + if (stat(nativeEntry, &buf) != 0) { /* Posix error occurred */ typeOk = 0; } @@ -395,7 +407,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) typeOk = 0; #ifdef S_ISLNK if (types->type & TCL_GLOB_TYPE_LINK) { - if (TclpLstat(fname, &buf) == 0) { + if (lstat(nativeEntry, &buf) == 0) { if (S_ISLNK(buf.st_mode)) { typeOk = 1; } @@ -411,10 +423,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig))); } } - Tcl_DStringFree(&ds); + Tcl_DStringFree(&utfDs); } closedir(d); + Tcl_DStringFree(&ds); Tcl_DStringFree(&dsOrig); return result; } @@ -466,7 +479,7 @@ TclpGetUserHome(name, bufferPtr) /* *--------------------------------------------------------------------------- * - * TclpAccess -- + * TclpObjAccess -- * * This function replaces the library version of access(). * @@ -479,26 +492,23 @@ TclpGetUserHome(name, bufferPtr) *--------------------------------------------------------------------------- */ -int -TclpAccess(path, mode) - CONST char *path; /* Path of file to access (UTF-8). */ - int mode; /* Permission setting. */ +int +TclpObjAccess(pathPtr, mode) + Tcl_Obj *pathPtr; /* Path of file to access */ + int mode; /* Permission setting. */ { - int result; - Tcl_DString ds; - char *native; - - native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); - result = access(native, mode); /* INTL: Native. */ - Tcl_DStringFree(&ds); - - return result; + char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return access(path, mode); + } } /* *--------------------------------------------------------------------------- * - * TclpChdir -- + * TclpObjChdir -- * * This function replaces the library version of chdir(). * @@ -511,25 +521,22 @@ TclpAccess(path, mode) *--------------------------------------------------------------------------- */ -int -TclpChdir(dirName) - CONST char *dirName; /* Path to new working directory (UTF-8). */ +int +TclpObjChdir(pathPtr) + Tcl_Obj *pathPtr; /* Path to new working directory */ { - int result; - Tcl_DString ds; - char *native; - - native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds); - result = chdir(native); /* INTL: Native. */ - Tcl_DStringFree(&ds); - - return result; + char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return chdir(path); + } } /* *---------------------------------------------------------------------- * - * TclpLstat -- + * TclpObjLstat -- * * This function replaces the library version of lstat(). * @@ -542,26 +549,23 @@ TclpChdir(dirName) *---------------------------------------------------------------------- */ -int -TclpLstat(path, bufPtr) - CONST char *path; /* Path of file to stat (UTF-8). */ +int +TclpObjLstat(pathPtr, bufPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ struct stat *bufPtr; /* Filled with results of stat call. */ { - int result; - Tcl_DString ds; - char *native; - - native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); - result = lstat(native, bufPtr); /* INTL: Native. */ - Tcl_DStringFree(&ds); - - return result; + char *path = Tcl_FSGetNativePath(pathPtr); + if (path == NULL) { + return -1; + } else { + return lstat(path, bufPtr); + } } /* *--------------------------------------------------------------------------- * - * TclpGetCwd -- + * TclpObjGetCwd -- * * This function replaces the library version of getcwd(). * @@ -579,6 +583,22 @@ TclpLstat(path, bufPtr) *---------------------------------------------------------------------- */ +Tcl_Obj* +TclpObjGetCwd(interp) + Tcl_Interp *interp; +{ + Tcl_DString ds; + if (TclpGetCwd(interp, &ds) != NULL) { + Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(cwdPtr); + Tcl_DStringFree(&ds); + return cwdPtr; + } else { + return NULL; + } +} + +/* Older string based version */ char * TclpGetCwd(interp, bufferPtr) Tcl_Interp *interp; /* If non-NULL, used for error reporting. */ @@ -648,7 +668,7 @@ TclpReadlink(path, linkPtr) /* *---------------------------------------------------------------------- * - * TclpStat -- + * TclpObjStat -- * * This function replaces the library version of stat(). * @@ -661,87 +681,19 @@ TclpReadlink(path, linkPtr) *---------------------------------------------------------------------- */ -int -TclpStat(path, bufPtr) - CONST char *path; /* Path of file to stat (in UTF-8). */ - struct stat *bufPtr; /* Filled with results of stat call. */ -{ - int result; - Tcl_DString ds; - char *native; - - native = Tcl_UtfToExternalDString(NULL, path, -1, &ds); - result = stat(native, bufPtr); /* INTL: Native. */ - Tcl_DStringFree(&ds); - - return result; -} - -int -TclpObjLstat(pathPtr, buf) - Tcl_Obj *pathPtr; - struct stat *buf; -{ - char *path = Tcl_FSGetNativePath(pathPtr); - if (path == NULL) { - return -1; - } else { - return lstat(path, buf); - } -} - int -TclpObjStat(pathPtr, buf) - Tcl_Obj *pathPtr; - struct stat *buf; -{ - char *path = Tcl_FSGetNativePath(pathPtr); - if (path == NULL) { - return -1; - } else { - return stat(path, buf); - } -} - -Tcl_Obj* -TclpObjGetCwd(interp) - Tcl_Interp *interp; -{ - Tcl_DString ds; - if (TclpGetCwd(interp, &ds) != NULL) { - Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_IncrRefCount(cwdPtr); - Tcl_DStringFree(&ds); - return cwdPtr; - } else { - return NULL; - } -} - -int -TclpObjChdir(pathPtr) - Tcl_Obj *pathPtr; -{ - char *path = Tcl_FSGetNativePath(pathPtr); - if (path == NULL) { - return -1; - } else { - return chdir(path); - } -} - -int -TclpObjAccess(pathPtr, mode) - Tcl_Obj *pathPtr; - int mode; +TclpObjStat(pathPtr, bufPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ + struct stat *bufPtr; /* Filled with results of stat call. */ { char *path = Tcl_FSGetNativePath(pathPtr); if (path == NULL) { return -1; } else { - return access(path, mode); + return stat(path, bufPtr); } } + #ifdef S_IFLNK diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index 1e7985d..4ca092a 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -19,7 +19,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixPort.h,v 1.17 2001/06/17 03:48:19 dgp Exp $ + * RCS: @(#) $Id: tclUnixPort.h,v 1.18 2001/08/30 08:53:15 vincentdarley Exp $ */ #ifndef _TCLUNIXPORT @@ -484,15 +484,6 @@ extern double strtod(); #define TclpExit exit -#ifdef TclpStat -#undef TclpStat -#endif - -EXTERN int TclpLstat _ANSI_ARGS_((CONST char *path, - struct stat *buf)); -EXTERN int TclpStat _ANSI_ARGS_((CONST char *path, - struct stat *buf)); - /* * Platform specific mutex definition used by memory allocators. * These mutexes are statically allocated and explicitly initialized. diff --git a/win/tclWinChan.c b/win/tclWinChan.c index be6ffe0..51d418a 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.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: tclWinChan.c,v 1.13 2000/10/06 23:46:06 davidg Exp $ + * RCS: @(#) $Id: tclWinChan.c,v 1.14 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -653,10 +653,10 @@ FileGetHandleProc(instanceData, direction, handlePtr) */ Tcl_Channel -TclpOpenFileChannel(interp, fileName, modeString, permissions) +TclpOpenFileChannel(interp, pathPtr, modeString, permissions) Tcl_Interp *interp; /* Interpreter for error reporting; * can be NULL. */ - char *fileName; /* Name of file to open. */ + Tcl_Obj *pathPtr; /* Name of file to open. */ char *modeString; /* A list of POSIX open modes or * a string such as "rw". */ int permissions; /* If the open involves creating a @@ -667,7 +667,6 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) int seekFlag, mode, channelPermissions; DWORD accessMode, createMode, shareMode, flags, consoleParams, type; TCHAR *nativeName; - Tcl_DString ds, buffer; DCB dcb; HANDLE handle; char channelName[16 + TCL_INTEGER_SPACE]; @@ -679,12 +678,11 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) return NULL; } - if (Tcl_TranslateFileName(interp, fileName, &ds) == NULL) { + nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr); + if (nativeName == NULL) { return NULL; } - nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds), &buffer); - + switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { case O_RDONLY: accessMode = GENERIC_READ; @@ -766,10 +764,10 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) } TclWinConvertError(err); if (interp != (Tcl_Interp *) NULL) { - Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ", + Tcl_AppendResult(interp, "couldn't open \"", + Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), (char *) NULL); } - Tcl_DStringFree(&buffer); return NULL; } @@ -828,14 +826,12 @@ TclpOpenFileChannel(interp, fileName, modeString, permissions) */ channel = NULL; - Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ", - "bad file type", (char *) NULL); + Tcl_AppendResult(interp, "couldn't open \"", + Tcl_GetString(pathPtr), "\": ", + "bad file type", (char *) NULL); break; } - Tcl_DStringFree(&buffer); - Tcl_DStringFree(&ds); - if (channel != NULL) { if (seekFlag) { if (Tcl_Seek(channel, 0, SEEK_END) < 0) { diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index c21fb9e..a04fc45 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.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: tclWinFCmd.c,v 1.10 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFCmd.c,v 1.11 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -91,8 +91,8 @@ static int ConvertFileNameFormat(Tcl_Interp *interp, static int DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr); static int DoCreateDirectory(CONST TCHAR *pathPtr); static int DoDeleteFile(CONST TCHAR *pathPtr); -static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, int recursive, - Tcl_DString *errorPtr); +static int DoRemoveJustDirectory(CONST TCHAR *nativeSrc, + int recursive, Tcl_DString *errorPtr); static int DoRemoveDirectory(Tcl_DString *pathPtr, int recursive, Tcl_DString *errorPtr); static int DoRenameFile(CONST TCHAR *nativeSrc, CONST TCHAR *dstPtr); @@ -105,85 +105,10 @@ static int TraverseWinTree(TraversalProc *traverseProc, Tcl_DString *errorPtr); -int -TclpObjCreateDirectory(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjDeleteFile(pathPtr) - Tcl_Obj *pathPtr; -{ - return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); -} - -int -TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - ret = TclpCopyDirectory(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), - Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), &ds); - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjCopyFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); -} - -int -TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) - Tcl_Obj *pathPtr; - int recursive; - Tcl_Obj **errorPtr; -{ - Tcl_DString ds; - int ret; - if (recursive) { - /* - * In the recursive case, the string rep is used to construct a Tcl_DString - * which may be used extensively, so we can't optimize this case easily. - */ - ret = TclpRemoveDirectory(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), - recursive, &ds); - } else { - ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), recursive, &ds); - } - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); - Tcl_IncrRefCount(*errorPtr); - } - return ret; -} - -int -TclpObjRenameFile(srcPathPtr, destPathPtr) - Tcl_Obj *srcPathPtr; - Tcl_Obj *destPathPtr; -{ - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), Tcl_FSGetNativePath(destPathPtr)); -} - /* *--------------------------------------------------------------------------- * - * TclpRenameFile, DoRenameFile -- + * TclpObjRenameFile, DoRenameFile -- * * Changes the name of an existing file or directory, from src to dst. * If src and dst refer to the same file or directory, does nothing @@ -222,25 +147,13 @@ TclpObjRenameFile(srcPathPtr, destPathPtr) *--------------------------------------------------------------------------- */ -int -TclpRenameFile( - CONST char *src, /* Pathname of file or dir to be renamed - * (UTF-8). */ - CONST char *dst) /* New pathname of file or directory - * (UTF-8). */ +int +TclpObjRenameFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - TCHAR *nativeSrc; - TCHAR *nativeDest; - Tcl_DString srcString, dstString; - - nativeSrc = Tcl_WinUtfToTChar(src, -1, &srcString); - nativeDest = Tcl_WinUtfToTChar(dst, -1, &dstString); - - result = DoRenameFile(nativeSrc, nativeDest); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -481,7 +394,7 @@ DoRenameFile( /* *--------------------------------------------------------------------------- * - * TclpCopyFile, DoCopyFile -- + * TclpObjCopyFile, DoCopyFile -- * * Copy a single file (not a directory). If dst already exists and * is not a directory, it is removed. @@ -506,20 +419,12 @@ DoRenameFile( */ int -TclpCopyFile( - CONST char *src, /* Pathname of file to be copied (UTF-8). */ - CONST char *dst) /* Pathname of file to copy to (UTF-8). */ +TclpObjCopyFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { - int result; - Tcl_DString srcString, dstString; - - Tcl_WinUtfToTChar(src, -1, &srcString); - Tcl_WinUtfToTChar(dst, -1, &dstString); - result = DoCopyFile(Tcl_DStringValue(&srcString), - Tcl_DStringValue(&dstString)); - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - return result; + return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -532,6 +437,16 @@ DoCopyFile( * block device. */ + /* + * If 'nativeDst' is NULL, the following code can lock the process + * up, at least under Windows2000. Therefore we have to bail at + * that point. + */ + if (nativeDst == NULL) { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + __try { if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; @@ -578,7 +493,7 @@ DoCopyFile( /* *--------------------------------------------------------------------------- * - * TclpDeleteFile, DoDeleteFile -- + * TclpObjDeleteFile, DoDeleteFile -- * * Removes a single file (not a directory). * @@ -600,17 +515,11 @@ DoCopyFile( *--------------------------------------------------------------------------- */ -int -TclpDeleteFile( - CONST char *path) /* Pathname of file to be removed (UTF-8). */ +int +TclpObjDeleteFile(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoDeleteFile(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoDeleteFile(Tcl_FSGetNativePath(pathPtr)); } static int @@ -629,6 +538,11 @@ DoDeleteFile( * instead of ENOENT. */ + if (nativePath == NULL) { + Tcl_SetErrno(ENOENT); + return TCL_ERROR; + } + if (tclWinProcs->useWide) { if (((WCHAR *) nativePath)[0] == '\0') { Tcl_SetErrno(ENOENT); @@ -687,7 +601,7 @@ DoDeleteFile( /* *--------------------------------------------------------------------------- * - * TclpCreateDirectory -- + * TclpObjCreateDirectory -- * * Creates the specified directory. All parent directories of the * specified directory must already exist. The directory is @@ -709,17 +623,11 @@ DoDeleteFile( *--------------------------------------------------------------------------- */ -int -TclpCreateDirectory( - CONST char *path) /* Pathname of directory to create (UTF-8). */ +int +TclpObjCreateDirectory(pathPtr) + Tcl_Obj *pathPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoCreateDirectory(Tcl_DStringValue(&pathString)); - Tcl_DStringFree(&pathString); - return result; + return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int @@ -738,7 +646,7 @@ DoCreateDirectory( /* *--------------------------------------------------------------------------- * - * TclpCopyDirectory -- + * TclpObjCopyDirectory -- * * Recursively copies a directory. The target directory dst must * not already exist. Note that this function does not merge two @@ -761,32 +669,38 @@ DoCreateDirectory( *--------------------------------------------------------------------------- */ -int -TclpCopyDirectory( - CONST char *src, /* Pathname of directory to be copied - * (UTF-8). */ - CONST char *dst, /* Pathname of target directory (UTF-8). */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; + Tcl_Obj **errorPtr; { - int result; + Tcl_DString ds; Tcl_DString srcString, dstString; + int ret; - Tcl_WinUtfToTChar(src, -1, &srcString); - Tcl_WinUtfToTChar(dst, -1, &dstString); + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,srcPathPtr), + -1, &srcString); + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL,destPathPtr), + -1, &dstString); - result = TraverseWinTree(TraversalCopy, &srcString, &dstString, errorPtr); + ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds); Tcl_DStringFree(&srcString); Tcl_DStringFree(&dstString); - return result; + + if (ret != TCL_OK) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_DStringFree(&ds); + Tcl_IncrRefCount(*errorPtr); + } + return ret; } /* *---------------------------------------------------------------------- * - * TclpRemoveDirectory, DoRemoveDirectory -- + * TclpObjRemoveDirectory, DoRemoveDirectory -- * * Removes directory (and its contents, if the recursive flag is set). * @@ -812,25 +726,38 @@ TclpCopyDirectory( *---------------------------------------------------------------------- */ -int -TclpRemoveDirectory( - CONST char *path, /* Pathname of directory to be removed - * (UTF-8). */ - int recursive, /* If non-zero, removes directories that - * are nonempty. Otherwise, will only remove - * empty directories. */ - Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ +int +TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) + Tcl_Obj *pathPtr; + int recursive; + Tcl_Obj **errorPtr; { - int result; - Tcl_DString pathString; - - Tcl_WinUtfToTChar(path, -1, &pathString); - result = DoRemoveDirectory(&pathString, recursive, errorPtr); - Tcl_DStringFree(&pathString); - - return result; + Tcl_DString ds; + int ret; + if (recursive) { + /* + * In the recursive case, the string rep is used to construct a + * Tcl_DString which may be used extensively, so we can't + * optimize this case easily. + */ + Tcl_DString native; + Tcl_WinUtfToTChar(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), + -1, &native); + ret = DoRemoveDirectory(&native, recursive, &ds); + Tcl_DStringFree(&native); + } else { + ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), + recursive, &ds); + } + if (ret != TCL_OK) { + int len = Tcl_DStringLength(&ds); + if (len > 0) { + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(*errorPtr); + } + Tcl_DStringFree(&ds); + } + return ret; } static int @@ -856,7 +783,11 @@ DoRemoveJustDirectory( * instead of ENOENT. */ - + if (nativePath == NULL) { + Tcl_SetErrno(ENOENT); + goto end; + } + if (tclWinProcs->useWide) { if (((WCHAR *) nativePath)[0] == '\0') { Tcl_SetErrno(ENOENT); @@ -974,7 +905,8 @@ DoRemoveDirectory( * DString filled with UTF-8 name of file * causing error. */ { - int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, errorPtr); + int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive, + errorPtr); if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) { /* @@ -1410,10 +1342,12 @@ ConvertFileNameFormat( splitPath = Tcl_FSSplitPath(fileName, &pathc); if (splitPath == NULL || pathc == 0) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + if (interp != NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not read \"", Tcl_GetString(fileName), "\": no such file or directory", (char *) NULL); + } result = TCL_ERROR; goto cleanup; } @@ -1480,7 +1414,9 @@ ConvertFileNameFormat( if (handle == INVALID_HANDLE_VALUE) { Tcl_DStringFree(&ds); - StatError(interp, fileName); + if (interp != NULL) { + StatError(interp, fileName); + } result = TCL_ERROR; goto cleanup; } @@ -1522,8 +1458,15 @@ ConvertFileNameFormat( Tcl_DStringInit(&dsTemp); Tcl_WinTCharToUtf(nativeName, -1, &dsTemp); - tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), - Tcl_DStringLength(&dsTemp)); + /* Deal with issues of tildes being absolute */ + if (Tcl_DStringValue(&dsTemp)[0] == '~') { + tempPath = Tcl_NewStringObj("./",2); + Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); + } else { + tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp), + Tcl_DStringLength(&dsTemp)); + } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); Tcl_DStringFree(&ds); Tcl_DStringFree(&dsTemp); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index d74fb78..c62b9ac 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinFile.c,v 1.12 2001/08/23 17:37:08 vincentdarley Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.13 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -30,6 +30,10 @@ typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); +static int NativeAccess(TCHAR *path, int mode); +static int NativeStat(TCHAR *path, struct stat *statPtr); +static int NativeIsExec(TCHAR *path); + /* *--------------------------------------------------------------------------- @@ -266,8 +270,9 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) found = (*tclWinProcs->findNextFileProc)(handle, &data)) { TCHAR *nativeMatchResult; char *name, *fname; + int typeOk = 1; - + if (tclWinProcs->useWide) { nativeName = (TCHAR *) data.w.cFileName; } else { @@ -316,7 +321,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) fname = Tcl_DStringValue(&dsOrig); nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(&dsOrig), &ds); - + /* * 'attr' represents the attributes of the file, but we only * want to retrieve this info if it is absolutely necessary @@ -347,16 +352,17 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) typeOk = 0; } } + if (typeOk == 1 && types->perm != 0) { if ( ((types->perm & TCL_GLOB_PERM_RONLY) && !(attr & FILE_ATTRIBUTE_READONLY)) || ((types->perm & TCL_GLOB_PERM_R) && - (TclpAccess(fname, R_OK) != 0)) || + (NativeAccess(nativeName, R_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_W) && - (TclpAccess(fname, W_OK) != 0)) || + (NativeAccess(nativeName, W_OK) != 0)) || ((types->perm & TCL_GLOB_PERM_X) && - (TclpAccess(fname, X_OK) != 0)) + (NativeAccess(nativeName, X_OK) != 0)) ) { typeOk = 0; } @@ -364,7 +370,7 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) if (typeOk && types->type != 0) { if (types->perm == 0) { /* We haven't yet done a stat on the file */ - if (TclpStat(fname, &buf) != 0) { + if (NativeStat(nativeName, &buf) != 0) { /* Posix error occurred */ typeOk = 0; } @@ -394,7 +400,11 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types) typeOk = 0; #ifdef S_ISLNK if (types->type & TCL_GLOB_TYPE_LINK) { - if (TclpLstat(fname, &buf) == 0) { + /* + * We should use 'lstat' but it is the + * same as 'stat' on windows. + */ + if (NativeStat(nativeName, &buf) == 0) { if (S_ISLNK(buf.st_mode)) { typeOk = 1; } @@ -563,7 +573,7 @@ TclpGetUserHome(name, bufferPtr) /* *--------------------------------------------------------------------------- * - * TclpAccess -- + * NativeAccess -- * * This function replaces the library version of access(), fixing the * following bugs: @@ -579,18 +589,14 @@ TclpGetUserHome(name, bufferPtr) *--------------------------------------------------------------------------- */ -int -TclpAccess( - CONST char *path, /* Path of file to access (UTF-8). */ +static int +NativeAccess( + TCHAR *nativePath, /* Path of file to access (UTF-8). */ int mode) /* Permission setting. */ { - Tcl_DString ds; - TCHAR *nativePath; DWORD attr; - nativePath = Tcl_WinUtfToTChar(path, -1, &ds); attr = (*tclWinProcs->getFileAttributesProc)(nativePath); - Tcl_DStringFree(&ds); if (attr == 0xffffffff) { /* @@ -611,8 +617,6 @@ TclpAccess( } if (mode & X_OK) { - CONST char *p; - if (attr & FILE_ATTRIBUTE_DIRECTORY) { /* * Directories are always executable. @@ -620,18 +624,8 @@ TclpAccess( return 0; } - p = strrchr(path, '.'); - if (p != NULL) { - p++; - if ((stricmp(p, "exe") == 0) - || (stricmp(p, "com") == 0) - || (stricmp(p, "bat") == 0)) { - /* - * File that ends with .exe, .com, or .bat is executable. - */ - - return 0; - } + if (NativeIsExec(nativePath)) { + return 0; } Tcl_SetErrno(EACCES); return -1; @@ -640,10 +634,47 @@ TclpAccess( return 0; } +static int +NativeIsExec(nativePath) + TCHAR *nativePath; +{ + CONST char *p; + char *path; + Tcl_DString ds; + + /* + * This is really not efficient. We should be able to examine + * the native path directly without converting to UTF. + */ + Tcl_DStringInit(&ds); + path = Tcl_WinTCharToUtf(nativePath, -1, &ds); + + p = strrchr(path, '.'); + if (p != NULL) { + p++; + /* + * Note: in the old code, stat considered '.pif' files as + * executable, whereas access did not. + */ + if ((stricmp(p, "exe") == 0) + || (stricmp(p, "com") == 0) + || (stricmp(p, "bat") == 0)) { + /* + * File that ends with .exe, .com, or .bat is executable. + */ + + Tcl_DStringFree(&ds); + return 1; + } + } + Tcl_DStringFree(&ds); + return 0; +} + /* *---------------------------------------------------------------------- * - * TclpChdir -- + * TclpObjChdir -- * * This function replaces the library version of chdir(). * @@ -656,17 +687,15 @@ TclpAccess( *---------------------------------------------------------------------- */ -int -TclpChdir(path) - CONST char *path; /* Path to new working directory (UTF-8). */ +int +TclpObjChdir(pathPtr) + Tcl_Obj *pathPtr; /* Path to new working directory. */ { int result; - Tcl_DString ds; TCHAR *nativePath; - nativePath = Tcl_WinUtfToTChar(path, -1, &ds); + nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); - Tcl_DStringFree(&ds); if (result == 0) { TclWinConvertError(GetLastError()); @@ -796,10 +825,30 @@ TclpGetCwd(interp, bufferPtr) return Tcl_DStringValue(bufferPtr); } +int +TclpObjStat(pathPtr, statPtr) + Tcl_Obj *pathPtr; /* Path of file to stat */ + struct stat *statPtr; /* Filled with results of stat call. */ +{ + Tcl_Obj *transPtr; + /* + * Eliminate file names containing wildcard characters, or subsequent + * call to FindFirstFile() will expand them, matching some other file. + */ + + transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); + if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) { + Tcl_SetErrno(ENOENT); + return -1; + } + + return NativeStat((TCHAR*) Tcl_FSGetNativePath(pathPtr), statPtr); +} + /* *---------------------------------------------------------------------- * - * TclpObjStat -- + * NativeStat -- * * This function replaces the library version of stat(), fixing * the following bugs: @@ -819,34 +868,20 @@ TclpGetCwd(interp, bufferPtr) *---------------------------------------------------------------------- */ -int -TclpObjStat(pathPtr, statPtr) - Tcl_Obj *pathPtr; /* Path of file to stat */ +static int +NativeStat(nativePath, statPtr) + TCHAR *nativePath; /* Path of file to stat */ struct stat *statPtr; /* Filled with results of stat call. */ { Tcl_DString ds; - TCHAR *nativePath; WIN32_FIND_DATAT data; HANDLE handle; DWORD attr; WCHAR nativeFullPath[MAX_PATH]; TCHAR *nativePart; - char *p, *fullPath; + char *fullPath; int dev, mode; - Tcl_Obj *transPtr; - - /* - * Eliminate file names containing wildcard characters, or subsequent - * call to FindFirstFile() will expand them, matching some other file. - */ - transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - if (transPtr == NULL || (strpbrk(Tcl_GetString(transPtr), "?*") != NULL)) { - Tcl_SetErrno(ENOENT); - return -1; - } - - nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); if (handle == INVALID_HANDLE_VALUE) { /* @@ -918,14 +953,8 @@ TclpObjStat(pathPtr, statPtr) attr = data.a.dwFileAttributes; mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE; - p = strrchr(Tcl_GetString(transPtr), '.'); - if (p != NULL) { - if ((lstrcmpiA(p, ".exe") == 0) - || (lstrcmpiA(p, ".com") == 0) - || (lstrcmpiA(p, ".bat") == 0) - || (lstrcmpiA(p, ".pif") == 0)) { - mode |= S_IEXEC; - } + if (NativeIsExec(nativePath)) { + mode |= S_IEXEC; } /* @@ -1096,85 +1125,18 @@ TclpObjGetCwd(interp) } int -TclpObjChdir(pathPtr) - Tcl_Obj *pathPtr; -{ - int result; - TCHAR *nativePath; - - nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); - result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); - - if (result == 0) { - TclWinConvertError(GetLastError()); - return -1; - } - return 0; -} - -int TclpObjAccess(pathPtr, mode) Tcl_Obj *pathPtr; int mode; { - TCHAR *nativePath; - DWORD attr; - - nativePath = (TCHAR *) Tcl_FSGetNativePath(pathPtr); - attr = (*tclWinProcs->getFileAttributesProc)(nativePath); - - if (attr == 0xffffffff) { - /* - * File doesn't exist. - */ - - TclWinConvertError(GetLastError()); - return -1; - } - - if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { - /* - * File is not writable. - */ - - Tcl_SetErrno(EACCES); - return -1; - } - - if (mode & X_OK) { - CONST char *p; - - if (attr & FILE_ATTRIBUTE_DIRECTORY) { - /* - * Directories are always executable. - */ - - return 0; - } - p = strrchr(Tcl_FSGetTranslatedStringPath(NULL, pathPtr), '.'); - if (p != NULL) { - p++; - if ((stricmp(p, "exe") == 0) - || (stricmp(p, "com") == 0) - || (stricmp(p, "bat") == 0)) { - /* - * File that ends with .exe, .com, or .bat is executable. - */ - - return 0; - } - } - Tcl_SetErrno(EACCES); - return -1; - } - - return 0; + return NativeAccess((TCHAR*) Tcl_FSGetNativePath(pathPtr), mode); } int TclpObjLstat(pathPtr, buf) Tcl_Obj *pathPtr; - struct stat *buf; { + struct stat *buf; +{ return TclpObjStat(pathPtr,buf); } @@ -1201,17 +1163,3 @@ TclpObjLink(pathPtr, toPtr) } #endif - -/* Obsolete, only called from test suite */ -int -TclpStat(path, statPtr) - CONST char *path; /* Path of file to stat (UTF-8). */ - struct stat *statPtr; /* Filled with results of stat call. */ -{ - int retVal; - Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1); - Tcl_IncrRefCount(pathPtr); - retVal = TclpObjStat(pathPtr, statPtr); - Tcl_DecrRefCount(pathPtr); - return retVal; -} diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 8afbefe..c0923d5 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.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: tclWinLoad.c,v 1.6 2000/09/06 22:37:24 hobbs Exp $ + * RCS: @(#) $Id: tclWinLoad.c,v 1.7 2001/08/30 08:53:15 vincentdarley Exp $ */ #include "tclWinInt.h" @@ -36,9 +36,9 @@ */ int -TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) +TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *fileName; /* Name of the file containing the desired + Tcl_Obj *pathPtr; /* Name of the file containing the desired * code. */ char *sym1, *sym2; /* Names of two procedures to look up in * the file's symbol table. */ @@ -53,6 +53,7 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) TCHAR *nativeName; Tcl_DString ds; + char *fileName = Tcl_GetString(pathPtr); nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds); handle = (*tclWinProcs->loadLibraryProc)(nativeName); Tcl_DStringFree(&ds); diff --git a/win/tclWinPort.h b/win/tclWinPort.h index aa85de4..e7b5533 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -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: tclWinPort.h,v 1.18 2001/08/02 20:15:40 mdejong Exp $ + * RCS: @(#) $Id: tclWinPort.h,v 1.19 2001/08/30 08:53:15 vincentdarley Exp $ */ #ifndef _TCLWINPORT @@ -420,7 +420,6 @@ typedef float *TCHAR; */ #define TclpExit exit -#define TclpLstat TclpStat /* * Declarations for Windows-only functions. |