Tcl Source Code

Artifact [12ae08637a]
Login

Artifact 12ae08637a483ace2adc246a678d366ad77fa3fc:

Attachment "fs.patch" to ticket [2994165fff] added by nijtmans 2010-04-29 20:18:57.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.174
diff -u -r1.174 tcl.decls
--- generic/tcl.decls	2 Apr 2010 23:11:55 -0000	1.174
+++ generic/tcl.decls	29 Apr 2010 12:07:57 -0000
@@ -1671,7 +1671,7 @@
 	    ClientData clientData)
 }
 declare 469 generic {
-    const char *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
+    const char *TclFSGetNativePath(Tcl_Obj *pathPtr)
 }
 declare 470 generic {
     Tcl_Obj *Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr)
@@ -2319,6 +2319,10 @@
     int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr)
 }
 
+declare 630 generic {
+    const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
+}
+
 # ----- BASELINE -- FOR -- 8.6.0 ----- #
 
 ##############################################################################
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.473
diff -u -r1.473 tclInt.h
--- generic/tclInt.h	28 Apr 2010 11:50:53 -0000	1.473
+++ generic/tclInt.h	29 Apr 2010 12:08:07 -0000
@@ -2985,7 +2985,7 @@
 MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr);
 MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
 			    int len);
-MODULE_SCOPE int	TclpDeleteFile(const char *path);
+MODULE_SCOPE int	TclpDeleteFile(const void *path);
 MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
 MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
 MODULE_SCOPE void	TclpFinalizePipes(void);
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.191
diff -u -r1.191 tclStubInit.c
--- generic/tclStubInit.c	26 Apr 2010 13:32:33 -0000	1.191
+++ generic/tclStubInit.c	29 Apr 2010 12:08:08 -0000
@@ -41,6 +41,17 @@
 #undef Tcl_CreateHashEntry
 #undef Tcl_Panic
 
+/* Only provided in the stub table for backwards
+ * binary compatibility.
+ */
+#define TclFSGetNativePath getnativepath
+static const char *
+getnativepath(
+    Tcl_Obj *pathPtr)
+{
+    return Tcl_FSGetNativePath(pathPtr);
+}
+
 /*
  * WARNING: The contents of this file is automatically generated by the
  * tools/genStubs.tcl script. Any modifications to the function declarations
@@ -963,7 +974,7 @@
     Tcl_FSGetTranslatedPath, /* 466 */
     Tcl_FSEvalFile, /* 467 */
     Tcl_FSNewNativePath, /* 468 */
-    Tcl_FSGetNativePath, /* 469 */
+    TclFSGetNativePath, /* 469 */
     Tcl_FSFileSystemInfo, /* 470 */
     Tcl_FSPathSeparator, /* 471 */
     Tcl_FSListVolumes, /* 472 */
@@ -1124,6 +1135,7 @@
     Tcl_LoadFile, /* 627 */
     Tcl_FindSymbol, /* 628 */
     Tcl_FSUnloadFile, /* 629 */
+    Tcl_FSGetNativePath, /* 630 */
 };
 
 /* !END!: Do not edit above this line. */
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.176
diff -u -r1.176 tclIOUtil.c
--- generic/tclIOUtil.c	27 Apr 2010 08:20:00 -0000	1.176
+++ generic/tclIOUtil.c	29 Apr 2010 12:08:04 -0000
@@ -4564,7 +4564,7 @@
  *---------------------------------------------------------------------------
  */
 
-const char *
+const void *
 Tcl_FSGetNativePath(
     Tcl_Obj *pathPtr)
 {
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.176
diff -u -r1.176 tclDecls.h
--- generic/tclDecls.h	2 Apr 2010 23:11:55 -0000	1.176
+++ generic/tclDecls.h	29 Apr 2010 12:08:02 -0000
@@ -2765,10 +2765,10 @@
 				const Tcl_Filesystem *fromFilesystem,
 				ClientData clientData);
 #endif
-#ifndef Tcl_FSGetNativePath_TCL_DECLARED
-#define Tcl_FSGetNativePath_TCL_DECLARED
+#ifndef TclFSGetNativePath_TCL_DECLARED
+#define TclFSGetNativePath_TCL_DECLARED
 /* 469 */
-EXTERN const char *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
+EXTERN const char *	TclFSGetNativePath(Tcl_Obj *pathPtr);
 #endif
 #ifndef Tcl_FSFileSystemInfo_TCL_DECLARED
 #define Tcl_FSFileSystemInfo_TCL_DECLARED
@@ -3703,6 +3703,11 @@
 EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
 				Tcl_LoadHandle handlePtr);
 #endif
