testing/lisp/test-org-archive.el

   1 ;;; test-org-archive.el --- Test for Org Archive     -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2017  Jay Kamat
   4
   5 ;; Author: Jay Kamat <jaygkamat@gmail.com>
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Code:
  21
  22 (ert-deftest test-org-archive/update-status-cookie ()
  23   "Test archiving properly updating status cookies."
  24   ;; Test org-archive-subtree with two children.
  25   (should
  26    (equal
  27     "Top [0%]"
  28     (org-test-with-temp-text-in-file
  29         "* Top [%]\n** DONE One\n** TODO Two"
  30       (forward-line)
  31       (org-archive-subtree)
  32       (forward-line -1)
  33       (org-element-property :title (org-element-at-point)))))
  34   ;; Test org-archive-subtree with one child.
  35   (should
  36    (equal
  37     "Top [100%]"
  38     (org-test-with-temp-text-in-file "* Top [%]\n** TODO Two"
  39       (forward-line)
  40       (org-archive-subtree)
  41       (forward-line -1)
  42       (org-element-property :title (org-element-at-point)))))
  43   ;; Test org-archive-to-archive-sibling with two children.
  44   (should
  45    (equal
  46     "Top [100%]"
  47     (org-test-with-temp-text "* Top [%]\n<point>** TODO One\n** DONE Two"
  48       (org-archive-to-archive-sibling)
  49       (forward-line -1)
  50       (org-element-property :title (org-element-at-point)))))
  51   ;; Test org-archive-to-archive-sibling with two children.
  52   (should
  53    (equal
  54     "Top [0%]"
  55     (org-test-with-temp-text "* Top [%]\n<point>** DONE Two"
  56       (org-archive-to-archive-sibling)
  57       (forward-line -1)
  58       (org-element-property :title (org-element-at-point))))))
  59
  60 (ert-deftest test-org-archive/to-archive-sibling ()
  61   "Test `org-archive-to-archive-sibling' specifications."
  62   ;; Archive sibling before or after archive heading.
  63   (should
  64    (equal "* Archive :ARCHIVE:\n** H\n"
  65           (org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n"
  66             (let ((org-archive-sibling-heading "Archive")
  67                   (org-archive-tag "ARCHIVE"))
  68               (org-archive-to-archive-sibling)
  69               (goto-char (point-min))
  70               (buffer-substring-no-properties
  71                (point) (line-beginning-position 3))))))
  72   (should
  73    (equal "* Archive :ARCHIVE:\n** H\n"
  74           (org-test-with-temp-text "* Archive :ARCHIVE:\n<point>* H\n"
  75             (let ((org-archive-sibling-heading "Archive")
  76                   (org-archive-tag "ARCHIVE"))
  77               (org-archive-to-archive-sibling)
  78               (goto-char (point-min))
  79               (buffer-substring-no-properties
  80                (point) (line-beginning-position 3))))))
  81   ;; When there is no sibling archive heading, create it.
  82   (should
  83    (equal "* Archive :ARCHIVE:\n** H\n"
  84           (org-test-with-temp-text "* H\n"
  85             (let ((org-archive-sibling-heading "Archive")
  86                   (org-archive-tag "ARCHIVE"))
  87               (org-archive-to-archive-sibling)
  88               (goto-char (point-min))
  89               (buffer-substring-no-properties
  90                (point) (line-beginning-position 3))))))
  91   ;; Ignore non-sibling archive headings.
  92   (should
  93    (equal "* Archive :ARCHIVE:\n* Top\n** Archive :ARCHIVE:\n*** H\n"
  94           (org-test-with-temp-text "* Archive :ARCHIVE:\n* Top\n<point>** H\n"
  95             (let ((org-archive-sibling-heading "Archive")
  96                   (org-archive-tag "ARCHIVE"))
  97               (org-archive-to-archive-sibling)
  98               (goto-char (point-min))
  99               (buffer-substring-no-properties
 100                (point) (line-beginning-position 5))))))
 101   ;; When archiving a heading, leave point on next heading.
 102   (should
 103    (equal "* H2"
 104           (org-test-with-temp-text "* H1\n* H2\n* Archive :ARCHIVE:\n"
 105             (let ((org-archive-sibling-heading "Archive")
 106                   (org-archive-tag "ARCHIVE"))
 107               (org-archive-to-archive-sibling)
 108               (buffer-substring-no-properties (point) (line-end-position))))))
 109   (should
 110    (equal "* H2"
 111           (org-test-with-temp-text "* Archive :ARCHIVE:\n<point>* H1\n* H2\n"
 112             (let ((org-archive-sibling-heading "Archive")
 113                   (org-archive-tag "ARCHIVE"))
 114               (org-archive-to-archive-sibling)
 115               (buffer-substring-no-properties (point) (line-end-position))))))
 116   ;; If `org-archive-reversed-order' is nil, archive as the last
 117   ;; child.  Otherwise, archive as the first one.
 118   (should
 119    (equal "* Archive :ARCHIVE:\n** A\n"
 120           (org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n** A\n"
 121             (let ((org-archive-sibling-heading "Archive")
 122                   (org-archive-tag "ARCHIVE")
 123                   (org-archive-reversed-order nil))
 124               (org-archive-to-archive-sibling)
 125               (goto-char (point-min))
 126               (buffer-substring-no-properties
 127                (point) (line-beginning-position 3))))))
 128   (should
 129    (equal "* Archive :ARCHIVE:\n** H\n"
 130           (org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n** A\n"
 131             (let ((org-archive-sibling-heading "Archive")
 132                   (org-archive-tag "ARCHIVE")
 133                   (org-archive-reversed-order t))
 134               (org-archive-to-archive-sibling)
 135               (goto-char (point-min))
 136               (buffer-substring-no-properties
 137                (point) (line-beginning-position 3)))))))
 138
 139 (provide 'test-org-archive)
 140 ;;; test-org-archive.el ends here