Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add more tests and run in CI #44

Merged
merged 21 commits into from
Dec 25, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 33 additions & 0 deletions .github/workflows/test.yml
Original file line number Diff line number Diff line change
@@ -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
9 changes: 9 additions & 0 deletions ci.sh
Original file line number Diff line number Diff line change
@@ -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
61 changes: 32 additions & 29 deletions org-alert.el
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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 ()
Expand All @@ -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 ()
Expand All @@ -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
7 changes: 7 additions & 0 deletions test/Makefile
Original file line number Diff line number Diff line change
@@ -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
2 changes: 2 additions & 0 deletions test/plain.org
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
* TODO regular test
SCHEDULED: <2023-05-20 Sat 09:55>
99 changes: 86 additions & 13 deletions test/test.el
Original file line number Diff line number Diff line change
@@ -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)))))
Loading