+#ifndef Tcl_FSGetNativePath_TCL_DECLARED
+#define Tcl_FSGetNativePath_TCL_DECLARED
+/* 630 */
+EXTERN const void *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
+#endif
 
 typedef struct TclStubHooks {
     const struct TclPlatStubs *tclPlatStubs;
@@ -4207,7 +4212,7 @@
     Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */
     int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */
     Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */
-    const char * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
+    const char * (*tclFSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
     Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */
     Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */
     Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */
@@ -4368,6 +4373,7 @@
     int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
     void* (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
     int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
+    const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 630 */
 } TclStubs;
 
 #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
@@ -6274,9 +6280,9 @@
 #define Tcl_FSNewNativePath \
 	(tclStubsPtr->tcl_FSNewNativePath) /* 468 */
 #endif
-#ifndef Tcl_FSGetNativePath
-#define Tcl_FSGetNativePath \
-	(tclStubsPtr->tcl_FSGetNativePath) /* 469 */
+#ifndef TclFSGetNativePath
+#define TclFSGetNativePath \
+	(tclStubsPtr->tclFSGetNativePath) /* 469 */
 #endif
 #ifndef Tcl_FSFileSystemInfo
 #define Tcl_FSFileSystemInfo \
@@ -6918,6 +6924,10 @@
 #define Tcl_FSUnloadFile \
 	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
 #endif
+#ifndef Tcl_FSGetNativePath
+#define Tcl_FSGetNativePath \
+	(tclStubsPtr->tcl_FSGetNativePath) /* 630 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
Index: doc/FileSystem.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/FileSystem.3,v
retrieving revision 1.71
diff -u -r1.71 FileSystem.3
--- doc/FileSystem.3	4 Apr 2010 15:03:07 -0000	1.71
+++ doc/FileSystem.3	29 Apr 2010 12:07:56 -0000
@@ -139,7 +139,7 @@
 Tcl_Obj *
 \fBTcl_FSNewNativePath\fR(\fIfsPtr, clientData\fR)
 .sp
-const char *
+const void *
 \fBTcl_FSGetNativePath\fR(\fIpathPtr\fR)
 .sp
 Tcl_Obj *
@@ -742,14 +742,13 @@
 \fBTcl_FSGetNativePath\fR is for use by the Win/Unix native
 filesystems, so that they can easily retrieve the native (char* or
 TCHAR*) representation of a path. This function is a convenience
-wrapper around \fBTcl_FSGetInternalRep\fR, and assumes the native
-representation is string-based. It may be desirable in the future to
-have non-string-based native representations (for example, on MacOSX, a
-representation using a fileSpec of FSRef structure would probably be
-more efficient). On Windows a full Unicode representation would allow
-for paths of unlimited length. Currently the representation is simply a
-character string which may contain either the relative path or a
-complete, absolute normalized path in the native encoding (complex
+wrapper around \fBTcl_FSGetInternalRep\fR. It may be desirable in the
+future to have non-string-based native representations (for example,
+on MacOSX, a representation using a fileSpec of FSRef structure would
+probably be more efficient). On Windows a full Unicode representation
+would allow for paths of unlimited length. Currently the representation
+is simply a character string which may contain either the relative path
+or a complete, absolute normalized path in the native encoding (complex
 conditions dictate which of these will be provided, so neither can be
 relied upon, unless the path is known to be absolute). If you need a
 native path which must be absolute, then you should ask for the native
Index: win/tclWinFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinFCmd.c,v
retrieving revision 1.62
diff -u -r1.62 tclWinFCmd.c
--- win/tclWinFCmd.c	22 Apr 2010 11:40:32 -0000	1.62
+++ win/tclWinFCmd.c	29 Apr 2010 12:08:10 -0000
@@ -766,34 +766,35 @@
 
 int
 TclpDeleteFile(
-    const TCHAR *nativePath)	/* Pathname of file to be removed (native). */
+    const void *nativePath)	/* Pathname of file to be removed (native). */
 {
     DWORD attr;
+    const TCHAR *path = nativePath;
 
     /*
      * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and
      * "". Avoid passing these values.
      */
 
-    if (nativePath == NULL || nativePath[0] == '\0') {
+    if (path == NULL || path[0] == '\0') {
 	Tcl_SetErrno(ENOENT);
 	return TCL_ERROR;
     }
 
-    if (tclWinProcs->deleteFileProc(nativePath) != FALSE) {
+    if (tclWinProcs->deleteFileProc(path) != FALSE) {
 	return TCL_OK;
     }
     TclWinConvertError(GetLastError());
 
     if (Tcl_GetErrno() == EACCES) {
-	attr = tclWinProcs->getFileAttributesProc(nativePath);
+	attr = tclWinProcs->getFileAttributesProc(path);
 	if (attr != 0xffffffff) {
 	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
 		if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
 		    /*
 		     * It is a symbolic link - remove it.
 		     */
-		    if (TclWinSymLinkDelete(nativePath, 0) == 0) {
+		    if (TclWinSymLinkDelete(path, 0) == 0) {
 			return TCL_OK;
 		    }
 		}
@@ -807,21 +808,21 @@
 
 		Tcl_SetErrno(EISDIR);
 	    } else if (attr & FILE_ATTRIBUTE_READONLY) {
-		int res = tclWinProcs->setFileAttributesProc(nativePath,
+		int res = tclWinProcs->setFileAttributesProc(path,
 			attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
 
 		if ((res != 0) &&
-			(tclWinProcs->deleteFileProc(nativePath) != FALSE)) {
+			(tclWinProcs->deleteFileProc(path) != FALSE)) {
 		    return TCL_OK;
 		}
 		TclWinConvertError(GetLastError());
 		if (res != 0) {
-		    tclWinProcs->setFileAttributesProc(nativePath, attr);
+		    tclWinProcs->setFileAttributesProc(path, attr);
 		}
 	    }
 	}
     } else if (Tcl_GetErrno() == ENOENT) {
-	attr = tclWinProcs->getFileAttributesProc(nativePath);
+	attr = tclWinProcs->getFileAttributesProc(path);
 	if (attr != 0xffffffff) {
 	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
 		/*
Index: unix/tclUnixFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFCmd.c,v
retrieving revision 1.76
diff -u -r1.76 tclUnixFCmd.c
--- unix/tclUnixFCmd.c	25 Mar 2010 14:53:35 -0000	1.76
+++ unix/tclUnixFCmd.c	29 Apr 2010 12:08:09 -0000
@@ -636,9 +636,9 @@
 
 int
 TclpDeleteFile(
-    const char *path)		/* Pathname of file to be removed (native). */
+    const void *path)		/* Pathname of file to be removed (native). */
 {
-    if (unlink(path) != 0) {				/* INTL: Native. */
+    if (unlink((const char *)path) != 0) {
 	return TCL_ERROR;
     }
     return TCL_OK;