dir-rename.lisp 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546
  1. (in-package :translator-test)
  2. (defun %my-dir-rename (dir newdir oldname newname
  3. ret err)
  4. (multiple-value-bind (ret0 err0)
  5. (dir-rename dir newdir
  6. :oldname oldname
  7. :newname newname
  8. :excl t)
  9. (assert-equal ret0 ret)
  10. (assert-equal err0 err)))
  11. (def-test-method dir-rename-test ((test fs-test))
  12. (with-testport (dir (file-name-lookup +main-dir+))
  13. ; Trigger invalid cross device link
  14. (with-testport (newdir (file-name-lookup "/usr"))
  15. (%my-dir-rename dir newdir "a" "a"
  16. nil :invalid-cross-device-link))
  17. ; Trigger no such file
  18. (with-testport (newdir (file-name-lookup +main-dir+))
  19. (%my-dir-rename dir newdir "abcd" "x" nil :no-such-file))
  20. ; Trigger a file exists
  21. (with-testport (newdir (file-name-lookup +main-dir+))
  22. (%my-dir-rename dir newdir "a" "a" nil :file-exists))
  23. ; Now some successful rename's..
  24. (with-testport (newdir (file-name-lookup +translator-root+))
  25. (let (old-stat new-stat)
  26. (with-testport (file (file-name-lookup (concatenate-string
  27. +main-dir+
  28. "/a")))
  29. (setf old-stat (io-stat file)))
  30. (assert-true (dir-rename dir newdir :oldname "a" :newname "a"))
  31. (with-testport (file (file-name-lookup (concatenate-string
  32. +translator-root+
  33. "/a")))
  34. (setf new-stat (io-stat file)))
  35. (assert-true (stat-eq old-stat new-stat)))
  36. (assert-true (dir-rename newdir newdir
  37. :oldname "a"
  38. :newname "thingy"))
  39. (assert-true (dir-rename newdir dir
  40. :oldname "thingy"
  41. :newname "a")))))