test-org-attach-annex.el 3.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495
  1. ;;; test-org-annex-attach.el --- Tests for Org Attach with git-annex
  2. ;;
  3. ;; Copyright (c) 2016 Erik Hetzner
  4. ;; Authors: Erik Hetzner
  5. ;; This file is not part of GNU Emacs.
  6. ;; This program is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; This program is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Code:
  17. (org-test-for-executable "git-annex")
  18. (require 'org-attach)
  19. (require 'cl-lib)
  20. (defmacro test-org-attach-annex/with-annex (&rest body)
  21. `(let ((tmpdir (make-temp-file "org-annex-test" t "/")))
  22. (unwind-protect
  23. (let ((default-directory tmpdir)
  24. (org-attach-directory tmpdir))
  25. (shell-command "git init")
  26. (shell-command "git annex init")
  27. ,@body))))
  28. (ert-deftest test-org-attach/use-annex ()
  29. (test-org-attach-annex/with-annex
  30. (let ((org-attach-git-annex-cutoff 1))
  31. (should (org-attach-use-annex)))
  32. (let ((org-attach-git-annex-cutoff nil))
  33. (should-not (org-attach-use-annex))))
  34. ;; test with non annex directory
  35. (let ((tmpdir (make-temp-file "org-annex-test" t "/")))
  36. (unwind-protect
  37. (let ((default-directory tmpdir)
  38. (org-attach-directory tmpdir))
  39. (shell-command "git init")
  40. (should-not (org-attach-use-annex)))
  41. (delete-directory tmpdir 'recursive))))
  42. (ert-deftest test-org-attach/get-maybe ()
  43. (test-org-attach-annex/with-annex
  44. (let ((path (expand-file-name "test-file"))
  45. (annex-dup (make-temp-file "org-annex-test" t "/")))
  46. (with-temp-buffer
  47. (insert "hello world\n")
  48. (write-file path))
  49. (shell-command "git annex add test-file")
  50. (shell-command "git annex sync")
  51. ;; Set up remote & copy files there
  52. (let ((annex-original default-directory)
  53. (default-directory annex-dup))
  54. (shell-command (format "git clone %s ." (shell-quote-argument annex-original)))
  55. (shell-command "git annex init dup")
  56. (shell-command (format "git remote add original %s" (shell-quote-argument annex-original)))
  57. (shell-command "git annex get test-file")
  58. (shell-command "git annex sync"))
  59. (shell-command (format "git remote add dup %s" (shell-quote-argument annex-dup)))
  60. (shell-command "git annex sync")
  61. (shell-command "git annex drop --force test-file")
  62. ;; test getting the file from the dup when we should ALWAYS get
  63. (should (not (file-exists-p (file-symlink-p (expand-file-name "test-file")))))
  64. (let ((org-attach-annex-auto-get t))
  65. (org-attach-annex-get-maybe (expand-file-name "test-file"))
  66. ;; check that the file has the right contents
  67. (with-temp-buffer
  68. (insert-file-contents path)
  69. (should (string-equal "hello world\n" (buffer-string)))))
  70. ;; test getting the file from the dup when we should NEVER get
  71. (shell-command "git annex drop --force test-file")
  72. (let ((org-attach-annex-auto-get nil))
  73. (should-error (org-attach-annex-get-maybe (expand-file-name "test-file"))))
  74. (let ((org-attach-annex-auto-get 'ask)
  75. (called nil))
  76. (cl-letf (((symbol-function 'y-or-n-p)
  77. (lambda (_) (setq called 'was-called) t)))
  78. (org-attach-annex-get-maybe (expand-file-name "test-file"))
  79. ;; check that the file has the right contents
  80. (with-temp-buffer
  81. (insert-file-contents path)
  82. (should (string-equal "hello world\n" (buffer-string))))
  83. (should (eq called 'was-called)))))))
  84. ;;; test-org-attach-annex.el ends here