From mboxrd@z Thu Jan 1 00:00:00 1970 From: Erik Hetzner Subject: [PATCH] testing/lisp/test-org-attach-annex.el: New file Date: Mon, 8 Feb 2016 21:40:11 -0800 Message-ID: <56b97cc5.1a5d620a.7b499.ffff958a@mx.google.com> References: <568b532e.d111620a.b25a8.ffffbb7c@mx.google.com> <87poxg8s22.fsf@kyleam.com> <568c6aaa.c345620a.7f4da.6359@mx.google.com> <56a5b193.ca77420a.1551e.667c@mx.google.com> <87lh7dz79f.fsf@gmx.us> <56a70513.6861420a.33633.5843@mx.google.com> <87egd4u6tq.fsf@kyleam.com> <56a7a139.885d620a.6b777.576d@mx.google.com> <87io2gb5xh.fsf@kyleam.com> <87oac8hu9p.fsf@gmx.us> <56a87251.0e2a620a.4811f.fffff1c6@mx.google.com> <87lh79t04p.fsf@kyleam.com> <56b2c213.08e5420a.3d619.ffffd033@mx.google.com> <87oabu3uc0.fsf@gmx.us> <56b77bb8.9447620a.f3b5a.1c05@mx.google.com> <87io20qmaz.fsf@Rainer.invalid> Reply-To: Erik Hetzner Mime-Version: 1.0 (generated by SEMI-EPG 1.14.7 - "Harue") Content-Type: text/plain; charset=US-ASCII Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:58000) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aT16Q-0005Nc-Lw for emacs-orgmode@gnu.org; Tue, 09 Feb 2016 00:44:44 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aT16N-0003aJ-Iw for emacs-orgmode@gnu.org; Tue, 09 Feb 2016 00:44:42 -0500 Received: from mail-pf0-x235.google.com ([2607:f8b0:400e:c00::235]:36065) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aT16N-0003a6-0k for emacs-orgmode@gnu.org; Tue, 09 Feb 2016 00:44:39 -0500 Received: by mail-pf0-x235.google.com with SMTP id e127so26559047pfe.3 for ; Mon, 08 Feb 2016 21:44:38 -0800 (PST) Received: from marut.e6h.org (50-0-83-149.dsl.static.fusionbroadband.com. [50.0.83.149]) by smtp.gmail.com with ESMTPSA id r26sm47278023pfb.21.2016.02.08.21.44.37 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Mon, 08 Feb 2016 21:44:37 -0800 (PST) In-Reply-To: <87io20qmaz.fsf@Rainer.invalid> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org * testing/lisp/test-org-attach-annex.el: Move all org-attach tests that use git-annex to this file, which can test for the presence of git-annex. Prevents tests failing on systems where git-annex is not installed. --- testing/lisp/test-org-attach-annex.el | 96 ++++++++++++++++++++++++++++++++++ testing/lisp/test-org-attach.el | 97 ----------------------------------- 2 files changed, 96 insertions(+), 97 deletions(-) create mode 100644 testing/lisp/test-org-attach-annex.el delete mode 100644 testing/lisp/test-org-attach.el diff --git a/testing/lisp/test-org-attach-annex.el b/testing/lisp/test-org-attach-annex.el new file mode 100644 index 0000000..44b4ad0 --- /dev/null +++ b/testing/lisp/test-org-attach-annex.el @@ -0,0 +1,96 @@ +;;; test-org-annex-attach.el --- Tests for Org Attach with git-annex +;; +;; Copyright (c) 2016 Erik Hetzner +;; Authors: Erik Hetzner + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(org-test-for-executable "git-annex") +(require 'org-attach) +(require 'cl-lib) + +(defmacro test-org-attach-annex/with-annex (&rest body) + `(let ((tmpdir (make-temp-file "org-annex-test" t))) + (unwind-protect + (let ((default-directory tmpdir) + (org-attach-directory tmpdir)) + (shell-command "git init") + (shell-command "git annex init") + ,@body)))) + +(ert-deftest test-org-attach/use-annex () + (test-org-attach-annex/with-annex + (let ((org-attach-git-annex-cutoff 1)) + (should (org-attach-use-annex))) + + (let ((org-attach-git-annex-cutoff nil)) + (should-not (org-attach-use-annex)))) + + ;; test with non annex directory + (let ((tmpdir (make-temp-file "org-annex-test" t))) + (unwind-protect + (let ((default-directory tmpdir) + (org-attach-directory tmpdir)) + (shell-command "git init") + (should-not (org-attach-use-annex))) + (delete-directory tmpdir 'recursive)))) + +(ert-deftest test-org-attach/get-maybe () + (test-org-attach-annex/with-annex + (let ((path (expand-file-name "test-file")) + (annex-dup (make-temp-file "org-annex-test" t))) + (with-temp-buffer + (insert "hello world\n") + (write-file path)) + (shell-command "git annex add test-file") + (shell-command "git annex sync") + ;; Set up remote & copy files there + (let ((annex-original default-directory) + (default-directory annex-dup)) + (shell-command (format "git clone %s ." (shell-quote-argument annex-original))) + (shell-command "git annex init dup") + (shell-command (format "git remote add original %s" (shell-quote-argument annex-original))) + (shell-command "git annex get test-file") + (shell-command "git annex sync")) + (shell-command (format "git remote add dup %s" (shell-quote-argument annex-dup))) + (shell-command "git annex sync") + (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")) + ;; 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) + (called nil)) + (flet ((y-or-n-p (prompt) + (setq called 'was-called) + t)) + (org-attach-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)))) + (should (eq called 'was-called))))))) + +;;; test-org-attach-annex.el ends here diff --git a/testing/lisp/test-org-attach.el b/testing/lisp/test-org-attach.el deleted file mode 100644 index 9772bd7..0000000 --- a/testing/lisp/test-org-attach.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; test-org-attach.el --- Tests for Org Attach -;; -;; Copyright (c) 2016 Erik Hetzner -;; Authors: Erik Hetzner - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(require 'org-attach) -(require 'cl-lib) - -(defmacro test-org-attach-annex/with-annex (&rest body) - `(let ((tmpdir (make-temp-file "org-annex-test" t))) - (unwind-protect - (let ((default-directory tmpdir) - (org-attach-directory tmpdir)) - (shell-command "git init") - (shell-command "git annex init") - ,@body)))) - -(ert-deftest test-org-attach/use-annex () - (org-test-for-executable "git-annex") - (test-org-attach-annex/with-annex - (let ((org-attach-git-annex-cutoff 1)) - (should (org-attach-use-annex))) - - (let ((org-attach-git-annex-cutoff nil)) - (should-not (org-attach-use-annex)))) - - ;; test with non annex directory - (let ((tmpdir (make-temp-file "org-annex-test" t))) - (unwind-protect - (let ((default-directory tmpdir) - (org-attach-directory tmpdir)) - (shell-command "git init") - (should-not (org-attach-use-annex))) - (delete-directory tmpdir 'recursive)))) - -(ert-deftest test-org-attach/get-maybe () - (org-test-for-executable "git-annex") - (test-org-attach-annex/with-annex - (let ((path (expand-file-name "test-file")) - (annex-dup (make-temp-file "org-annex-test" t))) - (with-temp-buffer - (insert "hello world\n") - (write-file path)) - (shell-command "git annex add test-file") - (shell-command "git annex sync") - ;; Set up remote & copy files there - (let ((annex-original default-directory) - (default-directory annex-dup)) - (shell-command (format "git clone %s ." (shell-quote-argument annex-original))) - (shell-command "git annex init dup") - (shell-command (format "git remote add original %s" (shell-quote-argument annex-original))) - (shell-command "git annex get test-file") - (shell-command "git annex sync")) - (shell-command (format "git remote add dup %s" (shell-quote-argument annex-dup))) - (shell-command "git annex sync") - (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")) - ;; 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) - (called nil)) - (flet ((y-or-n-p (prompt) - (setq called 'was-called) - t)) - (org-attach-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)))) - (should (eq called 'was-called))))))) - -;;; test-org-attach.el ends here -- 2.5.0