common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

win32: make RENAME-FILE overwrite its target file

Browse source 
This is consistent with what we do on other platforms (as evidenced by
the newly added unit test) and it is also consistent with what other
implementations (namely Allegro CL and Lispworks) do on Windows.
This commit is contained in:
Luís Borges de Oliveira 2022-05-16 17:09:02 +01:00
parent e8b5fb7d81
commit 87f72d9e27
3 changed files with 17 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
NEWS
View file

@ -5,6 +5,8 @@ changes relative to sbcl-2.2.4:
means that function calls will strictly only use type information from
proclaimed ftypes. The previous behavior (still the default) of using
derived type information from the same file is specified with :SAME-FILE.
* minor incompatible change: RENAME-FILE now overwrites the target file on
Windows too, making its behaviour consistent with other platforms.
* optimization: fasl files are now usually smaller (up to 10% on default
policy) and may load faster, especially on high debug.
* enhancement: debug source locations now work correctly for top level forms

6
src/code/win32.lisp
View file

@ -316,11 +316,13 @@
(values result (if result 0 (get-last-error)))
name nil))
(defconstant +movefile-replace-existing+ 1)
(defun sb-unix:unix-rename (name1 name2)
(declare (type sb-unix:unix-pathname name1 name2))
(syscall (("MoveFile" t) lispbool system-string system-string)
(syscall (("MoveFileEx" t) lispbool system-string system-string dword)
(values result (if result 0 (get-last-error)))
name1 name2))
name1 name2 +movefile-replace-existing+))
(defun sb-unix::posix-getenv (name)
(declare (type simple-string name))

11
tests/filesys.pure.lisp
View file

@ -429,3 +429,14 @@
(test (make-unspecific nil t) "foo/")
(test (make-unspecific t nil) "foo/")
(test (make-unspecific t t) "foo/")))
(with-test (:name (rename-file :overwrite))
(with-test-directory ()
(with-open-file (s "a" :direction :output)
(write-line "a" s))
(with-open-file (s "b" :direction :output)
(write-line "b" s))
(rename-file "a" "b")
(assert (null (probe-file "a")))
(with-open-file (s "b")
(assert (equal "a" (read-line s))))))