From 930a1bcfc52b6897ca9bfaf4e2c0f6cf2c248172 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= Date: Sun, 8 Sep 2019 14:12:46 +0200 Subject: [PATCH] Fix problems with org-attach-git, failed tests Ref. mail "[O] git-annex-related org-attach tests failing on master" https://lists.gnu.org/archive/html/emacs-orgmode/2019-09/msg00030.html * lisp/org-attach-git.el (org-attach-git-commit): Add optional argument to function contract to make it work with `org-attach-after-change-hook'. Even though that argument is not used in the actual code (due to legacy functionality). * testing/lisp/test-org-attach.el (test-org-attach/dired-attach-to-next-best-subtree/1) (test-org-attach/dired-attach-to-next-best-subtree/2): Modify tests to also work if user has git-annex installed * testing/lisp/test-org-attach-git.el (test-org-attach-git/use-annex): Correct errors from previous commit, where git-annex was refactored out from org-attach into it's separate module. --- lisp/org-attach-git.el | 14 ++++--- testing/lisp/test-org-attach-git.el | 22 +++++------ testing/lisp/test-org-attach.el | 60 ++++++++++++++++------------- 3 files changed, 52 insertions(+), 44 deletions(-) diff --git a/lisp/org-attach-git.el b/lisp/org-attach-git.el index f40eb966d..1dbc2b746 100644 --- a/lisp/org-attach-git.el +++ b/lisp/org-attach-git.el @@ -23,10 +23,9 @@ ;;; Commentary: -;; An extention to org-attach. If the attachment-directory to an -;; outline node (using either DIR or ID) is initialized as a Git -;; repository, then org-attach-git will automatically commit changes -;; when it sees them. +;; An extention to org-attach. If `org-attach-id-dir' is initialized +;; as a Git repository, then org-attach-git will automatically commit +;; changes when it sees them. Requires git-annex. ;;; Code: @@ -81,9 +80,12 @@ Signals an error if the file content is not available and it was not retrieved." (message "Running git annex get \"%s\"." path-relative) (call-process "git" nil nil nil "annex" "get" path-relative))))) -(defun org-attach-git-commit () +(defun org-attach-git-commit (&optional attach-dir) "Commit changes to git if `org-attach-id-dir' is properly initialized. -This checks for the existence of a \".git\" directory in that directory." +This checks for the existence of a \".git\" directory in that directory. + +Takes one optional argument ATTACH-DIR for the sake of being +compatible with hook `org-attach-after-change-hook'." (let* ((dir (expand-file-name org-attach-id-dir)) (git-dir (vc-git-root dir)) (use-annex (org-attach-git-use-annex)) diff --git a/testing/lisp/test-org-attach-git.el b/testing/lisp/test-org-attach-git.el index 8b826b72f..36cb83bb0 100644 --- a/testing/lisp/test-org-attach-git.el +++ b/testing/lisp/test-org-attach-git.el @@ -33,12 +33,12 @@ ,@body)))) (ert-deftest test-org-attach-git/use-annex () - (test-org-attach-annex/with-annex + (test-org-attach-git/with-annex (let ((org-attach-git-annex-cutoff 1)) - (should (org-attach-use-annex))) + (should (org-attach-git-use-annex))) (let ((org-attach-git-annex-cutoff nil)) - (should-not (org-attach-use-annex)))) + (should-not (org-attach-git-use-annex)))) ;; test with non annex directory (let ((tmpdir (make-temp-file "org-annex-test" t "/"))) @@ -46,11 +46,11 @@ (let ((default-directory tmpdir) (org-attach-id-dir tmpdir)) (shell-command "git init") - (should-not (org-attach-use-annex))) + (should-not (org-attach-git-use-annex))) (delete-directory tmpdir 'recursive)))) (ert-deftest test-org-attach-git/get-maybe () - (test-org-attach-annex/with-annex + (test-org-attach-git/with-annex (let ((path (expand-file-name "test-file")) (annex-dup (make-temp-file "org-annex-test" t "/"))) (with-temp-buffer @@ -71,21 +71,21 @@ (shell-command "git annex drop --force test-file") ;; test getting the file from the dup when we should ALWAYS get (should (not (file-exists-p (file-symlink-p (expand-file-name "test-file"))))) - (let ((org-attach-annex-auto-get t)) - (org-attach-annex-get-maybe (expand-file-name "test-file")) + (let ((org-attach-git-annex-auto-get t)) + (org-attach-git-annex-get-maybe (expand-file-name "test-file")) ;; check that the file has the right contents (with-temp-buffer (insert-file-contents path) (should (string-equal "hello world\n" (buffer-string))))) ;; test getting the file from the dup when we should NEVER get (shell-command "git annex drop --force test-file") - (let ((org-attach-annex-auto-get nil)) - (should-error (org-attach-annex-get-maybe (expand-file-name "test-file")))) - (let ((org-attach-annex-auto-get 'ask) + (let ((org-attach-git-annex-auto-get nil)) + (should-error (org-attach-git-annex-get-maybe (expand-file-name "test-file")))) + (let ((org-attach-git-annex-auto-get 'ask) (called nil)) (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) (setq called 'was-called) t))) - (org-attach-annex-get-maybe (expand-file-name "test-file")) + (org-attach-git-annex-get-maybe (expand-file-name "test-file")) ;; check that the file has the right contents (with-temp-buffer (insert-file-contents path) diff --git a/testing/lisp/test-org-attach.el b/testing/lisp/test-org-attach.el index 324e51c6e..37cc39d85 100644 --- a/testing/lisp/test-org-attach.el +++ b/testing/lisp/test-org-attach.el @@ -108,56 +108,62 @@ (ert-deftest test-org-attach/dired-attach-to-next-best-subtree/1 () "Attach file at point in dired to subtree." (should - (let ((a-filename (make-temp-file "a"))) ; file is an attach candidate. + (let ((a-filename (make-temp-file "a")) ; file is an attach candidate. + (org-attach-id-dir "data/")) (unwind-protect (org-test-with-temp-text-in-file - "* foo :foo:" - (split-window) - (dired temporary-file-directory) - (cl-assert (eq 'dired-mode major-mode)) - (revert-buffer) - (dired-goto-file a-filename) + "* foo :foo:" + (split-window) + (let ((org-buffer (current-buffer)) + (dired-buffer (dired temporary-file-directory))) + (cl-assert (eq 'dired-mode major-mode)) + (revert-buffer) + (dired-goto-file a-filename) ; action - (call-interactively #'org-attach-dired-to-subtree) + (call-interactively #'org-attach-dired-to-subtree) ; check - (delete-window) - (cl-assert (eq 'org-mode major-mode)) - (beginning-of-buffer) - (search-forward "* foo") + (delete-window) + (switch-to-buffer org-buffer) + (cl-assert (eq 'org-mode major-mode))) + (beginning-of-buffer) + (search-forward "* foo") ; expectation. tag ATTACH has been appended. - (cl-reduce (lambda (x y) (or x y)) - (mapcar (lambda (x) (string-equal "ATTACH" x)) - (plist-get + (cl-reduce (lambda (x y) (or x y)) + (mapcar (lambda (x) (string-equal "ATTACH" x)) (plist-get - (org-element-at-point) 'headline) :tags)))) + (plist-get + (org-element-at-point) 'headline) :tags)))) (delete-file a-filename))))) (ert-deftest test-org-attach/dired-attach-to-next-best-subtree/2 () "Attach 2 marked files." (should (let ((a-filename (make-temp-file "a")) - (b-filename (make-temp-file "b"))) ; attach candidates. + (b-filename (make-temp-file "b")) ; attach candidates. + (org-attach-id-dir "data/")) (unwind-protect (org-test-with-temp-text-in-file "* foo" (split-window) - (dired temporary-file-directory) - (cl-assert (eq 'dired-mode major-mode)) - (revert-buffer) - (dired-goto-file a-filename) - (dired-mark 1) - (dired-goto-file b-filename) - (dired-mark 1) + (let ((org-buffer (current-buffer)) + (dired-buffer (dired temporary-file-directory))) + (cl-assert (eq 'dired-mode major-mode)) + (revert-buffer) + (dired-goto-file a-filename) + (dired-mark 1) + (dired-goto-file b-filename) + (dired-mark 1) ; action - (call-interactively #'org-attach-dired-to-subtree) + (call-interactively #'org-attach-dired-to-subtree) ; check - (delete-window) + (delete-window) + (switch-to-buffer org-buffer)) (cl-assert (eq 'org-mode major-mode)) (beginning-of-buffer) (search-forward "* foo") (and (file-exists-p (concat (org-attach-dir) "/" (file-name-nondirectory a-filename))) - (file-exists-p (concat (org-attach-dir) "/" + (file-exists-p (concat (org-attach-dir) "/" (file-name-nondirectory b-filename))))) (delete-file a-filename) (delete-file b-filename)))))