diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-bootstrap-packages.bats | 142 | ||||
| -rw-r--r-- | tests/test-calendar-sync--batch-failures.el | 47 | ||||
| -rw-r--r-- | tests/test-calendar-sync--batch-report.el | 89 | ||||
| -rw-r--r-- | tests/test-calendar-sync--batch-results.el | 59 | ||||
| -rw-r--r-- | tests/test-calendar-sync--batch-wait.el | 68 | ||||
| -rw-r--r-- | tests/test-calendar-sync--sync-dispatch.el | 39 | ||||
| -rw-r--r-- | tests/test-calendar-sync-run.bats | 116 | ||||
| -rw-r--r-- | tests/test-google-keep-config--local-config.el | 52 | ||||
| -rw-r--r-- | tests/test-music-config--append-track-to-m3u-file.el | 231 | ||||
| -rw-r--r-- | tests/test-package-resilience.el | 504 | ||||
| -rw-r--r-- | tests/test-system-lib-auth-source-secret-value.el | 39 | ||||
| -rw-r--r-- | tests/test-video-audio-recording--keybindings.el | 130 |
12 files changed, 1511 insertions, 5 deletions
diff --git a/tests/test-bootstrap-packages.bats b/tests/test-bootstrap-packages.bats new file mode 100644 index 00000000..7e511152 --- /dev/null +++ b/tests/test-bootstrap-packages.bats @@ -0,0 +1,142 @@ +#!/usr/bin/env bats +# Tests for scripts/bootstrap-packages.sh — the headless package installer. +# +# The elisp tests cover what happens inside one Emacs. What only a shell test +# can cover is the pass loop: whether a run that reports packages still missing +# gets another pass, whether a run that converges stops early, and whether a +# broken init breaks out instead of burning every pass on the same failure. +# +# Every test drives a fake emacs whose exit statuses are scripted, so no test +# touches the network, the real elpa directory, or a real Emacs. The script +# honours $EMACS, which is the seam these hang on. + +setup() { + SCRIPT="${BATS_TEST_DIRNAME}/../scripts/bootstrap-packages.sh" + BIN="${BATS_TEST_TMPDIR}/bin" + COUNTER="${BATS_TEST_TMPDIR}/attempts" + mkdir -p "$BIN" + echo 0 >"$COUNTER" + export BOOTSTRAP_PASSES=3 + export BOOTSTRAP_TIMEOUT=30 + # Point the script at a scratch config dir rather than the real checkout, so + # the byte-compiled-modules check reads fixture state instead of whatever + # this working tree happens to have compiled. + export BOOTSTRAP_DIR="${BATS_TEST_TMPDIR}/emacsd" + mkdir -p "$BOOTSTRAP_DIR/modules" +} + +# Write a fake emacs that exits with the given statuses in order, repeating the +# last one once the list runs out. Status 1 also prints the "still missing" +# line the real cj/package-bootstrap-batch prints, so the script's grep is +# exercised rather than assumed. +fake_emacs() { + { + echo '#!/usr/bin/env bash' + echo "n=\$(cat '$COUNTER')" + echo "n=\$((n + 1))" + echo "echo \$n >'$COUNTER'" + echo "statuses=($*)" + echo 'idx=$((n - 1))' + echo 'last=$((${#statuses[@]} - 1))' + echo '[ $idx -gt $last ] && idx=$last' + echo 'status=${statuses[$idx]}' + echo '[ "$status" -eq 1 ] && echo "package-bootstrap: 2 missing: foo bar"' + echo 'exit $status' + } >"$BIN/emacs" + chmod +x "$BIN/emacs" + export EMACS="$BIN/emacs" +} + +attempts() { cat "$COUNTER"; } + +@test "normal: a clean first pass succeeds and stops there" { + fake_emacs 0 + run bash "$SCRIPT" + [ "$status" -eq 0 ] + [ "$(attempts)" -eq 1 ] + [[ "$output" == *"every package is installed"* ]] +} + +@test "normal: a pass reporting missing packages is retried until it converges" { + fake_emacs 1 0 + run bash "$SCRIPT" + [ "$status" -eq 0 ] + [ "$(attempts)" -eq 2 ] + [[ "$output" == *"2 missing: foo bar"* ]] +} + +@test "error: packages that never install exhaust the passes and fail" { + fake_emacs 1 + run bash "$SCRIPT" + [ "$status" -eq 1 ] + [ "$(attempts)" -eq 3 ] + [[ "$output" == *"FAILED"* ]] +} + +@test "error: exit 1 without a missing-packages line is not blamed on packages" { + # The fake exits 1 silently, which is any other failure, not a short install. + { + echo '#!/usr/bin/env bash' + echo "n=\$(cat '$COUNTER'); echo \$((n + 1)) >'$COUNTER'" + echo 'exit 1' + } >"$BIN/emacs" + chmod +x "$BIN/emacs" + export EMACS="$BIN/emacs" + run bash "$SCRIPT" + [ "$status" -eq 1 ] + [ "$(attempts)" -eq 1 ] + [[ "$output" == *"without reporting missing packages"* ]] +} + +@test "error: a broken init breaks out instead of burning every pass" { + fake_emacs 255 + run bash "$SCRIPT" + [ "$status" -eq 255 ] + [ "$(attempts)" -eq 1 ] + [[ "$output" == *"failed to load init"* ]] +} + +@test "boundary: a timed-out pass is reported and still retried" { + fake_emacs 124 0 + run bash "$SCRIPT" + [ "$status" -eq 0 ] + [ "$(attempts)" -eq 2 ] + [[ "$output" == *"timeout"* ]] +} + +@test "boundary: the pass ceiling is honoured" { + export BOOTSTRAP_PASSES=1 + fake_emacs 1 + run bash "$SCRIPT" + [ "$status" -eq 1 ] + [ "$(attempts)" -eq 1 ] +} + +@test "error: a byte-compiled tree is refused rather than passed vacuously" { + touch "$BOOTSTRAP_DIR/modules/foo.elc" + fake_emacs 0 + run bash "$SCRIPT" + [ "$status" -eq 2 ] + [ "$(attempts)" -eq 0 ] + [[ "$output" == *"REFUSING"* ]] + [[ "$output" == *"clean-compiled"* ]] + [[ "$output" != *"every package is installed"* ]] +} + +@test "boundary: a zero pass ceiling fails cleanly without a tail error" { + export BOOTSTRAP_PASSES=0 + fake_emacs 0 + run bash "$SCRIPT" + [ "$status" -ne 0 ] + [ "$(attempts)" -eq 0 ] + [[ "$output" != *"cannot open"* ]] + [[ "$output" == *"FAILED after 0 pass"* ]] +} + +@test "boundary: recovery on the final allowed pass still succeeds" { + export BOOTSTRAP_PASSES=3 + fake_emacs 1 1 0 + run bash "$SCRIPT" + [ "$status" -eq 0 ] + [ "$(attempts)" -eq 3 ] +} diff --git a/tests/test-calendar-sync--batch-failures.el b/tests/test-calendar-sync--batch-failures.el new file mode 100644 index 00000000..3190be21 --- /dev/null +++ b/tests/test-calendar-sync--batch-failures.el @@ -0,0 +1,47 @@ +;;; test-calendar-sync--batch-failures.el --- Batch failure filter tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; `calendar-sync--batch-failures' picks the rows that did not finish cleanly. +;; The batch runner's exit code is derived from it, and systemd reads that exit +;; code, so the rule is deliberately strict: only `ok' passes. A calendar left +;; `syncing' at the timeout, or one that never started, is a failure -- both +;; states mean the org file on disk is not the calendar's current contents, +;; which is exactly the silent staleness the timer exists to prevent. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +(ert-deftest test-calendar-sync-batch-failures-keeps-only-non-ok () + "Normal: an errored calendar is returned and a healthy one is not." + (should (equal (calendar-sync--batch-failures + '(("google" . ok) ("proton" . error))) + '(("proton" . error))))) + +(ert-deftest test-calendar-sync-batch-failures-all-ok-is-empty () + "Normal: a fully successful run reports no failures." + (should (equal (calendar-sync--batch-failures + '(("google" . ok) ("proton" . ok))) + '()))) + +(ert-deftest test-calendar-sync-batch-failures-empty-input-is-empty () + "Boundary: no rows in, no rows out." + (should (equal (calendar-sync--batch-failures '()) '()))) + +(ert-deftest test-calendar-sync-batch-failures-timeout-counts-as-failure () + "Error: a calendar still `syncing' when the wait expired is a failure. +Its org file was not rewritten, so reporting success would hide the staleness." + (should (equal (calendar-sync--batch-failures + '(("google" . ok) ("proton" . syncing))) + '(("proton" . syncing))))) + +(ert-deftest test-calendar-sync-batch-failures-never-counts-as-failure () + "Error: a calendar that never started is a failure, not a skip." + (should (equal (calendar-sync--batch-failures '(("google" . never))) + '(("google" . never))))) + +(provide 'test-calendar-sync--batch-failures) +;;; test-calendar-sync--batch-failures.el ends here diff --git a/tests/test-calendar-sync--batch-report.el b/tests/test-calendar-sync--batch-report.el new file mode 100644 index 00000000..12811200 --- /dev/null +++ b/tests/test-calendar-sync--batch-report.el @@ -0,0 +1,89 @@ +;;; test-calendar-sync--batch-report.el --- Batch report output tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; `calendar-sync-batch-run-and-report' is what the systemd timer runs, so its +;; printed rows are the only record that survives the process. Batch Emacs +;; discards *Messages* at exit, which is where the interactive failure path +;; logs its reason -- so a failed row has to carry its recorded `:last-error' +;; in the printed output or the journal shows "error" with no way to tell a +;; cold gpg-agent from a revoked feed token or a dead network. + +;;; Code: + +(require 'ert) +(require 'cl-lib) ;; cl-letf; calendar-sync pulls it in transitively, don't rely on that + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +(defun test-calendar-sync-batch-report--capture (states results) + "Return the report's printed output for STATES and RESULTS. +STATES is an alist of NAME . PLIST seeded into the state table; RESULTS is +what `calendar-sync-batch-run' is stubbed to return, so the report is +exercised without driving a real sync." + (let ((calendar-sync--calendar-states (make-hash-table :test 'equal))) + (dolist (entry states) + (puthash (car entry) (cdr entry) calendar-sync--calendar-states)) + (cl-letf (((symbol-function 'calendar-sync-batch-run) + (lambda (&rest _) results))) + (with-output-to-string + (calendar-sync-batch-run-and-report))))) + +;;; Normal + +(ert-deftest test-calendar-sync-batch-report-failed-row-carries-its-reason () + "Normal: a failed calendar prints the recorded `:last-error' reason. +Without it the journal records only \"error\", and the operator cannot tell a +cold gpg-agent from a revoked token without re-running the sync by hand." + (let ((out (test-calendar-sync-batch-report--capture + '(("google" . (:status error :last-error "Decryption failed")) + ("proton" . (:status ok))) + '(("google" . error) ("proton" . ok))))) + (should (string-match-p "google: error" out)) + (should (string-match-p "Decryption failed" out)))) + +(ert-deftest test-calendar-sync-batch-report-ok-row-stays-bare () + "Normal: a calendar that synced prints its status and nothing more. +A stale `:last-error' from an earlier failure must not be appended to a row +that succeeded this run." + (let ((out (test-calendar-sync-batch-report--capture + '(("google" . (:status ok :last-error "Decryption failed"))) + '(("google" . ok))))) + (should (string-match-p "google: ok" out)) + (should-not (string-match-p "Decryption failed" out)))) + +;;; Boundary + +(ert-deftest test-calendar-sync-batch-report-failure-without-reason-still-prints () + "Boundary: a failed row with no recorded reason prints its status alone. +`never' and `syncing' never record a `:last-error', so the reason lookup has +to tolerate nil rather than printing \"nil\" or signalling." + (let ((out (test-calendar-sync-batch-report--capture + '(("google" . (:status syncing))) + '(("google" . syncing) ("absent" . never))))) + (should (string-match-p "google: syncing" out)) + (should (string-match-p "absent: never" out)) + (should-not (string-match-p "nil" out)))) + +;;; Error + +(defun test-calendar-sync-batch-report--exit-code (results) + "Return the report's exit code for RESULTS, discarding its printed output." + (let ((calendar-sync--calendar-states (make-hash-table :test 'equal))) + (cl-letf (((symbol-function 'calendar-sync-batch-run) + (lambda (&rest _) results))) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (calendar-sync-batch-run-and-report)))))) + +(ert-deftest test-calendar-sync-batch-report-exit-code-tracks-failures () + "Error: the return value becomes the process exit code, so it stays 1 on any +non-ok row and 0 only when every calendar synced. Appending the reason to the +printed line must not disturb it." + (should (equal 1 (test-calendar-sync-batch-report--exit-code '(("google" . error))))) + (should (equal 1 (test-calendar-sync-batch-report--exit-code + '(("google" . ok) ("proton" . never))))) + (should (equal 0 (test-calendar-sync-batch-report--exit-code '(("google" . ok)))))) + +(provide 'test-calendar-sync--batch-report) +;;; test-calendar-sync--batch-report.el ends here diff --git a/tests/test-calendar-sync--batch-results.el b/tests/test-calendar-sync--batch-results.el new file mode 100644 index 00000000..03ee2aee --- /dev/null +++ b/tests/test-calendar-sync--batch-results.el @@ -0,0 +1,59 @@ +;;; test-calendar-sync--batch-results.el --- Batch result collection tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; `calendar-sync--batch-results' reads the per-calendar state table and +;; returns one (NAME . STATUS) pair per requested calendar. The batch runner +;; turns that into an exit code, so a calendar that never reached the table at +;; all has to read as `never' rather than nil -- a nil status would compare +;; equal to nothing and quietly drop out of the failure count. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +(defun test-calendar-sync-batch-results--with-states (states body) + "Run BODY with STATES (an alist of NAME . PLIST) in the state table." + (let ((calendar-sync--calendar-states (make-hash-table :test 'equal))) + (dolist (entry states) + (puthash (car entry) (cdr entry) calendar-sync--calendar-states)) + (funcall body))) + +(ert-deftest test-calendar-sync-batch-results-reports-each-status () + "Normal: every requested calendar comes back with its recorded status." + (test-calendar-sync-batch-results--with-states + '(("google" . (:status ok)) + ("proton" . (:status error :last-error "boom"))) + (lambda () + (should (equal (calendar-sync--batch-results '("google" "proton")) + '(("google" . ok) ("proton" . error))))))) + +(ert-deftest test-calendar-sync-batch-results-empty-names-is-empty () + "Boundary: no calendars requested yields no rows, not an error." + (test-calendar-sync-batch-results--with-states + '(("google" . (:status ok))) + (lambda () + (should (equal (calendar-sync--batch-results '()) '()))))) + +(ert-deftest test-calendar-sync-batch-results-missing-calendar-reads-never () + "Error: a calendar absent from the state table reads `never', never nil. +A nil status would drop out of the failure count and report success for a +calendar that never ran." + (test-calendar-sync-batch-results--with-states + '(("google" . (:status ok))) + (lambda () + (should (equal (calendar-sync--batch-results '("google" "absent")) + '(("google" . ok) ("absent" . never))))))) + +(ert-deftest test-calendar-sync-batch-results-preserves-request-order () + "Boundary: rows come back in the order asked for, not hash order." + (test-calendar-sync-batch-results--with-states + '(("a" . (:status ok)) ("b" . (:status ok)) ("c" . (:status ok))) + (lambda () + (should (equal (mapcar #'car (calendar-sync--batch-results '("c" "a" "b"))) + '("c" "a" "b")))))) + +(provide 'test-calendar-sync--batch-results) +;;; test-calendar-sync--batch-results.el ends here diff --git a/tests/test-calendar-sync--batch-wait.el b/tests/test-calendar-sync--batch-wait.el new file mode 100644 index 00000000..7deee5e1 --- /dev/null +++ b/tests/test-calendar-sync--batch-wait.el @@ -0,0 +1,68 @@ +;;; test-calendar-sync--batch-wait.el --- Batch wait-loop tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; The sync pipeline is asynchronous end to end: curl runs in one process and +;; the org conversion in a second batch Emacs. Under `emacs --batch' the +;; process exits as soon as the top-level form returns, killing both children +;; mid-flight -- a run that does nothing and reports success. +;; +;; `calendar-sync--batch-wait' is what stops that: it blocks until every +;; calendar has left the `syncing' state, or until the timeout expires. These +;; tests drive it with a stubbed state predicate, so the loop's exit conditions +;; are covered without a live network fetch. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'calendar-sync) + +(ert-deftest test-calendar-sync-batch-wait-returns-when-nothing-in-flight () + "Normal: with no calendar syncing the wait returns success immediately." + (let ((polls 0)) + (cl-letf (((symbol-function 'calendar-sync--syncing-p) (lambda (_) nil)) + ((symbol-function 'accept-process-output) + (lambda (&rest _) (setq polls (1+ polls))))) + (should (calendar-sync--batch-wait '("google" "proton") 5)) + (should (= polls 0))))) + +(ert-deftest test-calendar-sync-batch-wait-blocks-until-settled () + "Normal: the wait polls while a sync is in flight and returns once it lands." + (let ((remaining 3) + (polls 0)) + (cl-letf (((symbol-function 'calendar-sync--syncing-p) + (lambda (_) (> remaining 0))) + ((symbol-function 'accept-process-output) + (lambda (&rest _) + (setq polls (1+ polls)) + (setq remaining (1- remaining))))) + (should (calendar-sync--batch-wait '("google") 5)) + (should (= polls 3))))) + +(ert-deftest test-calendar-sync-batch-wait-empty-names-returns-immediately () + "Boundary: no calendars to wait on settles at once." + (let ((polls 0)) + (cl-letf (((symbol-function 'accept-process-output) + (lambda (&rest _) (setq polls (1+ polls))))) + (should (calendar-sync--batch-wait '() 5)) + (should (= polls 0))))) + +(ert-deftest test-calendar-sync-batch-wait-times-out-when-stuck () + "Error: a sync that never settles returns nil once the timeout expires. +Returning nil is what lets the runner exit non-zero instead of reporting a +success it cannot vouch for." + (let ((calendar-sync--batch-poll-seconds 0.01)) + (cl-letf (((symbol-function 'calendar-sync--syncing-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) (lambda (&rest _) nil))) + (should-not (calendar-sync--batch-wait '("google") 0.05))))) + +(ert-deftest test-calendar-sync-batch-wait-zero-timeout-does-not-hang () + "Boundary: a zero timeout returns at once rather than looping forever." + (cl-letf (((symbol-function 'calendar-sync--syncing-p) (lambda (_) t)) + ((symbol-function 'accept-process-output) (lambda (&rest _) nil))) + (should-not (calendar-sync--batch-wait '("google") 0)))) + +(provide 'test-calendar-sync--batch-wait) +;;; test-calendar-sync--batch-wait.el ends here diff --git a/tests/test-calendar-sync--sync-dispatch.el b/tests/test-calendar-sync--sync-dispatch.el index 22deeef0..9b12b167 100644 --- a/tests/test-calendar-sync--sync-dispatch.el +++ b/tests/test-calendar-sync--sync-dispatch.el @@ -77,5 +77,44 @@ than crashing." (should (equal (list cal) ics-calls)) (should (null api-calls))))) +(ert-deftest test-calendar-sync--sync-dispatch-error-leaf-signal-is-contained () + "Error: a syncer that signals marks the calendar failed instead of propagating. + +Resolving a `:secret-host' feed reads authinfo.gpg, and a cold gpg-agent makes +that signal a `file-error' before any process starts — so the failure arrives +synchronously, where the async callbacks that normally record a failure never +run." + (let ((failed '()) + (calendar-sync--calendar-states (make-hash-table :test 'equal))) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (_) (signal 'file-error '("Decryption failed")))) + ((symbol-function 'calendar-sync--mark-sync-failed) + (lambda (name reason) (push (cons name reason) failed)))) + (calendar-sync--sync-calendar + '(:name "google" :url "https://x/y.ics" :file "/tmp/c.org")) + (should (equal "google" (car (car failed))))))) + +(ert-deftest test-calendar-sync--sync-all-continues-past-a-failing-calendar () + "Error: one calendar's synchronous failure does not stop the ones after it. + +This is the whole cost of leaving the signal uncontained: on a machine whose +feeds resolve through authinfo, the first calendar's decryption error aborted +the entire run, so calendars that would have synced fine never got the chance." + (let ((synced '()) + (calendar-sync--calendar-states (make-hash-table :test 'equal)) + (calendar-sync-calendars + '((:name "bad" :url "https://x/a.ics" :file "/tmp/a.org") + (:name "good" :url "https://x/b.ics" :file "/tmp/b.org")))) + (cl-letf (((symbol-function 'calendar-sync--sync-calendar-ics) + (lambda (cal) + (if (equal (plist-get cal :name) "bad") + (signal 'file-error '("Decryption failed")) + (push (plist-get cal :name) synced)))) + ((symbol-function 'calendar-sync--mark-sync-failed) + (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil))) + (calendar-sync--sync-all-calendars) + (should (equal '("good") synced))))) + (provide 'test-calendar-sync--sync-dispatch) ;;; test-calendar-sync--sync-dispatch.el ends here diff --git a/tests/test-calendar-sync-run.bats b/tests/test-calendar-sync-run.bats new file mode 100644 index 00000000..da817060 --- /dev/null +++ b/tests/test-calendar-sync-run.bats @@ -0,0 +1,116 @@ +#!/usr/bin/env bats +# Tests for scripts/calendar-sync-run — the batch syncer behind the timer. +# +# The elisp tests cover the wait loop and the result tally with the state +# predicate stubbed. What only a shell test can cover is the thing that makes +# the whole script necessary: the sync pipeline is asynchronous end to end +# (curl in one process, the org conversion in a second batch Emacs), and a +# batch Emacs exits as soon as its top-level form returns. A version that +# launches the fetch and returns would exit zero, write nothing, and look +# exactly like a success. Every assertion here that checks the output file +# exists is really asserting that the script waited. +# +# Isolation rules, mirroring test-agenda-render-cache.bats: +# +# EMACS_D points at THIS checkout, so a broken tree cannot pass by running +# the installed config's elisp. +# +# CALENDAR_SYNC_CONFIG and CALENDAR_SYNC_STATE point at fixtures, so the run +# neither reads Craig's real feed URLs nor writes his persisted sync state. +# +# The feed is a file:// URL served to the script's own curl. That keeps the +# test hermetic -- no network, no live calendar -- while still exercising the +# real fetch path rather than a stub. + +setup() { + SCRIPT="${BATS_TEST_DIRNAME}/../scripts/calendar-sync-run" + export EMACS_D="${BATS_TEST_DIRNAME}/.." + export CALENDAR_SYNC_STATE="${BATS_TEST_TMPDIR}/state.el" + export CALENDAR_SYNC_TIMEOUT=120 + + OUT="${BATS_TEST_TMPDIR}/testcal.org" + ICS="${BATS_TEST_TMPDIR}/feed.ics" + TODAY="$(date +%Y%m%d)" + + cat > "$ICS" <<-EOF + BEGIN:VCALENDAR + VERSION:2.0 + PRODID:-//bats//test//EN + BEGIN:VEVENT + UID:bats-fixture-1 + DTSTART:${TODAY}T140000Z + DTEND:${TODAY}T150000Z + SUMMARY:Batch Fixture Event + END:VEVENT + END:VCALENDAR + EOF + + write_config "file://${ICS}" +} + +# The calendar list is normally private config; the test writes its own so the +# feed URL is a local file and the output lands in the temp dir. +write_config() { + export CALENDAR_SYNC_CONFIG="${BATS_TEST_TMPDIR}/config.el" + cat > "$CALENDAR_SYNC_CONFIG" <<-EOF + (setq calendar-sync-calendars + (list (list :name "testcal" :url "$1" :file "${OUT}"))) + EOF +} + +@test "the script is executable" { + [ -x "$SCRIPT" ] +} + +@test "waits for the async pipeline and writes the org file" { + run "$SCRIPT" + [ "$status" -eq 0 ] + # The file existing at all is the assertion: it is written by a grandchild + # process, so a script that did not wait would have exited before this. + [ -f "$OUT" ] + grep -q "Batch Fixture Event" "$OUT" +} + +@test "reports the calendar and its status on stdout" { + run "$SCRIPT" + [ "$status" -eq 0 ] + [[ "$output" == *"testcal: ok"* ]] +} + +@test "a failed fetch exits non-zero so systemd records it" { + write_config "file://${BATS_TEST_TMPDIR}/does-not-exist.ics" + run "$SCRIPT" + [ "$status" -ne 0 ] + [ ! -f "$OUT" ] +} + +@test "a failed fetch names the calendar rather than failing silently" { + write_config "file://${BATS_TEST_TMPDIR}/does-not-exist.ics" + run "$SCRIPT" + [[ "$output" == *"testcal"* ]] + [[ "$output" != *"testcal: ok"* ]] +} + +@test "a failed fetch prints why, not just that it failed" { + # The interactive path logs the reason to *Messages*, which batch Emacs + # discards at exit. Without the reason on stdout the journal shows only + # "error" -- no way to tell a cold gpg-agent from a revoked feed token. + write_config "file://${BATS_TEST_TMPDIR}/does-not-exist.ics" + run "$SCRIPT" + [[ "$output" == *"testcal: error"* ]] + [[ "$output" == *"Fetch failed"* ]] +} + +@test "refuses to run against a checkout with no modules directory" { + EMACS_D="${BATS_TEST_TMPDIR}/empty" run "$SCRIPT" + [ "$status" -ne 0 ] + [[ "$output" == *"no modules directory"* ]] +} + +@test "does not write the real session's sync state" { + run "$SCRIPT" + [ "$status" -eq 0 ] + # The state override is honoured, so a timer run cannot corrupt or race + # the interactive session's persisted state. + [ -f "$CALENDAR_SYNC_STATE" ] +} diff --git a/tests/test-google-keep-config--local-config.el b/tests/test-google-keep-config--local-config.el new file mode 100644 index 00000000..18769c5a --- /dev/null +++ b/tests/test-google-keep-config--local-config.el @@ -0,0 +1,52 @@ +;;; test-google-keep-config--local-config.el --- Tests for the Keep machine-local config loader -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for cj/keep--load-local-config, the loader for the gitignored +;; machine-local google-keep.local.el (venv interpreter path, account email) — +;; the same shape calendar-sync uses for calendar-sync.local.el. + +;;; Code: + +(require 'ert) +(require 'google-keep-config) + +(ert-deftest test-google-keep-local-config-loads-readable-file () + "Normal: a readable local config file is loaded and its settings apply." + (let ((file (make-temp-file "keep-local-" nil ".el"))) + (unwind-protect + (progn + (with-temp-file file + (insert "(setq test-google-keep--local-marker 'loaded)")) + (defvar test-google-keep--local-marker nil) + (setq test-google-keep--local-marker nil) + (let ((cj/keep-local-config-file file)) + (should (cj/keep--load-local-config)) + (should (eq test-google-keep--local-marker 'loaded)))) + (delete-file file)))) + +(ert-deftest test-google-keep-local-config-missing-file-is-quiet () + "Boundary: an absent local config file is a silent no-op, no error." + (let ((cj/keep-local-config-file "/nonexistent/google-keep.local.el")) + (should-not (cj/keep--load-local-config)))) + +(ert-deftest test-google-keep-local-config-broken-file-does-not-signal () + "Error: a local config file with a broken form is caught and reported, +never propagated as a load-time error." + (let ((file (make-temp-file "keep-local-broken-" nil ".el")) + (messages nil)) + (unwind-protect + (progn + (with-temp-file file + (insert "(error \"deliberately broken local config\")")) + (let ((cj/keep-local-config-file file)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (push (apply #'format fmt args) messages) + nil))) + (should-not (cj/keep--load-local-config))) + (should (seq-find (lambda (m) (string-match-p "google-keep.*local config" m)) + messages)))) + (delete-file file)))) + +(provide 'test-google-keep-config--local-config) +;;; test-google-keep-config--local-config.el ends here diff --git a/tests/test-music-config--append-track-to-m3u-file.el b/tests/test-music-config--append-track-to-m3u-file.el index be0cbd8e..cc40438c 100644 --- a/tests/test-music-config--append-track-to-m3u-file.el +++ b/tests/test-music-config--append-track-to-m3u-file.el @@ -39,7 +39,8 @@ "Append to brand new empty M3U file." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) (track-path (expand-file-name "artist/song.mp3" cj/music-root)) (expected-relative "artist/song.mp3")) (cj/music--append-track-to-m3u-file track-path m3u-file) @@ -53,6 +54,7 @@ (test-music-config--append-track-to-m3u-file-setup) (unwind-protect (let* ((existing-content "first.mp3\n") + (cj/music-root (cj/create-test-base-dir)) (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) (track-path (expand-file-name "second.mp3" cj/music-root)) (expected-relative "second.mp3")) @@ -68,6 +70,7 @@ (test-music-config--append-track-to-m3u-file-setup) (unwind-protect (let* ((existing-content "first.mp3") + (cj/music-root (cj/create-test-base-dir)) (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) (track-path (expand-file-name "second.mp3" cj/music-root)) (expected-relative "second.mp3")) @@ -82,7 +85,8 @@ "Multiple appends to same file all succeed (allows duplicates)." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) (track1 (expand-file-name "track1.mp3" cj/music-root)) (track2 (expand-file-name "track2.mp3" cj/music-root)) (track1-duplicate (expand-file-name "track1.mp3" cj/music-root)) @@ -98,13 +102,157 @@ (concat rel1 "\n" rel2 "\n" rel1 "\n")))))) (test-music-config--append-track-to-m3u-file-teardown))) +;;; Normal Cases: round-trip with the reader + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-round-trips-through-the-reader () + "Normal: the same-directory case round-trips through the reader. +A positive control only. With the playlist and the music root in one +directory both candidate bases produce the same string, so this passes +against the old writer too — the discriminating cases are the two tests +below, which put the bases at different depths." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (cj/music-root base) + (m3u-file (cj/create-temp-test-file "test-playlist-")) + (track-path (expand-file-name "artist/song.mp3" base))) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (should (equal (cj/music--m3u-file-tracks m3u-file) + (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-round-trips-outside-the-music-root () + "Normal/regression: a playlist living outside `cj/music-root' round-trips. +This is the case the old writer got wrong. It based every relative path on +`cj/music-root' wherever the playlist sat, while the reader resolved against +the playlist's directory. Inside the music root the two coincide, which is +why the defect stayed invisible until a playlist moved out of it." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + ;; The layout mirrors the real one: playlists/ and audio/ are siblings + ;; under mpd/, and the music root is a separate tree at a different depth. + ;; The depth difference is load-bearing -- put the music root alongside + ;; playlists/ instead and both bases yield the same relative path, so the + ;; test passes against the broken writer and proves nothing. + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "mpd/playlists/" base)) + (audio (expand-file-name "mpd/audio/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "ambience.m3u" playlists)) + (track-path (expand-file-name "rain-loop.mp3" audio))) + (make-directory playlists t) + (make-directory audio t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (should (equal (cj/music--m3u-file-tracks m3u-file) + (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-under-playlist-dir-is-relative () + "Normal: a track under the playlist's directory is written relative to it. +The music root sits at a different depth on purpose. Put it alongside the +playlist directory instead and both candidate bases produce the same string, +so the assertion would hold against a writer using either one." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "mpd/playlists/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "album.m3u" playlists)) + (track-path (expand-file-name "sub/song.mp3" playlists))) + (make-directory (expand-file-name "sub/" playlists) t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) "sub/song.mp3\n"))) + (should (equal (cj/music--m3u-file-tracks m3u-file) (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-sibling-dir-is-absolute () + "Normal: a track outside the playlist's directory is written absolute. +A sibling would otherwise come out as \"../audio/x.mp3\". Absolute is the +convention for cross-tree references here, and it survives the playlist being +moved again later, which a ../ chain does not." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "mpd/playlists/" base)) + (audio (expand-file-name "mpd/audio/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "ambience.m3u" playlists)) + (track-path (expand-file-name "rain-loop.mp3" audio))) + (make-directory playlists t) + (make-directory audio t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) (concat track-path "\n")))) + (should (equal (cj/music--m3u-file-tracks m3u-file) (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-normal-deep-parent-chain-goes-absolute () + "Normal: a track several levels away is written absolute, not as a ../ chain. +This is the case the absolute fallback exists for. A four-level chain is +unreadable and breaks the moment the playlist moves, so distance from the +playlist is exactly when an absolute path earns its keep." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "a/b/c/playlists/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "deep.m3u" playlists)) + (track-path (expand-file-name "faraway/song.mp3" base))) + (make-directory playlists t) + (make-directory (expand-file-name "faraway/" base) t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + ;; Four hops up (playlists -> c -> b -> a -> base) would be the + ;; relative form; the writer declines it and emits the absolute path. + (should (string= (buffer-string) (concat track-path "\n")))) + (should (equal (cj/music--m3u-file-tracks m3u-file) + (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + ;;; Boundary Cases +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-dotdot-named-dir-stays-relative () + "Boundary: a directory whose name merely begins with two dots stays relative. +This is the input the relative-vs-absolute test actually turns on. The check +looks for a leading \"../\", so a real subdirectory named \"..hidden\" is under +the playlist and must not be mistaken for an escape. Loosening the check to +\"..\" would break exactly this case and nothing else in the suite would catch +it." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (playlists (expand-file-name "mpd/playlists/" base)) + (cj/music-root (expand-file-name "music/" base)) + (m3u-file (expand-file-name "p.m3u" playlists)) + (track-path (expand-file-name "..hidden/song.mp3" playlists))) + (make-directory (expand-file-name "..hidden/" playlists) t) + (make-directory cj/music-root t) + (with-temp-buffer (write-file m3u-file)) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) "..hidden/song.mp3\n"))) + (should (equal (cj/music--m3u-file-tracks m3u-file) (list track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + (ert-deftest test-music-config--append-track-to-m3u-file-boundary-very-long-path-appends-successfully () "Append very long track path without truncation." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) ;; Create a relative path that's ~450 chars long (relative-path (concat (make-string 440 ?a) "/song.mp3")) (track-path (expand-file-name relative-path cj/music-root))) @@ -119,7 +267,8 @@ "Append path with unicode characters preserves UTF-8 encoding." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) (relative-path "中文/artist-名前/song🎵.mp3") (track-path (expand-file-name relative-path cj/music-root))) (cj/music--append-track-to-m3u-file track-path m3u-file) @@ -132,7 +281,8 @@ "Append path with spaces and special characters." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect - (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) + (let* ((cj/music-root (cj/create-test-base-dir)) + (m3u-file (cj/create-temp-test-file "test-playlist-")) (relative-path "Artist Name/Album (2024)/01 - Song's Title [Remix].mp3") (track-path (expand-file-name relative-path cj/music-root))) (cj/music--append-track-to-m3u-file track-path m3u-file) @@ -146,6 +296,7 @@ (test-music-config--append-track-to-m3u-file-setup) (unwind-protect (let* ((existing-content "#EXTM3U\n#EXTINF:-1,Radio Station\nhttp://stream.url/radio\n") + (cj/music-root (cj/create-test-base-dir)) (m3u-file (cj/create-temp-test-file-with-content existing-content "test-playlist-")) (relative-path "local-track.mp3") (track-path (expand-file-name relative-path cj/music-root))) @@ -156,6 +307,73 @@ (concat existing-content relative-path "\n"))))) (test-music-config--append-track-to-m3u-file-teardown))) +;;; Boundary Cases: symlinked playlists + +(defun test-music-config--append--make-symlinked-playlist (base content link-depth) + "Create a playlist whose deployed path is a symlink, and return that path. +CONTENT is written to the real file. LINK-DEPTH controls how long the link +string is, which is the whole point: `file-attributes' does not follow +symlinks, so a writer sizing the file that way reads the length of the link +rather than the content." + (let* ((deployed (expand-file-name "deployed/" base)) + (deep (expand-file-name (mapconcat #'identity + (make-list link-depth "longdirname") + "/") + base)) + (real (expand-file-name "p.m3u" deep)) + (link (expand-file-name "p.m3u" deployed))) + (make-directory deep t) + (make-directory deployed t) + (with-temp-buffer (insert content) (write-file real)) + (make-symbolic-link (file-relative-name real deployed) link t) + link)) + +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-symlink-longer-than-content () + "Boundary: appending to a symlinked playlist whose link string is longer than +its content must not signal. Sizing the file with `file-attributes' returns +the link's length, so the read range falls outside the file, nothing is +inserted, and `char-after' hands nil to a numeric comparison. Measured on the +real deployed set: 31 of 100 symlinked playlists are in this state." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + (let* ((base (cj/create-test-base-dir)) + (m3u-file (test-music-config--append--make-symlinked-playlist + base "https://example.com/s.mp3\n" 8)) + (track-path (expand-file-name "song.mp3" (file-name-directory m3u-file)))) + (should (> (file-attribute-size (file-attributes m3u-file)) + (file-attribute-size (file-attributes (file-truename m3u-file))))) + (cj/music--append-track-to-m3u-file track-path m3u-file) + ;; The seeded line is a stream URL, which the reader passes through, so + ;; both entries come back. + (should (equal (cj/music--m3u-file-tracks m3u-file) + (list "https://example.com/s.mp3" track-path)))) + (test-music-config--append-track-to-m3u-file-teardown))) + +(ert-deftest test-music-config--append-track-to-m3u-file-boundary-symlink-no-spurious-blank-line () + "Boundary: a symlinked playlist already ending in a newline gains no blank line. +The trailing-newline probe reads a byte chosen from the wrong size, so it +misreads a terminated file as unterminated and prepends a newline. All 100 +symlinked playlists in the deployed set read the wrong byte this way." + (test-music-config--append-track-to-m3u-file-setup) + (unwind-protect + ;; Content deliberately longer than the link string, so the misread byte + ;; still lands inside the file. That separates this from the sibling test + ;; above: here the probe reads a valid but wrong byte and silently + ;; misjudges, rather than reading past the end and signalling. + (let* ((base (cj/create-test-base-dir)) + (content (mapconcat (lambda (i) (format "track-%03d-with-a-longish-name.mp3" i)) + (number-sequence 1 12) "\n")) + (m3u-file (test-music-config--append--make-symlinked-playlist + base (concat content "\n") 2)) + (track-path (expand-file-name "second.mp3" (file-name-directory m3u-file)))) + (should (< (file-attribute-size (file-attributes m3u-file)) + (file-attribute-size (file-attributes (file-truename m3u-file))))) + (cj/music--append-track-to-m3u-file track-path m3u-file) + (with-temp-buffer + (insert-file-contents m3u-file) + (should (string= (buffer-string) (concat content "\nsecond.mp3\n"))))) + (test-music-config--append-track-to-m3u-file-teardown))) + ;;; Error Cases (ert-deftest test-music-config--append-track-to-m3u-file-error-nonexistent-file-signals-error () @@ -172,6 +390,9 @@ "Signal error when M3U file is read-only." (test-music-config--append-track-to-m3u-file-setup) (unwind-protect + ;; No `cj/music-root' rebinding here: the writable-p guard signals before + ;; any path computation runs, so binding it would imply a dependency the + ;; read-only path does not have. (let* ((m3u-file (cj/create-temp-test-file "test-playlist-")) (track-path "/home/user/music/song.mp3")) ;; Make file read-only diff --git a/tests/test-package-resilience.el b/tests/test-package-resilience.el new file mode 100644 index 00000000..d5fdde4a --- /dev/null +++ b/tests/test-package-resilience.el @@ -0,0 +1,504 @@ +;;; test-package-resilience.el --- Tests for surviving failed package installs -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for package-resilience.el, which keeps a failed package download from +;; aborting init. The regression these guard is concrete: early-init.el sets +;; `debug-on-error' during startup so config errors are loud, and that disarms +;; the `condition-case-unless-debug' inside `use-package-ensure-elpa', so one +;; transient download error dropped a fresh install into the debugger with two +;; thirds of the config unloaded. +;; +;; The fakes below stand in for the package archive so no test touches the +;; network or the real elpa directory. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'package-resilience) + +;;; ------------------------------- Fake registry ------------------------------- + +(defvar test-pkg-res--installed nil + "Package symbols the fake registry considers installed.") + +(defvar test-pkg-res--install-log nil + "Packages `package-install' was called with, newest first.") + +(defvar test-pkg-res--failures nil + "Alist of (PACKAGE . N): the next N install attempts for PACKAGE signal.") + +(defvar test-pkg-res--dynamic-state nil + "Captured dynamic state at each `package-install' call, newest first.") + +(defun test-pkg-res--should-fail-p (package) + "Return non-nil when this attempt at PACKAGE should signal, and count it." + (let ((cell (assq package test-pkg-res--failures))) + (when (and cell (> (cdr cell) 0)) + (setcdr cell (1- (cdr cell))) + t))) + +(defun test-pkg-res--install (package) + "Fake `package-install' for PACKAGE: record the call, then fail or install." + (push package test-pkg-res--install-log) + (push (list :debug-on-error debug-on-error + :find-file-hook find-file-hook + :prog-mode-hook prog-mode-hook + :lisp-data-mode-hook lisp-data-mode-hook + :emacs-lisp-mode-hook emacs-lisp-mode-hook) + test-pkg-res--dynamic-state) + (if (test-pkg-res--should-fail-p package) + (signal 'file-error (list "https://elpa.example.invalid/x.tar" "No Data")) + (push package test-pkg-res--installed))) + +(defmacro test-pkg-res--with-registry (available installed failures &rest body) + "Run BODY against a fake package registry. +AVAILABLE lists package symbols the archives carry, INSTALLED those already +installed, and FAILURES is an alist of (PACKAGE . N) attempts that signal." + (declare (indent 3) (debug t)) + `(let ((test-pkg-res--installed (copy-sequence ,installed)) + (test-pkg-res--install-log nil) + (test-pkg-res--failures (copy-tree ,failures)) + (test-pkg-res--dynamic-state nil) + (cj/failed-package-installs nil) + (cj/failed-source-package-installs nil) + (cj/package-install-retry-delay 0) + ;; Both of these accumulate across a whole session by design, so a + ;; test that leaves them set changes what a later test does: an + ;; unbound failure counter tripped the circuit breaker and three + ;; install tests stopped installing anything at all. + (cj/--package-retry-spent 0.0) + (cj/--package-consecutive-failures 0) + (package-archive-contents (mapcar #'list ,available))) + (cl-letf (((symbol-function 'package-installed-p) + (lambda (pkg &rest _) (and (memq pkg test-pkg-res--installed) t))) + ((symbol-function 'package-install) + (lambda (pkg &rest _) (test-pkg-res--install pkg))) + ((symbol-function 'package-refresh-contents) (lambda (&rest _) nil)) + ((symbol-function 'package-read-all-archive-contents) (lambda (&rest _) nil)) + ((symbol-function 'sleep-for) (lambda (&rest _) nil))) + ,@body))) + +;;; --------------------------- Resolving :ensure args -------------------------- + +(ert-deftest test-package-resilience-packages-resolves-t-to-name () + "Normal: an :ensure of t resolves to the use-package form's own name." + (should (equal '(foo) (cj/--package-ensure-packages 'foo '(t))))) + +(ert-deftest test-package-resilience-packages-resolves-explicit-symbol () + "Normal: an explicit :ensure symbol names a different package." + (should (equal '(bar) (cj/--package-ensure-packages 'foo '(bar))))) + +(ert-deftest test-package-resilience-packages-nil-ensure-is-empty () + "Boundary: :ensure nil requests no package at all." + (should (equal '() (cj/--package-ensure-packages 'foo '(nil))))) + +(ert-deftest test-package-resilience-packages-unwraps-pinned-cons () + "Boundary: a pinned (PACKAGE . ARCHIVE) cell resolves to the package symbol." + (should (equal '(bar) (cj/--package-ensure-packages 'foo '((bar . "melpa")))))) + +(ert-deftest test-package-resilience-packages-accepts-string-name () + "Boundary: a use-package form named with a string still resolves to a symbol." + (should (equal '(foo) (cj/--package-ensure-packages "foo" '(t))))) + +(ert-deftest test-package-resilience-packages-handles-several-ensures () + "Boundary: several :ensure keywords resolve to several packages." + (should (equal '(bar baz) (cj/--package-ensure-packages 'foo '(bar baz))))) + +;;; ------------------------------ Installing ---------------------------------- + +(ert-deftest test-package-resilience-installs-missing-package () + "Normal: a missing package is installed and nothing is recorded as failed." + (test-pkg-res--with-registry '(foo) '() '() + (cj/package-ensure 'foo '(t) nil) + (should (equal '(foo) test-pkg-res--install-log)) + (should (memq 'foo test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-skips-installed-package () + "Normal: an already-installed package is never downloaded again." + (test-pkg-res--with-registry '(foo) '(foo) '() + (cj/package-ensure 'foo '(t) nil) + (should-not test-pkg-res--install-log) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-survives-failure-under-debug-on-error () + "Error: a failed install is recorded, not signalled, even with debug-on-error. +This is the regression: `condition-case-unless-debug' inside use-package does +not catch while `debug-on-error' is non-nil, so a transient download error +aborted init in place." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (let ((debug-on-error t)) + (cj/package-ensure 'foo '(t) nil) + (should (memq 'foo cj/failed-package-installs)) + (should-not (memq 'foo test-pkg-res--installed))))) + +(ert-deftest test-package-resilience-retries-transient-failure () + "Error: a download that fails once and then succeeds installs on the retry." + (test-pkg-res--with-registry '(foo) '() '((foo . 1)) + (cj/package-ensure 'foo '(t) nil) + (should (= 2 (length test-pkg-res--install-log))) + (should (memq 'foo test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-stops-after-configured-retries () + "Boundary: a package that always fails is attempted retries-plus-one times." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (let ((cj/package-install-retries 2)) + (cj/package-ensure 'foo '(t) nil) + (should (= 3 (length test-pkg-res--install-log))) + (should (memq 'foo cj/failed-package-installs))))) + +(ert-deftest test-package-resilience-does-not-retry-unknown-package () + "Boundary: a package no archive carries is attempted once, then recorded. +Retrying a name the archives have never heard of only burns refreshes." + (test-pkg-res--with-registry '() '() '((foo . 999)) + (let ((cj/package-install-retries 2)) + (cj/package-ensure 'foo '(t) nil) + (should (= 1 (length test-pkg-res--install-log))) + (should (memq 'foo cj/failed-package-installs))))) + +(ert-deftest test-package-resilience-inhibits-editing-hooks-during-install () + "Error: editing hooks are silenced while a package installs. +Installation generates autoloads by visiting .el files, so a hook belonging to +a package that failed earlier would otherwise break unrelated installs." + (test-pkg-res--with-registry '(foo) '() '() + (let ((find-file-hook '(ignore)) + (prog-mode-hook '(ignore)) + (lisp-data-mode-hook '(ignore)) + (emacs-lisp-mode-hook '(ignore))) + (cj/package-ensure 'foo '(t) nil) + (let ((seen (car test-pkg-res--dynamic-state))) + (should-not (plist-get seen :find-file-hook)) + (should-not (plist-get seen :prog-mode-hook)) + (should-not (plist-get seen :lisp-data-mode-hook)) + (should-not (plist-get seen :emacs-lisp-mode-hook)) + (should-not (plist-get seen :debug-on-error)))))) + +(ert-deftest test-package-resilience-records-each-failure-once () + "Boundary: repeated ensure calls for one package record it a single time." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (cj/package-ensure 'foo '(t) nil) + (cj/package-ensure 'foo '(t) nil) + (should (equal '(foo) cj/failed-package-installs)))) + +;;; ------------------------------ Retry budget --------------------------------- + +(ert-deftest test-package-resilience-budget-caps-retrying () + "Boundary: with the retry budget spent, a failure gets its one attempt only. +An offline machine fails every package, so an uncapped per-package retry would +turn the abort this module removes into a startup that appears to hang." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (let ((cj/package-install-retries 2) + (cj/--package-retry-spent 999.0)) + (cj/package-ensure 'foo '(t) nil) + (should (= 1 (length test-pkg-res--install-log))) + (should (memq 'foo cj/failed-package-installs))))) + +(ert-deftest test-package-resilience-budget-still-records-failures () + "Boundary: a package skipped for budget is still recorded and reportable." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (let ((cj/--package-retry-spent 999.0)) + (cj/package-ensure 'foo '(t) nil) + (should (equal '(foo) (cj/package-still-missing)))))) + +(ert-deftest test-package-resilience-budget-accrues-across-packages () + "Error: retry time spent on one package counts against the next one's budget. +The budget is per session, not per package, which is what bounds a machine +offline for all ~190 of them. The clock is advanced ten seconds per reading so +the accrual is real rather than an artifact of a mocked sleep." + (test-pkg-res--with-registry '(foo bar) '() '((foo . 999) (bar . 999)) + (let ((cj/package-install-retries 2) + (cj/package-install-retry-budget 15.0) + (cj/--package-retry-spent 0.0) + (clock 0.0)) + (cl-letf (((symbol-function 'float-time) + (lambda (&rest _) (setq clock (+ clock 10.0))))) + (cj/package-ensure 'foo '(t) nil) + (cj/package-ensure 'bar '(t) nil)) + ;; foo: one attempt plus two retries, spending 20s. bar: one attempt, + ;; because foo already overspent the shared budget. + (should (= 4 (length test-pkg-res--install-log))) + (should (> cj/--package-retry-spent cj/package-install-retry-budget))))) + +;;; ----------------------------- Circuit breaker ------------------------------- + +(ert-deftest test-package-resilience-stops-attempting-after-failure-run () + "Error: enough failures in a row and later packages are recorded untried. +Offline, nothing populates the archive list, so every single attempt pays a +full `package-refresh-contents' before failing. Across ~190 packages that is +the dominant cost, and no retry ceiling bounds it." + (test-pkg-res--with-registry '(a b c) '() '((a . 999) (b . 999) (c . 999)) + (let ((cj/package-install-retries 0) + (cj/package-install-failure-limit 2)) + (cj/package-ensure 'a '(t) nil) + (cj/package-ensure 'b '(t) nil) + (cj/package-ensure 'c '(t) nil) + ;; a and b were tried; c was not, because the run had already reached 2. + (should (equal '(b a) test-pkg-res--install-log)) + (should (memq 'c cj/failed-package-installs))))) + +(ert-deftest test-package-resilience-failure-run-resets-on-success () + "Boundary: one success clears the run, so an unlucky package is not fatal. +The breaker exists to detect a dead network, not to give up after N scattered +failures across an otherwise healthy install." + (test-pkg-res--with-registry '(a b c) '() '((a . 999) (c . 999)) + (let ((cj/package-install-retries 0) + (cj/package-install-failure-limit 2)) + (cj/package-ensure 'a '(t) nil) ; fails, run = 1 + (cj/package-ensure 'b '(t) nil) ; succeeds, run = 0 + (cj/package-ensure 'c '(t) nil) ; fails, run = 1, still under the limit + (should (equal '(c b a) test-pkg-res--install-log))))) + +(ert-deftest test-package-resilience-installed-package-does-not-clear-run () + "Boundary: a package that was already present tells us nothing about the net. +Counting it as a success would reset the run on every built-in-backed form and +the breaker would never trip on an offline machine." + (test-pkg-res--with-registry '(a b c) '(b) '((a . 999) (c . 999)) + (let ((cj/package-install-retries 0) + (cj/package-install-failure-limit 2)) + (cj/package-ensure 'a '(t) nil) ; fails, run = 1 + (cj/package-ensure 'b '(t) nil) ; already installed, untouched + (cj/package-ensure 'c '(t) nil) ; fails, run = 2 + (should (equal '(c a) test-pkg-res--install-log)) + (should (cj/--package-giving-up-p))))) + +;;; --------------------- Packages installed from source (:vc) ------------------ + +(defun test-pkg-res--vc-orig (fails) + "Return a fake `use-package-vc-install' that signals when FAILS is non-nil." + (lambda (arg &optional _local-path) + (push (car arg) test-pkg-res--install-log) + (if fails + (signal 'error (list "Cloning failed: Permission denied (publickey)")) + (push (car arg) test-pkg-res--installed)))) + +(ert-deftest test-package-resilience-vc-install-succeeds-quietly () + "Normal: a working source install is not recorded as a failure." + (test-pkg-res--with-registry '() '() '() + (cj/--package-vc-install-guard (test-pkg-res--vc-orig nil) '(gloss nil nil)) + (should (memq 'gloss test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-vc-install-survives-failed-clone () + "Error: a failed clone is recorded, not signalled, even with debug-on-error. +`:vc' forms route around `use-package-ensure-function' entirely and +`use-package-vc-install' has no error handling, so without this guard a fresh +machine lacking credentials for the git host aborts init exactly as before." + (test-pkg-res--with-registry '() '() '() + (let ((debug-on-error t)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig t) '(gloss nil nil)) + (should (memq 'gloss cj/failed-source-package-installs)) + (should (memq 'gloss (cj/package-still-missing))) + ;; Never the archive list: `package-install' cannot recover a source + ;; package, and for one that also exists on an archive it would install + ;; the archive build instead of the checkout that was asked for. + (should-not (memq 'gloss cj/failed-package-installs)) + (should-not (memq 'gloss test-pkg-res--installed))))) + +(ert-deftest test-package-resilience-vc-failure-counts-toward-breaker () + "Error: a failed clone counts toward the consecutive-failure run. +No credentials means every source package fails, the same shape as no network." + (test-pkg-res--with-registry '() '() '() + (let ((cj/package-install-failure-limit 2)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig t) '(gloss nil nil)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig t) '(chime nil nil)) + (should (cj/--package-giving-up-p))))) + +(ert-deftest test-package-resilience-vc-skipped-once-breaker-tripped () + "Boundary: with the breaker tripped a source install is recorded untried." + (test-pkg-res--with-registry '() '() '() + (let ((cj/--package-consecutive-failures 99)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig t) '(gloss nil nil)) + (should-not test-pkg-res--install-log) + (should (memq 'gloss cj/failed-source-package-installs))))) + +(ert-deftest test-package-resilience-vc-installed-package-passes-through () + "Boundary: an already-installed source package neither counts nor records. +It says nothing about whether the git host is reachable, so treating it as a +success would reset the run and stop the breaker ever tripping." + (test-pkg-res--with-registry '() '(gloss) '() + (let ((cj/--package-consecutive-failures 3)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig nil) '(gloss nil nil)) + (should (= 3 cj/--package-consecutive-failures)) + (should-not cj/failed-package-installs)))) + +(ert-deftest test-package-resilience-vc-success-clears-failure-run () + "Boundary: a clone that works clears the run, like any other install." + (test-pkg-res--with-registry '() '() '() + (let ((cj/--package-consecutive-failures 3)) + (cj/--package-vc-install-guard (test-pkg-res--vc-orig nil) '(gloss nil nil)) + (should (= 0 cj/--package-consecutive-failures))))) + +;;; --------------------------------- Retrying ---------------------------------- + +(ert-deftest test-package-resilience-retry-clears-recovered-package () + "Normal: retrying installs a package that is now reachable and clears it." + (test-pkg-res--with-registry '(foo) '() '() + (setq cj/failed-package-installs '(foo)) + (cj/retry-failed-package-installs) + (should (memq 'foo test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-retry-converges-on-cascade () + "Boundary: a package installable only on a later pass still converges. +A failed package leaves hooks that break other installs, so recovery has to +keep passing over the set until a pass installs nothing new." + (test-pkg-res--with-registry '(foo bar) '() '((bar . 1)) + (setq cj/failed-package-installs '(foo bar)) + (cj/retry-failed-package-installs) + (should (memq 'foo test-pkg-res--installed)) + (should (memq 'bar test-pkg-res--installed)) + (should-not cj/failed-package-installs))) + +(ert-deftest test-package-resilience-retry-leaves-source-packages-alone () + "Boundary: retrying never runs `package-install' on a source package. +It cannot recover one, and for a source package that also exists on an archive +it would install the archive build instead of the checkout that was declared, +leaving `package-installed-p' true and the source install permanently skipped." + (test-pkg-res--with-registry '(gloss) '() '() + (setq cj/failed-source-package-installs '(gloss)) + (cj/retry-failed-package-installs) + (should-not test-pkg-res--install-log) + (should (equal '(gloss) (cj/package-still-missing))))) + +(ert-deftest test-package-resilience-retry-works-with-empty-archive-list () + "Error: recovery still attempts installs when no archive list is loaded yet. +This is the case the command exists for: a laptop that booted before its wifi +came up has an empty `package-archive-contents', and screening recorded +packages against it would make the command a silent no-op right when the user +finally has a network. `package-install' populates the archives itself." + (test-pkg-res--with-registry '() '() '() + (setq cj/failed-package-installs '(foo bar)) + (should-not package-archive-contents) + (cj/retry-failed-package-installs) + (should (equal '(bar foo) test-pkg-res--install-log)) + (should-not (cj/package-still-missing)))) + +(ert-deftest test-package-resilience-retry-terminates-when-impossible () + "Error: a package that can never install terminates the loop and stays listed." + (test-pkg-res--with-registry '(foo) '() '((foo . 999)) + (setq cj/failed-package-installs '(foo)) + (cj/retry-failed-package-installs) + (should (equal '(foo) cj/failed-package-installs)))) + +(ert-deftest test-package-resilience-retry-with-nothing-failed-is-quiet () + "Boundary: retrying an empty failure set installs nothing." + (test-pkg-res--with-registry '(foo) '() '() + (setq cj/failed-package-installs nil) + (cj/retry-failed-package-installs) + (should-not test-pkg-res--install-log))) + +;;; -------------------------------- Reporting ---------------------------------- + +(ert-deftest test-package-resilience-report-is-silent-when-clean () + "Normal: a run with no failed installs raises no warning." + (test-pkg-res--with-registry '() '() '() + (let ((warned nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (&rest _) (setq warned t)))) + (cj/report-failed-package-installs) + (should-not warned))))) + +(ert-deftest test-package-resilience-still-missing-does-not-mutate-records () + "Error: reading the missing set leaves both record lists intact. +`append' does not copy its last argument and `delete-dups' splices, so the +obvious spelling edits `cj/failed-source-package-installs' in place. Reading a +value must not destroy it, least of all from the startup report." + (test-pkg-res--with-registry '() '() '() + (setq cj/failed-package-installs '(foo shared)) + (setq cj/failed-source-package-installs '(gloss shared chime)) + (cj/package-still-missing) + (should (equal '(foo shared) cj/failed-package-installs)) + (should (equal '(gloss shared chime) cj/failed-source-package-installs)))) + +(ert-deftest test-package-resilience-report-omits-package-installed-since () + "Boundary: a package that arrived later as a dependency is not reported. +It failed on its own use-package form, so it is on the recorded list, but it is +present now and there is nothing for the user to do about it." + (test-pkg-res--with-registry '(foo bar) '(foo) '() + (setq cj/failed-package-installs '(foo bar)) + (should (equal '(bar) (cj/package-still-missing))) + (let ((message-text nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (setq message-text msg)))) + (cj/report-failed-package-installs) + (should (string-match-p "bar" message-text)) + (should-not (string-match-p "foo" message-text)))))) + +(ert-deftest test-package-resilience-report-silent-when-all-arrived-since () + "Boundary: recorded failures that are all installed now raise no warning." + (test-pkg-res--with-registry '(foo) '(foo) '() + (setq cj/failed-package-installs '(foo)) + (let ((warned nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (&rest _) (setq warned t)))) + (cj/report-failed-package-installs) + (should-not warned))))) + +(ert-deftest test-package-resilience-report-says-when-it-stopped-early () + "Error: a tripped breaker is said out loud, so untried is not read as failed. +Most of a long list would never have been attempted, and reporting those as +install failures would send the user hunting for ~185 individual problems." + (test-pkg-res--with-registry '(foo) '() '() + (setq cj/failed-package-installs '(foo)) + (let ((cj/--package-consecutive-failures 99) + (message-text nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (setq message-text msg)))) + (cj/report-failed-package-installs) + (should (string-match-p "never" message-text)) + ;; Names both causes: a run of failures is a dead network or missing + ;; credentials, and the message should not pick one. + (should (string-match-p "network" message-text)) + (should (string-match-p "credentials" message-text)))))) + +(ert-deftest test-package-resilience-report-omits-early-stop-when-not-tripped () + "Boundary: an ordinary failure is not dressed up as a machine being offline." + (test-pkg-res--with-registry '(foo) '() '() + (setq cj/failed-package-installs '(foo)) + (let ((cj/--package-consecutive-failures 0) + (message-text nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (setq message-text msg)))) + (cj/report-failed-package-installs) + (should-not (string-match-p "never" message-text)))))) + +(ert-deftest test-package-resilience-report-warns-and-names-failures () + "Error: failed installs raise one warning that names every package." + (test-pkg-res--with-registry '(foo bar) '() '() + (setq cj/failed-package-installs '(foo bar)) + (let ((message-text nil)) + (cl-letf (((symbol-function 'display-warning) + (lambda (_type msg &rest _) (setq message-text msg)))) + (cj/report-failed-package-installs) + (should message-text) + (should (string-match-p "foo" message-text)) + (should (string-match-p "bar" message-text)))))) + +;;; ---------------------------------- Wiring ----------------------------------- + +;; The guard tests above call the functions directly, which says nothing about +;; whether they are actually reachable from a real startup. If use-package +;; renamed either seam, every test above would still pass while the whole +;; module sat dead -- this repo's recurring failure, a gate that was green +;; because it never ran. + +(ert-deftest test-package-resilience-is-wired-to-use-package () + "Normal: loading the module actually takes over both use-package seams. +`advice-member-p' answers yes for advice attached to a symbol that was never +defined, so it alone would still pass if upstream renamed the function and left +the advice on a dead symbol. That rename is the whole scenario this test +exists for, hence the `fboundp'." + (should (eq use-package-ensure-function #'cj/package-ensure)) + (should (fboundp 'use-package-vc-install)) + (should (advice-member-p #'cj/--package-vc-install-guard + 'use-package-vc-install))) + +(ert-deftest test-package-resilience-reports-at-startup () + "Normal: the end-of-startup report is on `emacs-startup-hook'." + (should (memq #'cj/report-failed-package-installs + (default-value 'emacs-startup-hook)))) + +(provide 'test-package-resilience) +;;; test-package-resilience.el ends here diff --git a/tests/test-system-lib-auth-source-secret-value.el b/tests/test-system-lib-auth-source-secret-value.el index ec526cec..27a2696b 100644 --- a/tests/test-system-lib-auth-source-secret-value.el +++ b/tests/test-system-lib-auth-source-secret-value.el @@ -63,5 +63,44 @@ Captures the call args in `test-ass--args'." (test-ass--with-search (list (list :host "h")) (should (null (cj/auth-source-secret-value "h"))))) +;;; Error + +(ert-deftest test-auth-source-secret-value-loads-auth-source-when-absent () + "Error: with `auth-source-search' unavailable, the helper loads auth-source. + +Under `emacs --batch -Q' nothing else pulls auth-source in, so a helper +carrying only a `declare-function' dies with a void-function on the first +lookup. An interactive Emacs hides this completely -- something in init +always has auth-source loaded by the time anyone calls here -- which is why +it surfaced only on the batch calendar sync, and only on the machine whose +feeds resolve through `:secret-host' rather than an inline URL. + +The stubbed `require' installs the entry point the way loading auth-source.el +would, so the call can complete and the return value is checked too." + (let ((required nil)) + (cl-letf (((symbol-function 'auth-source-search) nil) + ((symbol-function 'require) + (lambda (feature &rest _) + (push feature required) + (fset 'auth-source-search + (lambda (&rest _) (list (list :secret "loaded")))) + feature))) + (should (equal "loaded" (cj/auth-source-secret-value "h"))) + (should (memq 'auth-source required))))) + +(ert-deftest test-auth-source-secret-value-does-not-reload-when-present () + "Error: an available `auth-source-search' is used as-is, never re-required. + +An unconditional `require' re-loads auth-source.el over whatever is in place, +replacing a caller's stub mid-call -- which sent a test that meant to fake the +lookup out to the real authinfo, where it hung for twelve seconds on gpg." + (let ((required nil)) + (cl-letf (((symbol-function 'require) + (lambda (feature &rest _) (push feature required) feature)) + ((symbol-function 'auth-source-search) + (lambda (&rest _) (list (list :secret "stubbed"))))) + (should (equal "stubbed" (cj/auth-source-secret-value "h"))) + (should-not (memq 'auth-source required))))) + (provide 'test-system-lib-auth-source-secret-value) ;;; test-system-lib-auth-source-secret-value.el ends here diff --git a/tests/test-video-audio-recording--keybindings.el b/tests/test-video-audio-recording--keybindings.el new file mode 100644 index 00000000..cdb6493a --- /dev/null +++ b/tests/test-video-audio-recording--keybindings.el @@ -0,0 +1,130 @@ +;;; test-video-audio-recording--keybindings.el --- recording toggle keybinding placement -*- lexical-binding: t; -*- + +;;; Commentary: +;; The two recording toggles get a fast chord alongside the C-; r prefix: F9 +;; starts/stops video, S-F9 starts/stops audio. +;; +;; Reaching them from inside an EAT buffer turns on which key categories each +;; input mode claims. Semi-char mode -- the default, and where agent buffers +;; sit -- is built from (:ascii :arrow :navigation) and never claims function +;; keys, so F9 already fell through to the global map there. Char mode adds +;; :function, binding f1 through f63 to `eat-self-input', and it is a minor +;; mode, so its map outranks `eat-mode-map'. The char-mode entries are the +;; load-bearing ones; the semi-char entry is belt-and-braces. +;; +;; :function claims only the unmodified keys, which is why getting this wrong +;; split the pair rather than breaking it outright: S-F9 toggled audio in a +;; char-mode buffer while F9 went to the program under the cursor. +;; +;; These tests require eat first so the module's `with-eval-after-load' fires. +;; The char-mode cases resolve through `key-binding' in a fixture that +;; reproduces minor-mode precedence, because reading a binding back out of the +;; map the module just wrote proves nothing about which map wins on a keypress. + +;;; Code: + +(require 'ert) +(require 'package) + +(setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) +(package-initialize) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'eat) +(require 'video-audio-recording) + +;;; Normal + +(ert-deftest test-video-audio-recording-f9-bound-globally () + "Normal: F9 toggles video recording, S-F9 toggles audio recording." + (should (eq (lookup-key (current-global-map) (kbd "<f9>")) + #'cj/video-recording-toggle)) + (should (eq (lookup-key (current-global-map) (kbd "S-<f9>")) + #'cj/audio-recording-toggle))) + +(ert-deftest test-video-audio-recording-f9-bound-in-eat-semi-char-mode-map () + "Normal: both chords are bound in `eat-semi-char-mode-map'. +Redundant rather than load-bearing: semi-char is built without :function, so a +function key already falls through to the global map. Asserted anyway so the +entry cannot be dropped silently while the comment explaining it stays." + (should (eq (keymap-lookup eat-semi-char-mode-map "<f9>") + #'cj/video-recording-toggle)) + (should (eq (keymap-lookup eat-semi-char-mode-map "S-<f9>") + #'cj/audio-recording-toggle))) + +(ert-deftest test-video-audio-recording-f9-bound-in-eat-mode-map () + "Normal: both chords are bound in `eat-mode-map', the major-mode map every +EAT buffer carries regardless of input mode." + (should (eq (keymap-lookup eat-mode-map "<f9>") + #'cj/video-recording-toggle)) + (should (eq (keymap-lookup eat-mode-map "S-<f9>") + #'cj/audio-recording-toggle))) + +(ert-deftest test-video-audio-recording-f9-bound-in-eat-char-mode-maps () + "Normal: both chords are bound in the two char-mode maps. +Char mode is built with EAT's :function category, which binds f1 through f63 +to `eat-self-input'. These entries are what override that." + (dolist (map (list eat-char-mode-map eat-eshell-char-mode-map)) + (should (eq (keymap-lookup map "<f9>") #'cj/video-recording-toggle)) + (should (eq (keymap-lookup map "S-<f9>") #'cj/audio-recording-toggle)))) + +;;; Boundary + +(ert-deftest test-video-audio-recording-f9-chords-are-distinct () + "Boundary: the shifted and unshifted chords resolve to different commands. +A copy-paste binding both to the same toggle would satisfy every +binding-is-present assertion above, so assert the difference directly." + (should-not (eq (lookup-key (current-global-map) (kbd "<f9>")) + (lookup-key (current-global-map) (kbd "S-<f9>"))))) + +(defun test-video-audio-recording--in-char-mode (body) + "Run BODY in a buffer wired the way a live EAT char-mode buffer is. +`eat--char-mode' is a minor mode, so its map is consulted ahead of the +major-mode map. Reproducing that ordering is the point: reading a binding +back out of the map the module just wrote proves nothing about which map wins +when a key is actually pressed." + (with-temp-buffer + (use-local-map eat-mode-map) + (let ((minor-mode-overriding-map-alist + (list (cons 'eat--char-mode eat-char-mode-map))) + (eat--char-mode t)) + (funcall body)))) + +(ert-deftest test-video-audio-recording-f9-resolves-in-char-mode () + "Boundary: both chords resolve to the toggles through the real precedence +chain in a char-mode buffer. Before this override F9 resolved to +`eat-self-input' and went to the program under the cursor, while S-F9 reached +Emacs — so the pair silently split, audio recording and video not." + (test-video-audio-recording--in-char-mode + (lambda () + (should (eq (key-binding (kbd "<f9>")) #'cj/video-recording-toggle)) + (should (eq (key-binding (kbd "S-<f9>")) #'cj/audio-recording-toggle))))) + +;;; Error + +(ert-deftest test-video-audio-recording-char-mode-fixture-really-is-char-mode () + "Error (positive control): the char-mode fixture genuinely puts EAT's map in +front. F8 sits in the same :function category as F9 and this module never +touches it, so it must still reach `eat-self-input'. If it resolves anywhere +else the fixture is inert, and the resolution test above would pass without +ever consulting `eat-char-mode-map' — which is precisely how the first cut of +this file missed that F9 was being swallowed there." + (test-video-audio-recording--in-char-mode + (lambda () + (should (eq (key-binding (kbd "<f8>")) #'eat-self-input))))) + +(ert-deftest test-video-audio-recording-f9-targets-are-commands () + "Error: a key bound to a non-interactive function fails at press time with a +`commandp' error rather than at load, so assert both targets are real commands." + (should (commandp (lookup-key (current-global-map) (kbd "<f9>")))) + (should (commandp (lookup-key (current-global-map) (kbd "S-<f9>"))))) + +(ert-deftest test-video-audio-recording-prefix-bindings-still-reachable () + "Error/regression (positive control): the fast chords must not disturb the +C-; r prefix path. Without this, deleting the prefix map outright would leave +every assertion above green." + (should (eq (keymap-lookup cj/record-map "v") #'cj/video-recording-toggle)) + (should (eq (keymap-lookup cj/record-map "a") #'cj/audio-recording-toggle)) + (should (eq (keymap-lookup cj/custom-keymap "r") cj/record-map))) + +(provide 'test-video-audio-recording--keybindings) +;;; test-video-audio-recording--keybindings.el ends here |