io.directories: improve file moving words

move-file previously had inconsistent behavior on Windows and unixes.
This unifies the behavior to the common case (just get 'er done), while
also introducing an obviously named word, move-file-atomically, to
handle the case where you need an atomic file primitive.

Fixes #1772

diff --git a/basis/io/directories/directories-docs.factor b/basis/io/directories/directories-docs.factor
index 90d51249bf2647f1333bca23f0e33ac9712f7451..07d6afcc69f51d57b4d9de9c98ed44e796de00bf 100644 (file)
--- a/basis/io/directories/directories-docs.factor
+++ b/basis/io/directories/directories-docs.factor
@@ -104,7 +104,13 @@ HELP: touch-file
 
 HELP: move-file
 { $values { "from" "a pathname string" } { "to" "a pathname string" } }
-{ $description "Moves or renames a file." }
+{ $description "Moves or renames a file. This operation is not guaranteed to be atomic. In particular, if you attempt to move a file across volumes, this will copy the file and then delete the original in a nontransactional manner." }
+{ $errors "Throws an error if the file does not exist or if the move operation fails." }
+{ $see-also move-file-atomically } ;
+
+HELP: move-file-atomically
+{ $values { "from" "a pathname string" } { "to" "a pathname string" } }
+{ $description "Moves or renames a file as an atomic operation." }
 { $errors "Throws an error if the file does not exist or if the move operation fails." } ;
 
 HELP: move-file-into

diff --git a/basis/io/directories/directories.factor b/basis/io/directories/directories.factor
index d9353d8113d1673e88bd0543327db8c25417b6e6..0b5c335f9aa7e5320b3c399d4f8bbc6c02d8dcb5 100644 (file)
--- a/basis/io/directories/directories.factor
+++ b/basis/io/directories/directories.factor
@@ -84,6 +84,7 @@ HOOK: delete-directory io-backend ( path -- )
 
 ! Moving and renaming files
 HOOK: move-file io-backend ( from to -- )
+HOOK: move-file-atomically io-backend ( from to -- )
 
 : move-file-into ( from to -- )
     to-directory move-file ;

diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor
index 3cc0b549e824df2befc5d5d1b5ba7058d2688ff9..14a37f5bedf2fd5802527f6273fd63d69bc51ce8 100644 (file)
--- a/basis/io/directories/unix/unix.factor
+++ b/basis/io/directories/unix/unix.factor
@@ -17,9 +17,16 @@ M: unix touch-file ( path -- )
         touch-mode file-mode open-file close-file
     ] if ;
 
-M: unix move-file ( from to -- )
+M: unix move-file-atomically ( from to -- )
     [ normalize-path ] bi@ [ rename ] unix-system-call drop ;
 
+M: unix move-file ( from to -- )
+    [ move-file-atomically ] [
+        dup errno>> EXDEV = [
+            drop [ copy-file ] [ drop delete-file ] 2bi
+        ] [ rethrow ] if
+    ] recover ;
+
 M: unix delete-file ( path -- ) normalize-path unlink-file ;
 
 M: unix make-directory ( path -- )

diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor
index bfc7f8a1b4ea6f6d1735847dcb13a93658559cec..16f4724b30fa530115a27966288a0fe6483ba98a 100644 (file)
--- a/basis/io/directories/windows/windows.factor
+++ b/basis/io/directories/windows/windows.factor
@@ -17,6 +17,9 @@ M: windows touch-file ( path -- )
 M: windows move-file ( from to -- )
     [ normalize-path ] bi@ MoveFile win32-error=0/f ;
 
+M: windows move-file-atomically ( from to -- )
+    [ normalize-path ] bi@ 0 MoveFileEx win32-error=0/f ;
+
 ERROR: file-delete-failed path error ;
 
 : delete-file-throws ( path -- )

diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 0ebb18c4d06576cc20782003a765f76bbbb12cbc..5e2b170d659290f7a8490b54b0f29409d73eac23 100644 (file)
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -1676,7 +1676,8 @@ FUNCTION: LPVOID MapViewOfFileEx ( HANDLE hFileMappingObject,
 ! FUNCTION: Module32NextW
 ! FUNCTION: MoveFileA
 ! FUNCTION: MoveFileExA
-! FUNCTION: MoveFileExW
+FUNCTION: BOOL MoveFileExW ( LPCSTR lpExistingFile, LPCSTR lpNewFileName, DWORD dwFlags )
+ALIAS: MoveFileEx MoveFileExW
 FUNCTION: BOOL MoveFileW ( LPCTSTR lpExistingFileName, LPCTSTR lpNewFileName )
 ALIAS: MoveFile MoveFileW
 ! FUNCTION: MoveFileWithProgressA