summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog12
-rw-r--r--doc/FileSystem.38
-rw-r--r--generic/tclFCmd.c5
-rw-r--r--generic/tclIOUtil.c35
-rw-r--r--generic/tclInt.h4
5 files changed, 39 insertions, 25 deletions
diff --git a/ChangeLog b/ChangeLog
index 4203368..426f553 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2001-09-08 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclInt.h:
+ * generic/tclFCmd.c:
+ * doc/FileSystem.3:
+ * generic/tclIOUtil.c: removed Tcl_FSCopyFile fallback
+ to channel copying, since the channels will not have
+ access to interpreters and the channel copying currently
+ requires an interp. Code which required cross-platform
+ copies always has interpreters, so that solves the problem.
+ Fixes bug in TclKit.
+
2001-09-07 David Gravereaux <davygrvy@pobox.com>
* win/tcl.m4: Added -link50compat option so a VC6 linker makes
diff --git a/doc/FileSystem.3 b/doc/FileSystem.3
index 97bfe2c..97f1a78 100644
--- a/doc/FileSystem.3
+++ b/doc/FileSystem.3
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: FileSystem.3,v 1.5 2001/09/04 18:06:34 vincentdarley Exp $
+'\" RCS: @(#) $Id: FileSystem.3,v 1.6 2001/09/08 14:05:09 vincentdarley Exp $
'\"
.so man.macros
.TH Tcl_FSCopyFile 3 8.4 Tcl "Tcl Library Procedures"
@@ -252,8 +252,8 @@ passing it in, or decrementing it.
path name given by destPathPtr. If the two paths given lie in the same
filesystem (according to \fBTcl_FSGetFileSystemForPath\fR) then that
filesystem's 'copy file' function is called (if it is non-NULL).
-Otherwise a cross-filesystem copy is attempted using a combination
-of open-r/open-w/fcopy (at the C level).
+Otherwise the function returns -1 and sets Tcl's errno to the 'EXDEV'
+posix error code (which signifies a 'cross-domain link').
.PP
\fBTcl_FSCopyDirectory\fR attempts to copy the directory given by srcPathPtr to the
path name given by destPathPtr. If the two paths given lie in the same
@@ -629,7 +629,7 @@ functions (it will use \fITcl_FSCopyFileProc\fR followed by
implemented there is a further fallback). However, if a
\fITcl_FSRenameFile\fR command is issued at the C level, no such
fallbacks occur. This is true except for the last five entries in the
-filesystem table (lstat, load, unload, getcwd and chdir) and copyfile
+filesystem table (lstat, load, unload, getcwd and chdir)
for which fallbacks do in fact occur at the C level.
.PP
Any functions which take path names in Tcl_Obj form take
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index c05b7a4..042fe79 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFCmd.c,v 1.12 2001/09/04 18:06:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.13 2001/09/08 14:05:09 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -599,6 +599,9 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
}
} else {
result = Tcl_FSCopyFile(source, target);
+ if ((result != TCL_OK) && (errno == EXDEV)) {
+ result = TclCrossFilesystemCopy(interp, source, target);
+ }
if (result != TCL_OK) {
/*
* We could examine 'errno' to double-check if the problem
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 2650ecd..771b139 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.19 2001/09/06 17:51:00 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.20 2001/09/08 14:05:09 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -47,8 +47,6 @@ static Tcl_PathType FSGetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
Tcl_Filesystem **filesystemPtrPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
-static int CrossFilesystemCopy _ANSI_ARGS_((Tcl_Obj *source,
- Tcl_Obj *target));
/*
* Define the 'path' object type, which Tcl uses to represent
@@ -2282,11 +2280,12 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
return -1;
}
- if (CrossFilesystemCopy(pathPtr, copyToPtr) == TCL_OK) {
+ if (TclCrossFilesystemCopy(interp, pathPtr,
+ copyToPtr) == TCL_OK) {
/*
* Do we need to set appropriate permissions
* on the file? This may be required on some
- * systems. On Unix we could do loop over
+ * systems. On Unix we could loop over
* the file attributes, and set any that are
* called "-permissions" to 0777. Or directly:
*
@@ -2991,16 +2990,13 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
if (retVal == -1) {
Tcl_SetErrno(EXDEV);
}
- if ((retVal != TCL_OK) && (errno == EXDEV)) {
- retVal = CrossFilesystemCopy(srcPathPtr, destPathPtr);
- }
return retVal;
}
/*
*---------------------------------------------------------------------------
*
- * CrossFilesystemCopy --
+ * TclCrossFilesystemCopy --
*
* Helper for above function, and for Tcl_FSLoadFile, to copy
* files from one filesystem to another. This function will
@@ -3014,22 +3010,23 @@ Tcl_FSCopyFile(srcPathPtr, destPathPtr)
*
*---------------------------------------------------------------------------
*/
-static int
-CrossFilesystemCopy(source, target)
+int
+TclCrossFilesystemCopy(interp, source, target)
+ Tcl_Interp *interp; /* For error messages */
Tcl_Obj *source; /* Pathname of file to be copied (UTF-8). */
Tcl_Obj *target; /* Pathname of file to copy to (UTF-8). */
{
int result = TCL_ERROR;
int prot = 0666;
- Tcl_Channel out = Tcl_FSOpenFileChannel(NULL, target, "w", prot);
+ Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
if (out != NULL) {
/* It looks like we can copy it over */
- Tcl_Channel in = Tcl_FSOpenFileChannel(NULL, source,
+ Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source,
"r", prot);
if (in == NULL) {
/* This is very strange, we checked this above */
- Tcl_Close(NULL, out);
+ Tcl_Close(interp, out);
} else {
struct stat sourceStatBuf;
struct utimbuf tval;
@@ -3038,18 +3035,18 @@ CrossFilesystemCopy(source, target)
* asynchronous option to support vfs's which are
* slow (e.g. network sockets).
*/
- Tcl_SetChannelOption(NULL, in, "-translation", "binary");
- Tcl_SetChannelOption(NULL, out, "-translation", "binary");
+ Tcl_SetChannelOption(interp, in, "-translation", "binary");
+ Tcl_SetChannelOption(interp, out, "-translation", "binary");
- if (TclCopyChannel(NULL, in, out, -1, NULL) == TCL_OK) {
+ if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
result = TCL_OK;
}
/*
* If the copy failed, assume that copy channel left
* a good error message.
*/
- Tcl_Close(NULL, in);
- Tcl_Close(NULL, out);
+ Tcl_Close(interp, in);
+ Tcl_Close(interp, out);
/* Set modification date of copied file */
if (Tcl_FSLstat(source, &sourceStatBuf) != 0) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f14e415..5565338 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.63 2001/09/04 18:06:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.64 2001/09/08 14:05:09 vincentdarley Exp $
*/
#ifndef _TCLINT
@@ -1821,6 +1821,8 @@ EXTERN Tcl_Obj* TclpNativeSplitPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
int *lenPtr));
EXTERN Tcl_PathType TclpGetNativePathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
int *driveNameLengthPtr, Tcl_Obj **driveNameRef));
+EXTERN int TclCrossFilesystemCopy _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *source, Tcl_Obj *target));
EXTERN int TclpObjDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
EXTERN int TclpObjCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));