diff options
| author | Steve Bennett <steveb@workware.net.au> | 2013-11-07 08:21:36 +1000 |
|---|---|---|
| committer | Steve Bennett <steveb@workware.net.au> | 2013-11-07 08:26:52 +1000 |
| commit | 93acd70060fae15b0985c74991486f2d68d468b2 (patch) | |
| tree | 618028e1d90e444d551923c091d1bc9d466997c2 /tclcompat.tcl | |
| parent | a077f0800f5bbc7ca5f3b368726f7d1757c16549 (diff) | |
| download | jimtcl-93acd70060fae15b0985c74991486f2d68d468b2.zip jimtcl-93acd70060fae15b0985c74991486f2d68d468b2.tar.gz jimtcl-93acd70060fae15b0985c74991486f2d68d468b2.tar.bz2 | |
file copy -force handles identical source/target
No longer truncates the file
Reported-by: sg0x40 <https://github.com/sg0x40>
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'tclcompat.tcl')
| -rw-r--r-- | tclcompat.tcl | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/tclcompat.tcl b/tclcompat.tcl index 21c3922..d736859 100644 --- a/tclcompat.tcl +++ b/tclcompat.tcl @@ -130,9 +130,16 @@ proc {file copy} {{force {}} source target} { set in [open $source] - if {$force eq "" && [file exists $target]} { - $in close - error "error copying \"$source\" to \"$target\": file already exists" + if {[file exists $target]} { + if {$force eq ""} { + error "error copying \"$source\" to \"$target\": file already exists" + } + # If source and target are the same, nothing to do + file stat $source ss + file stat $target ts + if {$ss(dev) == $ts(dev) && $ss(ino) == $ts(ino)} { + return + } } set out [open $target w] $in copyto $out |