Add more tests and run in CI (#44)

* reindent current test

* add some tests

* add Makefile for running tests

* add org-alert--map-entries to make testing a little easier

* add test dependent on current-time

* add no notification test with remindern

* allow passing a different org file to `with-test-org`

* add non-remindern tests

* add ci.sh and github ci file

* wrong order in use-package

* add melpa

* unwind-protect to prevent one failure from ruining all tests

* use-package wasn't added until 29

* add/subtract 10 seconds for extra buffer time in failing tests

* fix extra quote

* assert preconditions for failing CI tests, they're working locally

* debug prints

* wrong remindern test

* set timezone, github runners were in UTC

* untabify and reindent

* fix a test docstring

.github/workflows/test.yml

@@ -0,0 +1,33 @@
+# copied from
+# https://github.com/magnars/s.el/blob/dda84d38fffdaf0c9b12837b504b402af910d01d/.github/workflows/test.yml
+name: CI
+
+on:
+  push:
+    branches:
+      - master
+  pull_request:
+
+jobs:
+  test:
+    timeout-minutes: 5
+    runs-on: ubuntu-latest
+    strategy:
+      matrix:
+        emacs_version:
+          - 29.1
+          - 29.2
+          - 29.3
+          - 29.4
+          - snapshot
+      fail-fast: false
+    steps:
+    - uses: actions/checkout@v3
+    - name: Set up Emacs
+      uses: purcell/[email protected]
+      with:
+        version: ${{ matrix.emacs_version }}
+
+    - name: Test
+      run: |
+        ./ci.sh

ci.sh

@@ -0,0 +1,9 @@
+#!/bin/bash
+
+set -xe
+
+emacs -batch -f package-initialize \
+	  --eval '(add-to-list (quote package-archives) (quote ("melpa" . "http://melpa.org/packages/")))' \
+	  --eval '(use-package alert :ensure t)'
+
+cd test && make test

org-alert.el

@@ -101,13 +101,13 @@ to allow differentiation from other uses of alert"
      (skip-chars-forward " \t\r\n")
      (save-match-data
        (save-excursion (outline-end-of-heading)
-		       (setq folded (org-invisible-p)))
+                       (setq folded (org-invisible-p)))
        (ignore-errors (org-forward-heading-same-level (1- n) t))
        (org-end-of-subtree t t))
      ;; Include the end of an inlinetask
      (when (and (featurep 'org-inlinetask)
-		(looking-at-p (concat (org-inlinetask-outline-regexp)
-				      "END[ \t]*$")))
+                (looking-at-p (concat (org-inlinetask-outline-regexp)
+                                      "END[ \t]*$")))
        (end-of-line))
      (setq end (point))
      (goto-char beg0)
