diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-agenda-query--bounds.el | 169 | ||||
| -rw-r--r-- | tests/test-agenda-query--occurrences.el | 242 | ||||
| -rw-r--r-- | tests/test-agenda-query.el | 381 |
3 files changed, 792 insertions, 0 deletions
diff --git a/tests/test-agenda-query--bounds.el b/tests/test-agenda-query--bounds.el new file mode 100644 index 00000000..9ee423e7 --- /dev/null +++ b/tests/test-agenda-query--bounds.el @@ -0,0 +1,169 @@ +;;; test-agenda-query--bounds.el --- Tests for timestamp bounds -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-timestamp-bounds', which turns an org-element +;; timestamp into epoch bounds for the JSON query. +;; +;; The contract under test: +;; - :start is the epoch of the timestamp's start. +;; - :end is the epoch of an explicit range end, or nil when the source has no +;; range. A null end is information the consumer cannot re-derive, so it is +;; never filled in with a guess. +;; - :all-day is t when the timestamp carries no hour. +;; - :effective-end is what the window predicate uses: the explicit end, or for +;; an all-day entry the end of its last day, or for a timed point event the +;; start itself. This is the "treat the day as its extent" rule, kept out of +;; :end so the reported shape stays faithful to the source. +;; +;; Helpers carry a file-unique prefix on purpose: the editor hook loads every +;; agenda-query test file into ONE process, so a shared helper name here would +;; silently redefine its namesake in a sibling file. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-aq-bounds--epoch (sec min hour day month year) + "Return the epoch second for the local time SEC MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list sec min hour day month year nil -1 nil)) + 'integer)) + +(defun test-aq-bounds--of (raw) + "Parse timestamp string RAW and return its bounds plist." + (cj/--agenda-query-timestamp-bounds (org-timestamp-from-string raw))) + +;;; Normal Cases + +(ert-deftest test-agenda-query-bounds-normal-timed-range () + "Normal: a same-day timed range reports both ends and is not all-day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 23:00-23:30>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 23 31 7 2026))) + (should (equal (plist-get b :end) + (test-aq-bounds--epoch 0 30 23 31 7 2026))) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :effective-end) (plist-get b :end))))) + +(ert-deftest test-agenda-query-bounds-normal-timed-point () + "Normal: a timed point event has no end, and its extent is the instant." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 14:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 14 31 7 2026))) + (should-not (plist-get b :end)) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :effective-end) (plist-get b :start))))) + +;;; Boundary Cases + +(ert-deftest test-agenda-query-bounds-boundary-all-day-extent () + "Boundary: an all-day entry reports no end but extends over its whole day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))) + (should-not (plist-get b :end)) + (should (plist-get b :all-day)) + ;; One second short of the next midnight -- the day is the extent. + (should (equal (plist-get b :effective-end) + (1- (test-aq-bounds--epoch 0 0 0 1 8 2026)))))) + +(ert-deftest test-agenda-query-bounds-boundary-multi-day-all-day () + "Boundary: a multi-day all-day range ends at the close of its last day." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri>--<2026-08-02 Sun>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))) + (should (plist-get b :all-day)) + (should (equal (plist-get b :end) + (1- (test-aq-bounds--epoch 0 0 0 3 8 2026)))) + (should (equal (plist-get b :effective-end) (plist-get b :end))))) + +(ert-deftest test-agenda-query-bounds-boundary-midnight-start () + "Boundary: an explicit 00:00 is a timed event, not an all-day one." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 00:00>"))) + (should-not (plist-get b :all-day)) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 31 7 2026))))) + +(ert-deftest test-agenda-query-bounds-boundary-dst-spring-forward () + "Boundary: a timestamp on a DST changeover day still resolves to one epoch. +US DST began 2026-03-08. The interface is epoch seconds precisely so the +consumer never has to know the source timestamps are naive local time." + (let ((b (test-aq-bounds--of "<2026-03-08 Sun 13:00>"))) + (should (integerp (plist-get b :start))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 13 8 3 2026))))) + +(ert-deftest test-agenda-query-bounds-boundary-dst-day-is-23-hours () + "Boundary: the day-extent rule follows real clock time, not a fixed 86400. +2026-03-08 loses an hour, so its all-day extent is one second short of 23 +hours. Adding a constant day would overshoot into the next day." + (let ((b (test-aq-bounds--of "<2026-03-08 Sun>"))) + (should (equal (plist-get b :effective-end) + (1- (test-aq-bounds--epoch 0 0 0 9 3 2026)))) + (should (= (- (plist-get b :effective-end) (plist-get b :start)) + (1- (* 23 3600)))))) + +(ert-deftest test-agenda-query-bounds-boundary-same-day-range-crosses-midnight () + "Boundary: a range whose end precedes its start is read as crossing midnight. + +Org records <2026-07-31 Fri 23:00-01:00> with day-end EQUAL to day-start, so +reading it literally puts the end 22 hours before the start. A negative +duration is meaningless to a renderer, and the row would also vanish from the +very window it belongs to, since its effective end would sit before the +window opens." + (let ((b (test-aq-bounds--of "<2026-07-31 Fri 23:00-01:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 23 31 7 2026))) + (should (equal (plist-get b :end) + (test-aq-bounds--epoch 0 0 1 1 8 2026))) + (should (> (plist-get b :end) (plist-get b :start))) + (should (= (- (plist-get b :end) (plist-get b :start)) (* 2 3600))))) + +(ert-deftest test-agenda-query-bounds-boundary-reversed-multi-day-range () + "Boundary: a genuinely reversed multi-day range reports no end at all. + +The midnight roll is scoped to same-day ranges, which is the shape org uses +for <23:00-01:00>. Rolling a reversed multi-day range would shift a wrong +date by one day and leave it still wrong, so instead the entry is reported as +a point -- a consumer can draw that, where a negative-duration bar is +meaningless." + (let ((b (test-aq-bounds--of "<2026-08-02 Sun 09:00>--<2026-07-31 Fri 08:00>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 9 2 8 2026))) + (should-not (plist-get b :end)) + (should (equal (plist-get b :effective-end) (plist-get b :start))))) + +(ert-deftest test-agenda-query-bounds-boundary-reversed-all-day-range () + "Boundary: a reversed ALL-DAY range also reports no end. + +The same malformed shape as the timed case, and the same consequence if it +slips through: the negative extent would sit before the start, so the entry +would vanish from the very day it opens on. A typo or a bad ICS import +produces this." + (let ((b (test-aq-bounds--of "<2026-08-05 Wed>--<2026-08-01 Sat>"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 0 5 8 2026))) + (should-not (plist-get b :end)) + ;; Falls back to its own day, so it still appears on 5 August. + (should (> (plist-get b :effective-end) (plist-get b :start))))) + +;;; Error Cases + +(ert-deftest test-agenda-query-bounds-error-inactive-still-computes () + "Error: bounds are purely arithmetic -- filtering inactive stamps is a +separate concern, so an inactive timestamp still yields usable bounds." + (let ((b (test-aq-bounds--of "[2026-07-31 Fri 09:00]"))) + (should (equal (plist-get b :start) + (test-aq-bounds--epoch 0 0 9 31 7 2026))))) + +(ert-deftest test-agenda-query-bounds-error-nil-timestamp () + "Error: a nil timestamp yields nil rather than signaling." + (should-not (cj/--agenda-query-timestamp-bounds nil))) + +(provide 'test-agenda-query--bounds) +;;; test-agenda-query--bounds.el ends here diff --git a/tests/test-agenda-query--occurrences.el b/tests/test-agenda-query--occurrences.el new file mode 100644 index 00000000..4fa73a0c --- /dev/null +++ b/tests/test-agenda-query--occurrences.el @@ -0,0 +1,242 @@ +;;; test-agenda-query--occurrences.el --- Tests for window + repeats -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-occurrences' and the repeater cookie helper. +;; +;; Two behaviors under test: +;; +;; 1. The window predicate is intersection, not containment. An event running +;; across the window's start edge is in the window -- on a live surface it is +;; the thing currently happening. +;; +;; 2. A repeating entry contributes one row per occurrence inside the window, +;; expanded through org's own arithmetic. The base timestamp of a long-lived +;; repeater sits far in the past, so returning it raw would put a task that is +;; genuinely due today outside the window entirely. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-agenda-query-occ--epoch (min hour day month year) + "Return the epoch for local MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list 0 min hour day month year nil -1 nil)) + 'integer)) + +(defun test-agenda-query-occ--of (raw start end) + "Return occurrences of timestamp string RAW within START..END." + (cj/--agenda-query-occurrences (org-timestamp-from-string raw) start end)) + +(defun test-agenda-query-occ--starts (raw start end) + "Return just the start epochs of RAW's occurrences within START..END." + (mapcar #'car (test-agenda-query-occ--of raw start end))) + +;;; ---------- repeater cookie ---------- + +(ert-deftest test-agenda-query-cookie-normal-all-three-styles () + "Normal: each repeater style round-trips to its raw cookie." + (should (equal "+1d" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed +1d>")))) + (should (equal "++2w" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed ++2w>")))) + (should (equal ".+3m" (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed .+3m>"))))) + +(ert-deftest test-agenda-query-cookie-boundary-none () + "Boundary: a plain timestamp has no cookie, and nil is not a cookie." + (should-not (cj/--agenda-query-repeater-cookie + (org-timestamp-from-string "<2026-07-01 Wed>"))) + (should-not (cj/--agenda-query-repeater-cookie nil))) + +;;; ---------- window predicate ---------- + +(ert-deftest test-agenda-query-occ-normal-inside-window () + "Normal: an event wholly inside the window is returned once, with its end." + (let* ((win-start (test-agenda-query-occ--epoch 0 8 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026)) + (occ (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end))) + (should (= 1 (length occ))) + (should (equal (caar occ) (test-agenda-query-occ--epoch 0 9 31 7 2026))) + (should (equal (cdar occ) (test-agenda-query-occ--epoch 0 10 31 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-overlaps-start-edge () + "Boundary: an event that began before the window but is still running is in. +This is the 23:00-01:00 case -- the whole reason the predicate is intersects +rather than starts-inside." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 1 8 2026)) + (win-end (test-agenda-query-occ--epoch 0 23 1 8 2026))) + (should (= 1 (length (test-agenda-query-occ--of + "<2026-07-31 Fri 23:00>--<2026-08-01 Sat 01:00>" + win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-touches-edge-exactly () + "Boundary: an event ending exactly at the window start is still included." + (let* ((win-start (test-agenda-query-occ--epoch 0 10 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026))) + (should (= 1 (length (test-agenda-query-occ--of + "<2026-07-31 Fri 09:00-10:00>" win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-all-day-covers-window () + "Boundary: an all-day entry covers any window inside its day." + (let* ((win-start (test-agenda-query-occ--epoch 0 13 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 30 13 31 7 2026)) + (occ (test-agenda-query-occ--of "<2026-07-31 Fri>" win-start win-end))) + (should (= 1 (length occ))) + ;; No range in the source, so no end is invented. + (should-not (cdar occ)))) + +(ert-deftest test-agenda-query-occ-boundary-outside-window () + "Boundary: an event finishing before the window opens is excluded." + (let* ((win-start (test-agenda-query-occ--epoch 0 12 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 18 31 7 2026))) + (should-not (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end)))) + +;;; ---------- repeat expansion ---------- + +(ert-deftest test-agenda-query-occ-normal-daily-repeat-reaches-today () + "Normal: a daily repeater based a month back yields today's occurrence. +Returning the raw base date would put a task genuinely due today far outside +the window -- this is the failure the expansion exists to prevent." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1d>" + win-start win-end))) + (should (equal starts (list (test-agenda-query-occ--epoch 0 9 31 7 2026)))))) + +(ert-deftest test-agenda-query-occ-normal-repeat-preserves-duration () + "Normal: an expanded occurrence keeps the base timestamp's duration." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (occ (car (test-agenda-query-occ--of "<2026-07-01 Wed 09:00-10:30 +1d>" + win-start win-end)))) + (should occ) + (should (equal (car occ) (test-agenda-query-occ--epoch 0 9 31 7 2026))) + (should (equal (cdr occ) (test-agenda-query-occ--epoch 30 10 31 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-one-row-per-occurrence () + "Boundary: a window wider than the interval yields a row per occurrence. +A count is derivable from rows; rows are not derivable from a count, so the +row form is what the query returns." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 27 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1d>" + win-start win-end))) + (should (= 5 (length starts))) + (should (equal starts + (list (test-agenda-query-occ--epoch 0 9 27 7 2026) + (test-agenda-query-occ--epoch 0 9 28 7 2026) + (test-agenda-query-occ--epoch 0 9 29 7 2026) + (test-agenda-query-occ--epoch 0 9 30 7 2026) + (test-agenda-query-occ--epoch 0 9 31 7 2026)))))) + +(ert-deftest test-agenda-query-occ-boundary-weekly-lands-on-its-day () + "Boundary: a weekly repeater yields only the days it actually falls on. +2026-07-01 is a Wednesday, so within Mon 27 -- Fri 31 July only Wed 29 counts." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 27 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (starts (test-agenda-query-occ--starts "<2026-07-01 Wed 09:00 +1w>" + win-start win-end))) + (should (equal starts (list (test-agenda-query-occ--epoch 0 9 29 7 2026)))))) + +(ert-deftest test-agenda-query-occ-boundary-restart-style-expands () + "Boundary: a .+ repeater expands from its base like any other style. + +Org rewrites a restart repeater's base timestamp when the task is completed, +so for an open task the base IS the last repeat and base-relative expansion is +what the agenda shows. All three styles agree here." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026)) + (expected (list (test-agenda-query-occ--epoch 0 9 31 7 2026)))) + (dolist (raw '("<2026-07-01 Wed 09:00 +1d>" + "<2026-07-01 Wed 09:00 ++1d>" + "<2026-07-01 Wed 09:00 .+1d>")) + (should (equal expected + (test-agenda-query-occ--starts raw win-start win-end)))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-not-yet-started () + "Boundary: a repeater whose base is after the window yields nothing." + (let* ((win-start (test-agenda-query-occ--epoch 0 0 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 31 7 2026))) + (should-not (test-agenda-query-occ--starts "<2026-12-01 Tue 09:00 +1d>" + win-start win-end)))) + +(ert-deftest test-agenda-query-occ-boundary-zero-value-repeater () + "Boundary: org treats a zero-value repeater as void, so it behaves as a +plain timestamp -- absent when its base is outside the window, and present +exactly once when the base is inside it. + +Both halves are asserted deliberately. The absent half alone would also pass +against an implementation with no repeater support at all, which makes it no +evidence about zero-value handling." + (should-not (test-agenda-query-occ--starts + "<2026-07-01 Wed 09:00 +0d>" + (test-agenda-query-occ--epoch 0 0 31 7 2026) + (test-agenda-query-occ--epoch 59 23 31 7 2026))) + (should (equal (list (test-agenda-query-occ--epoch 0 9 1 7 2026)) + (test-agenda-query-occ--starts + "<2026-07-01 Wed 09:00 +0d>" + (test-agenda-query-occ--epoch 0 0 1 7 2026) + (test-agenda-query-occ--epoch 59 23 1 7 2026))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-in-progress-at-window-start () + "Boundary: a repeating event that began before the window and is still +running is returned. + +The non-repeating path honors intersects-not-contains; the repeating path has +to as well. Scanning only days inside the window misses this, because the +occurrence's own day starts earlier: a nightly 22:00-02:00 job is the thing +actually happening at 03:00, and a renderer that drops it shows an empty slot +during the event." + (let ((raw "<2026-07-01 Wed 22:00 +1d>--<2026-07-02 Thu 02:00>")) + (should (= 1 (length (test-agenda-query-occ--of + raw + (test-agenda-query-occ--epoch 0 0 31 7 2026) + (test-agenda-query-occ--epoch 0 6 31 7 2026))))) + ;; The same occurrence seen from inside its own evening. + (should (= 1 (length (test-agenda-query-occ--of + raw + (test-agenda-query-occ--epoch 0 21 31 7 2026) + (test-agenda-query-occ--epoch 0 23 31 7 2026))))))) + +(ert-deftest test-agenda-query-occ-boundary-repeat-extent-follows-dst () + "Boundary: an all-day repeat's extent is recomputed per occurrence day. + +US DST ends 2026-11-01, making that day 25 hours long. Carrying the base +day's length forward as a fixed number of seconds leaves the occurrence +ending an hour early, so a window late on that day sees nothing while the +identical non-repeating entry is found." + (let ((win-start (test-agenda-query-occ--epoch 30 23 1 11 2026)) + (win-end (test-agenda-query-occ--epoch 59 23 1 11 2026))) + (should (= 1 (length (test-agenda-query-occ--of "<2026-07-01 Wed +1d>" + win-start win-end)))) + ;; The non-repeating control: same day, same window, must agree. + (should (= 1 (length (test-agenda-query-occ--of "<2026-11-01 Sun>" + win-start win-end)))))) + +;;; ---------- error cases ---------- + +(ert-deftest test-agenda-query-occ-error-inverted-window () + "Error: a window whose start is after its end matches nothing. +Without the guard the intersection test passes for any long-running event, +which would silently return rows for a nonsense request." + (let* ((win-start (test-agenda-query-occ--epoch 0 18 31 7 2026)) + (win-end (test-agenda-query-occ--epoch 0 8 31 7 2026))) + (should-not (test-agenda-query-occ--of "<2026-07-31 Fri 09:00-10:00>" + win-start win-end)) + (should-not (test-agenda-query-occ--of "<2026-07-01 Wed 09:00 +1d>" + win-start win-end)))) + +(ert-deftest test-agenda-query-occ-error-nil-timestamp () + "Error: a nil timestamp yields no occurrences rather than signaling." + (should-not (cj/--agenda-query-occurrences nil 0 100))) + +(provide 'test-agenda-query--occurrences) +;;; test-agenda-query--occurrences.el ends here diff --git a/tests/test-agenda-query.el b/tests/test-agenda-query.el new file mode 100644 index 00000000..4b6b0dc1 --- /dev/null +++ b/tests/test-agenda-query.el @@ -0,0 +1,381 @@ +;;; test-agenda-query.el --- Tests for the agenda JSON query -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for `cj/--agenda-query-buffer-events', `cj/agenda-window-json' and the +;; atomic writer. +;; +;; The load-bearing test here is the SCHEDULED/DEADLINE one. Org stores +;; planning timestamps as properties on a `planning' element rather than as +;; children in the parse tree, so the obvious implementation -- mapping over +;; \='timestamp -- returns neither, silently. A fixture without a SCHEDULED +;; entry would pass against that broken implementation, so every fixture that +;; matters carries one. +;; +;; Helpers carry a file-unique prefix on purpose: the editor hook loads every +;; agenda-query test file into ONE process, so a shared helper name here would +;; silently redefine its namesake in a sibling file. + +;;; Code: + +(require 'ert) +(require 'org) +(require 'org-element) +(require 'org-agenda) +(require 'seq) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'agenda-query) + +(defun test-aq-json--epoch (min hour day month year) + "Return the epoch for local MIN HOUR DAY MONTH YEAR." + (time-convert (encode-time (list 0 min hour day month year nil -1 nil)) + 'integer)) + +(defun test-aq-json--day-window () + "Return the window covering all of 2026-07-31 as a cons." + (cons (test-aq-json--epoch 0 0 31 7 2026) + (test-aq-json--epoch 59 23 31 7 2026))) + +(defmacro test-aq-json--with-org (text &rest body) + "Parse TEXT in an org-mode buffer and run BODY with `events' bound. +`events' holds the rows the buffer contributes for all of 2026-07-31." + (declare (indent 1)) + `(with-temp-buffer + (insert ,text) + (org-mode) + (let* ((window (test-aq-json--day-window)) + (events (cj/--agenda-query-buffer-events + (current-buffer) "/tmp/fixture.org" + (car window) (cdr window)))) + ,@body))) + +(defun test-aq-json--field (event key) + "Return EVENT's KEY, a symbol." + (alist-get key event)) + +(defun test-aq-json--of-type (events type) + "Return the EVENTS whose type is TYPE." + (seq-filter (lambda (e) (equal type (test-aq-json--field e 'type))) events)) + +(defmacro test-aq-json--with-agenda-file (text &rest body) + "Write TEXT to a temp agenda file and run BODY with `file' and `window' bound. +Kills the visited buffer afterwards so the run leaves no state behind." + (declare (indent 1)) + `(let* ((dir (make-temp-file "agenda-query-" t)) + (file (expand-file-name "todo.org" dir)) + (window (test-aq-json--day-window))) + (unwind-protect + (progn + (with-temp-file file (insert ,text)) + (let ((org-agenda-files (list file))) + ,@body)) + (dolist (buffer (buffer-list)) + (when (equal (buffer-file-name buffer) file) (kill-buffer buffer))) + (delete-directory dir t)))) + +;;; ---------- the planning-property trap ---------- + +(ert-deftest test-agenda-query-normal-scheduled-and-deadline-are-found () + "Normal: SCHEDULED and DEADLINE both reach the output. + +These are properties on the planning element, not children in the parse tree. +An implementation that maps over \='timestamp returns the body stamp only and +drops these two silently -- so this asserts they are present, not merely that +the count is right." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00> DEADLINE: <2026-07-31 Fri 17:00>\nBody <2026-07-31 Fri 14:00>\n" + (should (= 1 (length (test-aq-json--of-type events "scheduled")))) + (should (= 1 (length (test-aq-json--of-type events "deadline")))) + (should (= 1 (length (test-aq-json--of-type events "timestamp")))) + (should (equal (test-aq-json--epoch 0 9 31 7 2026) + (test-aq-json--field + (car (test-aq-json--of-type events "scheduled")) 'start))) + (should (equal (test-aq-json--epoch 0 17 31 7 2026) + (test-aq-json--field + (car (test-aq-json--of-type events "deadline")) 'start))))) + +(ert-deftest test-agenda-query-normal-scheduled-alone-is-found () + "Normal: an entry whose only timestamp is SCHEDULED still produces a row. +The positive control for the trap: with no body timestamp to mask it, a broken +implementation returns nothing at all here." + (test-aq-json--with-org + "* TODO Water plants\nSCHEDULED: <2026-07-31 Fri>\n" + (should (= 1 (length events))) + (should (equal "scheduled" (test-aq-json--field (car events) 'type))))) + +;;; ---------- field content ---------- + +(ert-deftest test-agenda-query-normal-title-is-stripped () + "Normal: the title carries no keyword, priority cookie or tags." + (test-aq-json--with-org + "* TODO [#A] Standup with Nerses :work:urgent:\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "Standup with Nerses" + (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-normal-title-renders-org-links () + "Normal: an org link in the title becomes its description text. + +Craig's captured web items carry link syntax in the headline, so this is not +hypothetical -- his live agenda has one today. A wallpaper showing +\"[[https://…][Tracking your habits]]\" is a bug the consumer cannot fix +without parsing org markup." + (test-aq-json--with-org + "* TODO [[https://orgmode.org/x][Tracking your habits]]\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "Tracking your habits" + (test-aq-json--field (car events) 'title)))) + ;; A bare link has no description, so its target is the best available text. + (test-aq-json--with-org + "* TODO [[https://orgmode.org/x]]\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (equal "https://orgmode.org/x" + (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-normal-location-and-organizer () + "Normal: LOCATION and ORGANIZER properties reach the row." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n:PROPERTIES:\n:LOCATION: Room 3\n:ORGANIZER: Nerses\n:END:\n" + (should (equal "Room 3" (test-aq-json--field (car events) 'location))) + (should (equal "Nerses" (test-aq-json--field (car events) 'organizer))))) + +(ert-deftest test-agenda-query-normal-completion-state () + "Normal: a closed entry reports done true and keeps its raw keyword. +Without this a DONE task carrying today's SCHEDULED renders as an upcoming +event, and the error compounds over a working day." + (test-aq-json--with-org + "* DONE Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (eq t (test-aq-json--field (car events) 'done))) + (should (equal "DONE" (test-aq-json--field (car events) 'keyword))))) + +(ert-deftest test-agenda-query-boundary-open-task-is-not-done () + "Boundary: an open task reports done false, not null or missing." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (eq :false (test-aq-json--field (car events) 'done))) + (should (equal "TODO" (test-aq-json--field (car events) 'keyword))))) + +(ert-deftest test-agenda-query-boundary-plain-headline-has-null-keyword () + "Boundary: an entry with no keyword reports null rather than an empty string." + (test-aq-json--with-org + "* Lunch\n<2026-07-31 Fri 12:00-13:00>\n" + (should (eq :null (test-aq-json--field (car events) 'keyword))) + (should (eq :false (test-aq-json--field (car events) 'done))))) + +(ert-deftest test-agenda-query-boundary-repeater-cookie-in-row () + "Boundary: a repeating entry carries its raw cookie so the consumer can mark it." + (test-aq-json--with-org + "* TODO Water plants\nSCHEDULED: <2026-07-01 Wed 09:00 +1d>\n" + (should (= 1 (length events))) + (should (equal "+1d" (test-aq-json--field (car events) 'repeater))) + (should (equal (test-aq-json--epoch 0 9 31 7 2026) + (test-aq-json--field (car events) 'start))))) + +(ert-deftest test-agenda-query-boundary-absent-fields-are-null () + "Boundary: absent optional values are null, so the shape stays stable." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-07-31 Fri>\n" + (let ((event (car events))) + (should (eq :null (test-aq-json--field event 'end))) + (should (eq :null (test-aq-json--field event 'location))) + (should (eq :null (test-aq-json--field event 'organizer))) + (should (eq :null (test-aq-json--field event 'repeater))) + (should (eq t (test-aq-json--field event 'all-day)))))) + +;;; ---------- selection ---------- + +(ert-deftest test-agenda-query-boundary-inactive-excluded () + "Boundary: an inactive timestamp never reaches an agenda, so it is excluded." + (test-aq-json--with-org + "* Note\nLogged [2026-07-31 Fri 10:00]\n" + (should-not events))) + +(ert-deftest test-agenda-query-boundary-nested-headlines-not-double-counted () + "Boundary: a child's timestamp belongs to the child alone. +Collecting per-headline by mapping a headline's whole subtree would attribute +each child stamp to every ancestor too." + (test-aq-json--with-org + "* Parent\nSCHEDULED: <2026-07-31 Fri 09:00>\n** Child\nSCHEDULED: <2026-07-31 Fri 11:00>\n" + (should (= 2 (length events))) + (should (equal '("Parent" "Child") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-archived-and-commented-excluded () + "Boundary: archived and commented subtrees are skipped, as org's agenda does. +A query that disagrees with the agenda Craig sees is worse than one returning +less, and both of these are off his agenda." + (test-aq-json--with-org + (concat "* Archived thing :ARCHIVE:\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + "* COMMENT Commented\nSCHEDULED: <2026-07-31 Fri 10:00>\n" + "* Live\nSCHEDULED: <2026-07-31 Fri 11:00>\n") + (should (equal '("Live") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-archive-applies-to-children () + "Boundary: archiving a parent takes its whole subtree off the agenda." + (test-aq-json--with-org + (concat "* Parent :ARCHIVE:\n** Child\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + "* Live\nSCHEDULED: <2026-07-31 Fri 11:00>\n") + (should (equal '("Live") + (mapcar (lambda (e) (test-aq-json--field e 'title)) events))))) + +(ert-deftest test-agenda-query-boundary-outside-window-excluded () + "Boundary: an entry on another day contributes nothing." + (test-aq-json--with-org + "* TODO Standup\nSCHEDULED: <2026-08-15 Sat 09:00>\n" + (should-not events))) + +(ert-deftest test-agenda-query-boundary-empty-buffer () + "Boundary: an empty buffer yields no rows." + (test-aq-json--with-org "" (should-not events))) + +;;; ---------- error cases ---------- + +(ert-deftest test-agenda-query-error-diary-sexp-is-skipped () + "Error: a diary sexp timestamp cannot expand to an instant, and is skipped +without signaling -- one unusable entry must not fail the whole query." + (test-aq-json--with-org + "* Floating\n<%%(diary-float t 3 3)>\n* TODO Standup\nSCHEDULED: <2026-07-31 Fri 09:00>\n" + (should (= 1 (length events))) + (should (equal "Standup" (test-aq-json--field (car events) 'title))))) + +(ert-deftest test-agenda-query-error-headline-without-timestamp () + "Error: an entry with no timestamp at all contributes nothing." + (test-aq-json--with-org "* TODO Someday\nJust prose.\n" + (should-not events))) + +;;; ---------- JSON output ---------- + +(ert-deftest test-agenda-query-normal-json-round-trips () + "Normal: the output parses as JSON and preserves the fields. +Booleans arrive as real JSON booleans and absent values as null, so the +consumer can test on them rather than string-matching." + (test-aq-json--with-agenda-file + "* DONE Standup\nSCHEDULED: <2026-07-31 Fri 09:00-09:30>\n" + (let* ((json (cj/agenda-window-json (car window) (cdr window))) + (parsed (json-parse-string json :object-type 'alist))) + (should (= 1 (length parsed))) + (let ((event (aref parsed 0))) + (should (equal "Standup" (alist-get 'title event))) + (should (eq t (alist-get 'done event))) + (should (eq :false (alist-get 'all-day event))) + (should (equal file (alist-get 'file event))) + (should (eq :null (alist-get 'repeater event))) + (should (equal (test-aq-json--epoch 30 9 31 7 2026) + (alist-get 'end event))))))) + +(ert-deftest test-agenda-query-boundary-json-empty-is-array () + "Boundary: an empty result is an empty JSON array, never null. +The consumer parses the same shape whether or not anything is scheduled." + (let ((org-agenda-files nil)) + (should (equal "[]" (cj/agenda-window-json 0 100))))) + +(ert-deftest test-agenda-query-boundary-json-sorted-by-start () + "Boundary: rows come back in start order regardless of file order." + (test-aq-json--with-agenda-file + "* Late\nSCHEDULED: <2026-07-31 Fri 17:00>\n* Early\nSCHEDULED: <2026-07-31 Fri 08:00>\n" + (let ((parsed (json-parse-string + (cj/agenda-window-json (car window) (cdr window)) + :object-type 'alist))) + (should (equal '("Early" "Late") + (mapcar (lambda (e) (alist-get 'title e)) + (append parsed nil))))))) + +(ert-deftest test-agenda-query-error-json-rejects-non-numeric-bounds () + "Error: a non-numeric bound signals rather than returning a wrong answer." + (should-error (cj/agenda-window-json "now" 100) :type 'wrong-type-argument) + (should-error (cj/agenda-window-json 0 nil) :type 'wrong-type-argument)) + +(ert-deftest test-agenda-query-error-rejects-absurdly-wide-window () + "Error: a window wider than the cap signals instead of trying to answer. + +This is the milliseconds-for-seconds mistake, which a JavaScript consumer +makes by passing `Date.now()' straight through. Answering it means building +tens of millions of rows inside the daemon Craig is working in; a renderer +losing one frame is much the cheaper failure." + (let ((org-agenda-files nil) + (now 1785474000)) + (should-error (cj/agenda-window-json now (* now 1000)) :type 'user-error) + ;; A window at the cap is still answered. + (should (equal "[]" (cj/agenda-window-json + now (+ now cj/agenda-query-max-window-seconds)))))) + +(ert-deftest test-agenda-query-error-rejects-millisecond-bounds () + "Error: BOTH bounds in milliseconds is rejected on magnitude. + +This is the likelier shape of the units mistake and the width cap cannot see +it: `Date.now()' and `Date.now() + 3600000' look like a 41-day window, so it +passes the width check and answers with timestamps in the year 58549. A +wrong answer that parses is worse than an error." + (let ((org-agenda-files nil) + (ms 1785474000000)) + (should-error (cj/agenda-window-json ms (+ ms 3600000)) :type 'user-error) + ;; The same instants in seconds are a perfectly ordinary request. + (should (equal "[]" (cj/agenda-window-json 1785474000 1785477600))))) + +;;; ---------- atomic write ---------- + +(ert-deftest test-agenda-query-normal-writes-file-atomically () + "Normal: OUT-PATH receives the JSON and no temp file is left behind." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir)) + (org-agenda-files nil)) + (unwind-protect + (progn + (should (equal "[]" (cj/agenda-window-json 0 100 out))) + (should (file-exists-p out)) + (with-temp-buffer + (insert-file-contents out) + (should (equal "[]" (buffer-string)))) + ;; The rename consumed the temp file; only the target remains. + (should (equal '("agenda.json") + (directory-files + dir nil directory-files-no-dot-files-regexp)))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-boundary-write-is-readable-by-others () + "Boundary: the written file is not left at the temp file's private 0600. + +`make-temp-file' creates 0600, and the rename carries that mode onto the +target. The whole point of OUT-PATH is that another process reads it, so a +private mode would work only while the reader runs as Craig." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir))) + (unwind-protect + (progn + (cj/--agenda-query-write-atomically out "[]") + ;; Readable beyond the owner, following the session umask... + (should (= (logand (file-modes out) #o044) + (logand #o044 (default-file-modes)))) + ;; ...but never executable. `default-file-modes' is 777 minus the + ;; umask, so using it unmasked publishes the JSON as 0755. + ;; No assertion that the mode differs from 0600: under umask 077 + ;; that IS the correct answer, and asserting otherwise would fail + ;; for a reason that has nothing to do with this code. + (should (zerop (logand (file-modes out) #o111)))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-boundary-write-replaces-existing () + "Boundary: an existing file is replaced wholesale, not appended to." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (out (expand-file-name "agenda.json" dir))) + (unwind-protect + (progn + (with-temp-file out (insert "stale content that is much longer")) + (cj/--agenda-query-write-atomically out "[]") + (with-temp-buffer + (insert-file-contents out) + (should (equal "[]" (buffer-string))))) + (delete-directory dir t)))) + +(ert-deftest test-agenda-query-error-write-to-missing-dir-preserves-target () + "Error: a write into a nonexistent directory signals and litters nothing." + (let* ((dir (make-temp-file "agenda-query-out-" t)) + (missing (expand-file-name "nope/agenda.json" dir))) + (unwind-protect + (progn + (should-error (cj/--agenda-query-write-atomically missing "[]")) + (should-not (file-exists-p missing)) + (should-not (directory-files + dir nil directory-files-no-dot-files-regexp))) + (delete-directory dir t)))) + +(provide 'test-agenda-query) +;;; test-agenda-query.el ends here |