Attachment "fsObsRemove4.patch" to
ticket [455021ffff]
added by
vincentdarley
2001-08-30 01:22:32.
? tests/tildetmp
? win/httpd
? win/testfile
? win/_tcl_test_remove_me.txt
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.543
diff -u -r1.543 ChangeLog
--- ChangeLog 2001/08/27 02:14:08 1.543
+++ ChangeLog 2001/08/29 18:21:22
@@ -8,6 +8,52 @@
the directory name $DISTNAME into which distributions built
by 'make test' unpack. [Bug 455642]
+2001-08-25 Vince Darley <[email protected]>
+
+ 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. Fixed bad error
+ return values in three cases on Win2000. 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-24 Jeff Hobbs <[email protected]>
* tests/stringComp.test: added string-1.3
Index: doc/FileSystem.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/FileSystem.3,v
retrieving revision 1.3
diff -u -r1.3 FileSystem.3
--- doc/FileSystem.3 2001/08/23 17:37:07 1.3
+++ doc/FileSystem.3 2001/08/29 18:21:22
@@ -10,7 +10,7 @@
.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 @@
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 @@
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
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.52
diff -u -r1.52 tcl.decls
--- generic/tcl.decls 2001/08/23 17:37:07 1.52
+++ generic/tcl.decls 2001/08/29 18:21:22
@@ -468,6 +468,7 @@
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 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 @@
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 @@
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 @@
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)
}
Index: generic/tclFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFCmd.c,v
retrieving revision 1.10
diff -u -r1.10 tclFCmd.c
--- generic/tclFCmd.c 2001/08/23 17:37:07 1.10
+++ generic/tclFCmd.c 2001/08/29 18:21:23
@@ -544,8 +544,8 @@
/*
* 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.
*/
}
Index: generic/tclFileName.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFileName.c,v
retrieving revision 1.18
diff -u -r1.18 tclFileName.c
--- generic/tclFileName.c 2001/08/23 18:20:50 1.18
+++ generic/tclFileName.c 2001/08/29 18:21:23
@@ -1110,7 +1110,7 @@
* 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 @@
*
* 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 @@
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);
}
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.16
diff -u -r1.16 tclIOUtil.c
--- generic/tclIOUtil.c 2001/08/23 18:20:50 1.16
+++ generic/tclIOUtil.c 2001/08/29 18:21:24
@@ -71,29 +71,11 @@
/*
* 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 @@
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 @@
* 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_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 @@
&NativeFilesystemSeparator,
&TclpObjStat,
&TclpObjAccess,
- &NativeOpenFileChannel,
+ &TclpOpenFileChannel,
&TclpMatchInDirectory,
&NativeUtime,
#ifndef S_IFLNK
@@ -364,7 +336,7 @@
&TclpObjCopyFile,
&TclpObjRenameFile,
&TclpObjCopyDirectory,
- &NativeLoadFile,
+ &TclpLoadFile,
&TclpUnloadFile,
&TclpObjGetCwd,
&TclpObjChdir
@@ -1602,19 +1574,33 @@
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 @@
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,7 +2642,20 @@
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
* which is also relative (or empty). There's nothing
@@ -2664,9 +2666,7 @@
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 @@
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 @@
* 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 @@
* 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 @@
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.
@@ -4302,27 +4302,6 @@
#else
return utime(Tcl_GetString(Tcl_FSGetNormalizedPath(NULL,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 */
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.29
diff -u -r1.29 tclInt.decls
--- generic/tclInt.decls 2001/07/31 19:12:06 1.29
+++ generic/tclInt.decls 2001/08/29 18:21:24
@@ -23,9 +23,10 @@
# 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)
}
@@ -267,10 +268,11 @@
}
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)
}
@@ -301,14 +303,16 @@
}
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)
}
@@ -361,10 +365,11 @@
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 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 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 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)
}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.59
diff -u -r1.59 tclInt.h
--- generic/tclInt.h 2001/08/23 17:37:08 1.59
+++ generic/tclInt.h 2001/08/29 18:21:24
@@ -1772,12 +1772,7 @@
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));
@@ -1804,7 +1799,11 @@
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));
@@ -1832,14 +1831,12 @@
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));
@@ -1848,10 +1845,6 @@
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));
Index: generic/tclIntDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntDecls.h,v
retrieving revision 1.25
diff -u -r1.25 tclIntDecls.h
--- generic/tclIntDecls.h 2001/07/31 19:12:06 1.25
+++ generic/tclIntDecls.h 2001/08/29 18:21:25
@@ -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 @@
/* 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 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 @@
/* 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,
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 @@
/* 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 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 @@
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 @@
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 @@
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 @@
#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 @@
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 @@
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 @@
* Inline function declarations:
*/
-#ifndef TclAccess
-#define TclAccess \
- (tclIntStubsPtr->tclAccess) /* 0 */
-#endif
+/* Slot 0 is reserved */
#ifndef TclAccessDeleteProc
#define TclAccessDeleteProc \
(tclIntStubsPtr->tclAccessDeleteProc) /* 1 */
@@ -992,11 +953,8 @@
#ifndef TclOpenFileChannelInsertProc
#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 @@
#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 */
@@ -1067,11 +1019,8 @@
#ifndef TclProcInterpProc
#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 @@
(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 @@
#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
+#ifndef TclpGetCwd
+#define TclpGetCwd \
+ (tclIntStubsPtr->tclpGetCwd) /* 141 */
#endif
-/* Slot 141 is reserved */
#ifndef TclSetByteCodeFromAny
#define TclSetByteCodeFromAny \
(tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */
@@ -1335,33 +1281,9 @@
#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) */
Index: generic/tclLoadNone.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLoadNone.c,v
retrieving revision 1.4
diff -u -r1.4 tclLoadNone.c
--- generic/tclLoadNone.c 1999/05/07 20:07:40 1.4
+++ generic/tclLoadNone.c 2001/08/29 18:21:25
@@ -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. */
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.55
diff -u -r1.55 tclStubInit.c
--- generic/tclStubInit.c 2001/08/23 17:37:08 1.55
+++ generic/tclStubInit.c 2001/08/29 18:21:25
@@ -47,7 +47,7 @@
TclIntStubs tclIntStubs = {
TCL_STUB_MAGIC,
NULL,
- TclAccess, /* 0 */
+ NULL, /* 0 */
TclAccessDeleteProc, /* 1 */
TclAccessInsertProc, /* 2 */
TclAllocateFreeObjects, /* 3 */
@@ -131,7 +131,7 @@
TclObjInvokeGlobal, /* 65 */
TclOpenFileChannelDeleteProc, /* 66 */
TclOpenFileChannelInsertProc, /* 67 */
- TclpAccess, /* 68 */
+ NULL, /* 68 */
TclpAlloc, /* 69 */
NULL, /* 70 */
NULL, /* 71 */
@@ -142,8 +142,8 @@
TclpGetSeconds, /* 76 */
TclpGetTime, /* 77 */
TclpGetTimeZone, /* 78 */
- TclpListVolumes, /* 79 */
- TclpOpenFileChannel, /* 80 */
+ NULL, /* 79 */
+ NULL, /* 80 */
TclpRealloc, /* 81 */
NULL, /* 82 */
NULL, /* 83 */
@@ -158,7 +158,7 @@
TclProcCompileProc, /* 92 */
TclProcDeleteProc, /* 93 */
TclProcInterpProc, /* 94 */
- TclpStat, /* 95 */
+ NULL, /* 95 */
TclRenameCommand, /* 96 */
TclResetShadowedCmdRefs, /* 97 */
TclServiceIdle, /* 98 */
@@ -184,7 +184,7 @@
#ifdef MAC_TCL
NULL, /* 104 */
#endif /* MAC_TCL */
- TclStat, /* 105 */
+ NULL, /* 105 */
TclStatDeleteProc, /* 106 */
TclStatInsertProc, /* 107 */
TclTeardownNamespace, /* 108 */
@@ -218,9 +218,9 @@
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 @@
NULL, /* 160 */
TclChannelTransform, /* 161 */
TclChannelEventScriptInvoker, /* 162 */
- TclFileCopyCmd, /* 163 */
- TclFileRenameCmd, /* 164 */
- TclFileDeleteCmd, /* 165 */
- TclFileMakeDirsCmd, /* 166 */
- TclFileAttrsCmd, /* 167 */
- TclpTempFileName, /* 168 */
- TclpSetInitialEncodings, /* 169 */
+ TclpSetInitialEncodings, /* 163 */
};
TclIntPlatStubs tclIntPlatStubs = {
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.27
diff -u -r1.27 tclTest.c
--- generic/tclTest.c 2001/08/23 17:37:08 1.27
+++ generic/tclTest.c 2001/08/29 18:21:30
@@ -167,6 +167,8 @@
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 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 @@
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 @@
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 @@
(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 @@
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 @@
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 @@
}
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 @@
}
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 @@
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 @@
}
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 @@
}
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 @@
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 @@
}
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 @@
}
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 @@
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 @@
* 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 @@
* 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 @@
* 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);
}
}
Index: mac/tclMacChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacChan.c,v
retrieving revision 1.6
diff -u -r1.6 tclMacChan.c
--- mac/tclMacChan.c 1999/04/16 00:47:19 1.6
+++ mac/tclMacChan.c 2001/08/29 18:21:30
@@ -753,7 +753,7 @@
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 @@
Tcl_Channel chan;
int mode;
char *native;
- Tcl_DString ds, buffer;
int errorCode;
mode = GetOpenMode(interp, modeString);
@@ -771,20 +770,18 @@
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;
}
Index: mac/tclMacFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacFCmd.c,v
retrieving revision 1.9
diff -u -r1.9 tclMacFCmd.c
--- mac/tclMacFCmd.c 2001/08/23 17:37:08 1.9
+++ mac/tclMacFCmd.c 2001/08/29 18:21:32
@@ -98,77 +98,10 @@
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 @@
*---------------------------------------------------------------------------
*/
-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 @@
/*
*---------------------------------------------------------------------------
*
- * 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 @@
*/
int
-TclpCopyFile(
- CONST char *src, /* Pathname of file to be copied (UTF-8). */
- CONST char *dst) /* Pathname of file to copy to (UTF-8). */
-{
- 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;
+TclpObjCopyFile(srcPathPtr, destPathPtr)
+ Tcl_Obj *srcPathPtr;
+ Tcl_Obj *destPathPtr;
+{
+ return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+ Tcl_FSGetNativePath(destPathPtr));
}
static int
@@ -564,7 +479,7 @@
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -583,17 +498,11 @@
*---------------------------------------------------------------------------
*/
-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 @@
/*
*---------------------------------------------------------------------------
*
- * 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 @@
*---------------------------------------------------------------------------
*/
-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 @@
/*
*---------------------------------------------------------------------------
*
- * 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 @@
*---------------------------------------------------------------------------
*/
-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 @@
/*
*---------------------------------------------------------------------------
*
- * TclpRemoveDirectory, DoRemoveDirectory --
+ * TclpObjRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
@@ -923,26 +823,21 @@
*---------------------------------------------------------------------------
*/
-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 @@
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 @@
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;
}
- 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];
- }
+ } 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];
+ }
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);
}
Index: mac/tclMacFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacFile.c,v
retrieving revision 1.11
diff -u -r1.11 tclMacFile.c
--- mac/tclMacFile.c 2001/08/23 17:37:08 1.11
+++ mac/tclMacFile.c 2001/08/29 18:21:32
@@ -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 @@
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 @@
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 @@
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 @@
}
} else {
struct stat buf;
-
+
if (pb.hFileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
/* If invisible */
if ((types->perm == 0) ||
@@ -260,11 +272,11 @@
((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 @@
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 @@
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 @@
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 @@
/*
*----------------------------------------------------------------------
*
- * TclpAccess --
+ * TclpObjAccess --
*
* This function replaces the library version of access().
*
@@ -354,23 +370,89 @@
*----------------------------------------------------------------------
*/
-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 @@
*
* 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 @@
*----------------------------------------------------------------------
*/
+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 @@
/*
*----------------------------------------------------------------------
*
- * 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 @@
*----------------------------------------------------------------------
*/
-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 @@
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 @@
{
char fileName[L_tmpnam];
- if (tmpnam(fileName) == NULL) { /* INTL: Native. */
+ if (tmpnam(fileName) == NULL) { /* INTL: Native. */
return NULL;
}
Index: mac/tclMacLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacLoad.c,v
retrieving revision 1.4
diff -u -r1.4 tclMacLoad.c
--- mac/tclMacLoad.c 1999/10/15 04:47:12 1.4
+++ mac/tclMacLoad.c 2001/08/29 18:21:32
@@ -99,7 +99,7 @@
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 @@
UInt32 length = kCFragGoesToEOF;
char packageName[255];
Str255 errName;
- Tcl_DString ds;
char *native;
/*
@@ -134,9 +133,8 @@
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 @@
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;
}
Index: mac/tclMacPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacPort.h,v
retrieving revision 1.12
diff -u -r1.12 tclMacPort.h
--- mac/tclMacPort.h 2001/07/31 19:12:07 1.12
+++ mac/tclMacPort.h 2001/08/29 18:21:32
@@ -248,14 +248,6 @@
#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);
Index: mac/tclMacShLib.exp
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacShLib.exp,v
retrieving revision 1.3
diff -u -r1.3 tclMacShLib.exp
--- mac/tclMacShLib.exp 1999/04/16 00:47:21 1.3
+++ mac/tclMacShLib.exp 2001/08/29 18:21:32
@@ -197,7 +197,6 @@
SetNameLocked
Share
StrToAddr
-TclAccess
TclAllocateFreeObjects
TclChdir
TclCleanupByteCode
@@ -303,7 +302,6 @@
TclLoadFile
TclLooksLikeInt
TclLookupVar
-TclpAccess
TclMacCreateEnv
TclMacExitHandler
TclMacFOpenHack
@@ -313,7 +311,6 @@
TclMacReadlink
TclMacRemoveTimer
TclMacStartTimer
-TclpStat
TclMacTimerExpired
TclMatchFiles
TclNeedSpace
@@ -338,7 +335,6 @@
TclSetIndexedScalar
TclSetupEnv
TclSockGetPort
-TclStat
TclTeardownNamespace
TclTestChannelCmd
TclTestChannelEventCmd
Index: tests/fileName.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileName.test,v
retrieving revision 1.12
diff -u -r1.12 fileName.test
--- tests/fileName.test 2001/08/23 17:37:08 1.12
+++ tests/fileName.test 2001/08/29 18:21:39
@@ -304,6 +304,26 @@
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.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
Index: tests/winFCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/winFCmd.test,v
retrieving revision 1.10
diff -u -r1.10 winFCmd.test
--- tests/winFCmd.test 2001/07/31 19:12:07 1.10
+++ tests/winFCmd.test 2001/08/29 18:21:39
@@ -529,7 +529,7 @@
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.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.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.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.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.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 @@
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
Index: unix/tclLoadAout.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadAout.c,v
retrieving revision 1.4
diff -u -r1.4 tclLoadAout.c
--- unix/tclLoadAout.c 2000/03/27 18:34:32 1.4
+++ unix/tclLoadAout.c 2001/08/29 18:21:39
@@ -136,9 +136,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 (UTF-8). */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
@@ -189,13 +189,13 @@
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;
}
Index: unix/tclLoadDl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDl.c,v
retrieving revision 1.3
diff -u -r1.3 tclLoadDl.c
--- unix/tclLoadDl.c 1999/04/16 00:48:04 1.3
+++ unix/tclLoadDl.c 2001/08/29 18:21:39
@@ -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 @@
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;
}
Index: unix/tclLoadDld.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDld.c,v
retrieving revision 1.3
diff -u -r1.3 tclLoadDld.c
--- unix/tclLoadDld.c 1999/04/16 00:48:04 1.3
+++ unix/tclLoadDld.c 2001/08/29 18:21:39
@@ -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 @@
{
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 @@
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);
Index: unix/tclLoadDyld.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDyld.c,v
retrieving revision 1.2
diff -u -r1.2 tclLoadDyld.c
--- unix/tclLoadDyld.c 2000/04/25 17:55:45 1.2
+++ unix/tclLoadDyld.c 2001/08/29 18:21:39
@@ -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 @@
NSSymbol symbol;
char *name;
+ char *fileName = Tcl_GetString(pathPtr);
err = NSCreateObjectFileImageFromFile(fileName, &image);
if (err != NSObjectFileImageSuccess) {
switch (err) {
Index: unix/tclLoadNext.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadNext.c,v
retrieving revision 1.3
diff -u -r1.3 tclLoadNext.c
--- unix/tclLoadNext.c 1999/04/16 00:48:04 1.3
+++ unix/tclLoadNext.c 2001/08/29 18:21:39
@@ -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 @@
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);
Index: unix/tclLoadOSF.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadOSF.c,v
retrieving revision 1.3
diff -u -r1.3 tclLoadOSF.c
--- unix/tclLoadOSF.c 1999/04/16 00:48:04 1.3
+++ unix/tclLoadOSF.c 2001/08/29 18:21:39
@@ -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 @@
{
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,
Index: unix/tclLoadShl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadShl.c,v
retrieving revision 1.4
diff -u -r1.4 tclLoadShl.c
--- unix/tclLoadShl.c 2001/04/09 23:09:58 1.4
+++ unix/tclLoadShl.c 2001/08/29 18:21:39
@@ -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 @@
{
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 ([email protected]): "This
Index: unix/tclUnixChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixChan.c,v
retrieving revision 1.20
diff -u -r1.20 tclUnixChan.c
--- unix/tclUnixChan.c 2001/06/18 13:13:23 1.20
+++ unix/tclUnixChan.c 2001/08/29 18:21:40
@@ -1281,10 +1281,10 @@
*/
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 @@
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 @@
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;
}
Index: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.10
diff -u -r1.10 tclUnixFCmd.c
--- unix/tclUnixFCmd.c 2001/08/23 18:20:50 1.10
+++ unix/tclUnixFCmd.c 2001/08/29 18:21:40
@@ -150,77 +150,10 @@
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 @@
*---------------------------------------------------------------------------
*/
-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 @@
/*
*---------------------------------------------------------------------------
*
- * 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 @@
*/
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 @@
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -580,17 +496,11 @@
*---------------------------------------------------------------------------
*/
-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 @@
*---------------------------------------------------------------------------
*/
-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 @@
/*
*---------------------------------------------------------------------------
*
- * 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 @@
* 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 @@
*---------------------------------------------------------------------------
*/
-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 @@
*---------------------------------------------------------------------------
*/
-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 @@
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;
}
Index: unix/tclUnixFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFile.c,v
retrieving revision 1.11
diff -u -r1.11 tclUnixFile.c
--- unix/tclUnixFile.c 2001/08/23 17:37:08 1.11
+++ unix/tclUnixFile.c 2001/08/29 18:21:40
@@ -15,8 +15,6 @@
#include "tclInt.h"
#include "tclPort.h"
-char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_DString *bufferPtr));
-
/*
*---------------------------------------------------------------------------
@@ -208,6 +206,7 @@
Tcl_DString ds;
struct stat statBuf;
int matchHidden;
+ int nativeDirLen;
int result = TCL_OK;
Tcl_DString dsOrig;
Tcl_Obj *fileNamePtr;
@@ -241,12 +240,6 @@
}
}
- 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 @@
*/
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 @@
return TCL_ERROR;
}
+ nativeDirLen = Tcl_DStringLength(&ds);
+
while (1) {
+ Tcl_DString utfDs;
char *utf;
struct dirent *entryPtr;
@@ -319,7 +323,7 @@
* 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 @@
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 @@
((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 @@
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 @@
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 @@
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 @@
/*
*---------------------------------------------------------------------------
*
- * TclpAccess --
+ * TclpObjAccess --
*
* This function replaces the library version of access().
*
@@ -479,26 +492,23 @@
*---------------------------------------------------------------------------
*/
-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 @@
*---------------------------------------------------------------------------
*/
-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 @@
*----------------------------------------------------------------------
*/
-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 @@
*----------------------------------------------------------------------
*/
+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 @@
/*
*----------------------------------------------------------------------
*
- * TclpStat --
+ * TclpObjStat --
*
* This function replaces the library version of stat().
*
@@ -661,87 +681,19 @@
*----------------------------------------------------------------------
*/
-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
Index: unix/tclUnixPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPort.h,v
retrieving revision 1.17
diff -u -r1.17 tclUnixPort.h
--- unix/tclUnixPort.h 2001/06/17 03:48:19 1.17
+++ unix/tclUnixPort.h 2001/08/29 18:21:40
@@ -484,15 +484,6 @@
#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.
Index: win/makefile.vc
===================================================================
RCS file: /cvsroot/tcl/tcl/win/makefile.vc,v
retrieving revision 1.62
diff -u -r1.62 makefile.vc
--- win/makefile.vc 2001/08/22 23:55:00 1.62
+++ win/makefile.vc 2001/08/29 18:21:40
@@ -49,12 +49,12 @@
!ELSE
# Visual Studio 5 default
-#TOOLS32 = C:\Progra~1\devstudio\vc
-#TOOLS32_rc = C:\Progra~1\devstudio\sharedide
+TOOLS32 = C:\Progra~1\devstudio\vc
+TOOLS32_rc = C:\Progra~1\devstudio\sharedide
# Visual Studio 6 default
-TOOLS32 = C:\Progra~1\Microsoft Visual Studio\VC98
-TOOLS32_rc = C:\Progra~1\Microsoft Visual Studio\common\MSDev98
+#TOOLS32 = C:\Progra~1\Microsoft Visual Studio\VC98
+#TOOLS32_rc = C:\Progra~1\Microsoft Visual Studio\common\MSDev98
cc32 = "$(TOOLS32)\bin\cl.exe"
link32 = "$(TOOLS32)\bin\link.exe"
Index: win/tclWinChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinChan.c,v
retrieving revision 1.13
diff -u -r1.13 tclWinChan.c
--- win/tclWinChan.c 2000/10/06 23:46:06 1.13
+++ win/tclWinChan.c 2001/08/29 18:21:40
@@ -653,10 +653,10 @@
*/
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 @@
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 @@
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 @@
}
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,13 +826,11 @@
*/
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) {
Index: win/tclWinFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFCmd.c,v
retrieving revision 1.10
diff -u -r1.10 tclWinFCmd.c
--- win/tclWinFCmd.c 2001/08/23 17:37:08 1.10
+++ win/tclWinFCmd.c 2001/08/29 18:21:41
@@ -91,8 +91,8 @@
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 @@
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 @@
*---------------------------------------------------------------------------
*/
-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
@@ -286,6 +199,11 @@
errno = EACCES;
return TCL_ERROR;
}
+ /* This EINVAL to EACCES conversion is required for Win2000 */
+ if (errno == EINVAL) {
+ errno = EACCES;
+ return TCL_ERROR;
+ }
if (errno == EACCES) {
decode:
if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
@@ -481,7 +399,7 @@
/*
*---------------------------------------------------------------------------
*
- * 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 +424,12 @@
*/
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 +442,16 @@
* 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;
@@ -543,6 +463,11 @@
Tcl_SetErrno(EACCES);
return TCL_ERROR;
}
+ /* This EINVAL to EACCES conversion is required for Win2000 */
+ if (Tcl_GetErrno() == EINVAL) {
+ Tcl_SetErrno(EACCES);
+ return TCL_ERROR;
+ }
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
@@ -578,7 +503,7 @@
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile, DoDeleteFile --
+ * TclpObjDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -600,17 +525,11 @@
*---------------------------------------------------------------------------
*/
-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 +548,11 @@
* 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 +611,7 @@
/*
*---------------------------------------------------------------------------
*
- * TclpCreateDirectory --
+ * TclpObjCreateDirectory --
*
* Creates the specified directory. All parent directories of the
* specified directory must already exist. The directory is
@@ -709,17 +633,11 @@
*---------------------------------------------------------------------------
*/
-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 +656,7 @@
/*
*---------------------------------------------------------------------------
*
- * TclpCopyDirectory --
+ * TclpObjCopyDirectory --
*
* Recursively copies a directory. The target directory dst must
* not already exist. Note that this function does not merge two
@@ -761,32 +679,38 @@
*---------------------------------------------------------------------------
*/
-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 +736,38 @@
*----------------------------------------------------------------------
*/
-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
@@ -855,8 +792,12 @@
* Win32s thinks that "" is the same as "." and then reports EACCES
* instead of ENOENT.
*/
-
+ if (nativePath == NULL) {
+ Tcl_SetErrno(ENOENT);
+ goto end;
+ }
+
if (tclWinProcs->useWide) {
if (((WCHAR *) nativePath)[0] == '\0') {
Tcl_SetErrno(ENOENT);
@@ -974,7 +915,8 @@
* 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 +1352,12 @@
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 +1424,9 @@
if (handle == INVALID_HANDLE_VALUE) {
Tcl_DStringFree(&ds);
- StatError(interp, fileName);
+ if (interp != NULL) {
+ StatError(interp, fileName);
+ }
result = TCL_ERROR;
goto cleanup;
}
@@ -1522,8 +1468,15 @@
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);
Index: win/tclWinFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFile.c,v
retrieving revision 1.12
diff -u -r1.12 tclWinFile.c
--- win/tclWinFile.c 2001/08/23 17:37:08 1.12
+++ win/tclWinFile.c 2001/08/29 18:21:41
@@ -30,6 +30,10 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
/*
*---------------------------------------------------------------------------
*
- * TclpAccess --
+ * NativeAccess --
*
* This function replaces the library version of access(), fixing the
* following bugs:
@@ -579,18 +589,14 @@
*---------------------------------------------------------------------------
*/
-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 @@
}
if (mode & X_OK) {
- CONST char *p;
-
if (attr & FILE_ATTRIBUTE_DIRECTORY) {
/*
* Directories are always executable.
@@ -620,18 +624,8 @@
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 @@
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 @@
*----------------------------------------------------------------------
*/
-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 @@
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 @@
*----------------------------------------------------------------------
*/
-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 @@
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 @@
}
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 @@
}
#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;
-}
Index: win/tclWinLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinLoad.c,v
retrieving revision 1.6
diff -u -r1.6 tclWinLoad.c
--- win/tclWinLoad.c 2000/09/06 22:37:24 1.6
+++ win/tclWinLoad.c 2001/08/29 18:21:41
@@ -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 @@
TCHAR *nativeName;
Tcl_DString ds;
+ char *fileName = Tcl_GetString(pathPtr);
nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
handle = (*tclWinProcs->loadLibraryProc)(nativeName);
Tcl_DStringFree(&ds);
Index: win/tclWinPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinPort.h,v
retrieving revision 1.18
diff -u -r1.18 tclWinPort.h
--- win/tclWinPort.h 2001/08/02 20:15:40 1.18
+++ win/tclWinPort.h 2001/08/29 18:21:41
@@ -420,7 +420,6 @@
*/
#define TclpExit exit
-#define TclpLstat TclpStat
/*
* Declarations for Windows-only functions.