@@ -128,16 +128,16 @@ return the stripped copy"
   "Return the current org subtree as a string with the
 text-properties stripped, along with the cutoff to apply"
   (let* ((subtree (org-alert--read-subtree))
-	 (props (org-entry-properties))
-	 (prop (alist-get org-alert-cutoff-prop props org-alert-notify-cutoff nil #'string-equal))
-	 (prop (if (stringp prop)
-		   (string-to-number prop)
-		 prop))
-	 (text (org-alert--strip-text-properties subtree)))
+         (props (org-entry-properties))
+         (prop (alist-get org-alert-cutoff-prop props org-alert-notify-cutoff nil #'string-equal))
+         (prop (if (stringp prop)
+                   (string-to-number prop)
+                 prop))
+         (text (org-alert--strip-text-properties subtree)))
     (list
      (apply #'concat
-	    (cl-remove-if #'(lambda (s) (string= s ""))
-			  (cdr (split-string text "\n"))))
+            (cl-remove-if #'(lambda (s) (string= s ""))
+                          (cdr (split-string text "\n"))))
      prop)))
 
 (defun org-alert--to-minute (hour minute)
@@ -149,15 +149,15 @@ text-properties stripped, along with the cutoff to apply"
 `org-alert-notify-after-event-cutoff` is set, also check that NOW
 is less than `org-alert-notify-after-event-cutoff` past TIME."
   (let* ((time (mapcar #'string-to-number (split-string time ":")))
-	 (now (or now (decode-time (current-time))))
-	 (now (org-alert--to-minute (decoded-time-hour now) (decoded-time-minute now)))
-	 (then (org-alert--to-minute (car time) (cadr time)))
-	 (time-until (- then now)))
+         (now (or now (decode-time (current-time))))
+         (now (org-alert--to-minute (decoded-time-hour now) (decoded-time-minute now)))
+         (then (org-alert--to-minute (car time) (cadr time)))
+         (time-until (- then now)))
     (if org-alert-notify-after-event-cutoff
-	(and
-	 (<= time-until cutoff)
-	 ;; negative time-until past events
-	 (> time-until (- org-alert-notify-after-event-cutoff)))
+        (and
+         (<= time-until cutoff)
+         ;; negative time-until past events
+         (> time-until (- org-alert-notify-after-event-cutoff)))
       (<= time-until cutoff))))
 
 (defun org-alert--parse-entry ()
@@ -166,27 +166,30 @@ heading, the scheduled/deadline time, and the cutoff to apply"
   (let ((head (org-alert--strip-text-properties (org-get-heading t t t t))))
     (cl-destructuring-bind (body cutoff) (org-alert--grab-subtree)
       (if (string-match org-alert-time-match-string body)
-	  (list head (match-string 1 body) cutoff)
-	nil))))
+          (list head (match-string 1 body) cutoff)
+        nil))))
 
 (defun org-alert--dispatch ()
   (let ((entry (org-alert--parse-entry)))
     (when entry
       (cl-destructuring-bind (head time cutoff) entry
-	(if time
-	    (when (org-alert--check-time time cutoff)
-	      (alert (concat time ": " head)
+        (if time
+            (when (org-alert--check-time time cutoff)
+              (alert (concat time ": " head)
                      :title org-alert-notification-title
                      :category org-alert-notification-category))
-	  (alert head :title org-alert-notification-title
+          (alert head :title org-alert-notification-title
                  :category org-alert-notification-category))))))
 
+(defun org-alert--map-entries (func)
+  (org-map-entries func org-alert-match-string 'agenda
+                   '(org-agenda-skip-entry-if 'todo
+                                              org-done-keywords-for-agenda)))
+
 (defun org-alert-check ()
   "Check for active, due deadlines and initiate notifications."
   (interactive)
-  (org-map-entries 'org-alert--dispatch org-alert-match-string 'agenda
-		   '(org-agenda-skip-entry-if 'todo
-					      org-done-keywords-for-agenda))
+  (org-alert--map-entries 'org-alert--dispatch)
   t)
 
 (defun org-alert-enable ()
@@ -200,7 +203,7 @@ heading, the scheduled/deadline time, and the cutoff to apply"
   (interactive)
   (dolist (timer timer-list)
     (if (eq (elt timer 5) 'org-alert-check)
-	(cancel-timer timer))))
+        (cancel-timer timer))))
 
 (provide 'org-alert)
 ;;; org-alert.el ends here

test/Makefile

@@ -0,0 +1,7 @@
+test:
+	emacs -batch -f package-initialize \
+          -l ert \
+          -l alert \
+          -l ../org-alert.el \
+          -l test.el \
+          -f ert-run-tests-batch-and-exit

test/plain.org

@@ -0,0 +1,2 @@
+* TODO regular test
+  SCHEDULED: <2023-05-20 Sat 09:55>

test/test.el

@@ -1,23 +1,96 @@
 ;; -*- lexical-binding: t; -*-
 
+(defvar test-alert-notifications nil
+  "The notifications received so far")
+
+(defun test-alert-notify (info)
+  (push info test-alert-notifications))
+
+(defun test-alert-reset ()
+  (setq test-alert-notifications nil))
+
+(alert-define-style 'test-alert :notifier #'test-alert-notify)
+
+(cl-defmacro with-test-org (agenda-file &rest body)
+  (declare (indent defun))
+  (let ((agenda-file (or agenda-file "test.org")))
+    `(let ((org-directory ".")
+           (org-agenda-files (list ,agenda-file))
+           (alert-default-style 'test-alert)
+           ;; TODO the fact that I have to include this from my own config is a
+           ;; really bad sign for the default value in the package
+           (org-alert-match-string
+            "SCHEDULED<\"<yesterday>\"+SCHEDULED<\"<tomorrow>\""))
+       (with-environment-variables (("TZ" "UTC4"))
+         (unwind-protect
+             (progn ,@body)
+           (test-alert-reset))))))
+
+(defmacro with-current-time (time &rest body)
+  "Override `current-time` to return `Sat May 20 09:40:01 2023`, 15 minutes
+before the scheduled event in `test.org`."
+  ;; (current-time-string '(25704 52657 0 0))
+  (declare (indent defun))
+  (let ((time (or time '(25704 52657 0 0))))
+    `(cl-letf (((symbol-function 'current-time)
+                (lambda () ',time)))
+       ,@body)))
+
 (ert-deftest org-alert-custom-cutoff ()
   "checks that we can extract the correct cutoff from the
  PROPERTIES of a subtree"
-  (let ((org-directory ".")
-	(org-agenda-files (list "test.org")))
+  (with-test-org nil
     (should (equal
-	     '(("remindern test" "09:55" 15))
-	     (org-map-entries 'org-alert--parse-entry org-alert-match-string 'agenda
-			      '(org-agenda-skip-entry-if 'todo
-							 org-done-keywords-for-agenda))))))
+             '(("remindern test" "09:55" 15))
+             (org-alert--map-entries 'org-alert--parse-entry)))))
+
+(ert-deftest check-alert-default ()
+  "Check that `org-alert-check` sends an alert from `test.org`.
+
+This works because the default `org-alert-notify-after-event-cutoff` is
+nil, so any time in the past will be alerted."
+  (with-test-org nil
+    (org-alert-check)
+    (should (= (length test-alert-notifications) 1))))
+
+(ert-deftest check-alert-none-cutoff ()
+  "Check that `org-alert-check` does not send an alert from `test.org` with
+a post-event cutoff set."
+  (with-test-org nil
+    (let ((org-alert-notify-after-event-cutoff 60))
+      (org-alert-check)
+      (should (= (length test-alert-notifications) 0)))))
 
-;; TODO idea here is generate an org file with a timestamp in the near future to
-;; check if the notification actually works
+(ert-deftest check-alert-some-remindern ()
+  "Check that `org-alert-check` sends an alert from `test.org` with
+a post-event cutoff set but the current time set appropriately."
+  (with-test-org nil
+    (with-current-time (25704 52667 0 0) ; 9:40:11
+      (let ((org-alert-notify-after-event-cutoff 60))
+        (should (= (length test-alert-notifications) 0))
+        (org-alert-check)
+        (should (= (length test-alert-notifications) 1))))))
 
-;; (let ((org-directory ".")
-;;       (org-agenda-files (list "test.org")))
-;;   (org-alert-check))
+(ert-deftest check-alert-none-remindern ()
+  "Check that `org-alert-check` does not send an alert from `test.org` with
+a post-event cutoff set but the current time set appropriately."
+  (with-test-org nil
+    ;; (current-time-string '(25704 52655 0 0)) => "Sat May 20 09:39:59 2023" or
+    ;; just before the notification should trigger
+    (with-current-time (25704 52655 0 0)
+      (let ((org-alert-notify-after-event-cutoff 60))
+        (org-alert-check)
+        (should (= (length test-alert-notifications) 0))))))
 
-;; (org-time-stamp '(16) nil)
-;; <2023-05-20 Sat 10:22>
+(ert-deftest check-alert-some ()
+  (with-test-org "plain.org"
+    (with-current-time (25704 52957 0 0) ; 9:45:01
+      (org-alert-check)
+      (should (= (length test-alert-notifications) 1)))))
 
+(ert-deftest check-alert-none ()
+  (with-test-org "plain.org"
+    (with-current-time (25704 52945 0 0) ; 9:44:49
+      (should (= (length test-alert-notifications) 0))
+      (org-alert-check)
+      (should (= (length test-alert-notifications) 0)))))