summaryrefslogtreecommitdiffstats
path: root/library/init.tcl
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2004-01-29 10:28:18 (GMT)
committervincentdarley <vincentdarley>2004-01-29 10:28:18 (GMT)
commitf5c319ed1e839e9256fcad85b69c4fde1d5d7c97 (patch)
treebc4f25a47a8614d6ef6beed61ae233eb487c80df /library/init.tcl
parent6d7cd4ec5de7d8e50e829fb37492ab7ca3a2f43a (diff)
downloadtcl-f5c319ed1e839e9256fcad85b69c4fde1d5d7c97.zip
tcl-f5c319ed1e839e9256fcad85b69c4fde1d5d7c97.tar.gz
tcl-f5c319ed1e839e9256fcad85b69c4fde1d5d7c97.tar.bz2
filesystem fixes for '-force' consistency and picky compilers
Diffstat (limited to 'library/init.tcl')
-rw-r--r--library/init.tcl17
1 files changed, 12 insertions, 5 deletions
diff --git a/library/init.tcl b/library/init.tcl
index 5f69a88..ff3a245 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.58 2003/10/14 15:44:53 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.59 2004/01/29 10:28:21 vincentdarley Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -668,6 +668,7 @@ proc auto_execok name {
proc tcl::CopyDirectory {action src dest} {
set nsrc [file normalize $src]
set ndest [file normalize $dest]
+
if {[string equal $action "renaming"]} {
# Can't rename volumes. We could give a more precise
# error message here, but that would break the test suite.
@@ -684,8 +685,14 @@ proc tcl::CopyDirectory {action src dest} {
into itself"
}
if {[string equal $action "copying"]} {
- return -code error "error $action \"$src\" to\
- \"$dest\": file already exists"
+ # We used to throw an error here, but, looking more closely
+ # at the core copy code in tclFCmd.c, if the destination
+ # exists, then we should only call this function if -force
+ # is true, which means we just want to over-write. So,
+ # the following code is now commented out.
+ #
+ # return -code error "error $action \"$src\" to\
+ # \"$dest\": file already exists"
} else {
# Depending on the platform, and on the current
# working directory, the directories '.', '..'
@@ -721,10 +728,10 @@ proc tcl::CopyDirectory {action src dest} {
# or filesystems hidden files may have other interpretations.
set filelist [concat [glob -nocomplain -directory $src *] \
[glob -nocomplain -directory $src -types hidden *]]
-
+
foreach s [lsort -unique $filelist] {
if {([file tail $s] != ".") && ([file tail $s] != "..")} {
- file copy $s [file join $dest [file tail $s]]
+ file copy -force $s [file join $dest [file tail $s]]
}
}
return