diff options
| -rw-r--r-- | Makefile | 7 | ||||
| -rw-r--r-- | early-init.el | 12 | ||||
| -rw-r--r-- | modules/package-resilience.el | 369 | ||||
| -rwxr-xr-x | scripts/bootstrap-packages.sh | 133 | ||||
| -rw-r--r-- | tests/test-bootstrap-packages.bats | 142 | ||||
| -rw-r--r-- | tests/test-package-resilience.el | 504 |
6 files changed, 1166 insertions, 1 deletions
@@ -16,6 +16,7 @@ # make compile - Byte-compile all modules # make compile-file FILE= - Byte-compile one file with the project load path # make lint - Run all linters (checkdoc, package-lint, elisp-lint) +# make bootstrap - Install every package headlessly (fresh machine) # make profile - Profile Emacs startup performance # make clean - Remove test artifacts and compiled files # make clean-compiled - Remove .elc/.eln files only @@ -54,7 +55,7 @@ EMACS_TEST = $(EMACS_BATCH) -L $(TEST_DIR) -L $(MODULE_DIR) .PHONY: help targets test test-all test-unit test-integration test-file test-name \ test-bash theme-studio-test theme-studio-check theme-studio-coverage theme-studio-gen theme-studio-open theme-studio-theme theme-studio-theme-load theme-studio-theme-reload deploy-wip \ benchmark coverage coverage-summary coverage-clean \ - validate-parens validate-modules compile compile-file lint profile \ + validate-parens validate-modules compile compile-file lint bootstrap profile \ task-sorted \ clean clean-compiled clean-tests reset @@ -100,6 +101,7 @@ help: @echo " make lint - Run all linters (checkdoc, package-lint, elisp-lint)" @echo "" @echo " Utilities:" + @echo " make bootstrap - Install every package headlessly (fresh machine)" @echo " make profile - Profile Emacs startup performance" @echo " make clean - Remove test artifacts and compiled files" @echo " make clean-compiled - Remove .elc/.eln files only" @@ -452,6 +454,9 @@ lint: # Utility Targets # ============================================================================ +bootstrap: + @bash scripts/bootstrap-packages.sh + profile: @echo "Profiling Emacs startup..." @if [ -f "$(EMACS_HOME)/early-init.el" ]; then \ diff --git a/early-init.el b/early-init.el index d59f0a8b..8d4eb268 100644 --- a/early-init.el +++ b/early-init.el @@ -253,6 +253,18 @@ early-init.el.") ;;(require 'use-package-ensure) ; Needed for :ensure to work (setq use-package-always-ensure t) ; Auto-install packages +;; A dead download must not abort startup. `use-package-ensure-elpa' already +;; warns and carries on when an install fails, but it guards with +;; `condition-case-unless-debug', which does nothing while `debug-on-error' is +;; set -- and it is set above, deliberately, so init errors are loud. The two +;; collide: one file-error from an ELPA host stopped a fresh install in place +;; with a third of the config loaded. This module takes over +;; `use-package-ensure-function' so the debugger is inhibited for the install +;; alone, retries a transient failure, and reports what is missing once startup +;; finishes. The load-path form matches init.el's so add-to-list dedups it. +(add-to-list 'load-path (concat user-emacs-directory "modules/")) +(require 'package-resilience) + ;; Keep the GNU ELPA signing keys current so signature verification doesn't ;; start failing when the archive key expires (the usual reason verification ;; gets turned off). Failure is non-fatal so a clean-machine bootstrap or an diff --git a/modules/package-resilience.el b/modules/package-resilience.el new file mode 100644 index 00000000..d81eeec0 --- /dev/null +++ b/modules/package-resilience.el @@ -0,0 +1,369 @@ +;;; package-resilience.el --- Survive failed package installs at startup -*- lexical-binding: t -*- + +;;; Commentary: +;; A transient package download must not abort init. +;; +;; `use-package-ensure-elpa' already handles a failed install correctly: it +;; wraps `package-install' in `condition-case-unless-debug', and on error it +;; warns and carries on. That guard does nothing whenever `debug-on-error' is +;; non-nil, and early-init.el sets `debug-on-error' for the whole of startup so +;; my own config errors are loud. The two settings collide. On a fresh +;; install one dead download — a file-error from an ELPA host — escaped into +;; the debugger and stopped init in place, leaving a third of the config +;; loaded and hooks pointing at packages that were never installed. +;; +;; I keep both behaviors by narrowing the loud-errors setting rather than +;; dropping it: package installation runs with the debugger inhibited, +;; everything else in init still gets it. A package that will not install is +;; recorded and reported at the end of startup instead of stopping it. + +;;; Code: + +(require 'cl-lib) +(require 'package) +(require 'seq) +(require 'use-package-ensure) + +(defgroup cj/package-resilience nil + "Keep a failed package install from aborting Emacs startup." + :group 'cj + :prefix "cj/package-") + +(defcustom cj/package-install-retries 2 + "How many extra attempts a failed package install gets. +Retries exist for transient network failures, which is the common case on a +fresh install pulling every package over the wire." + :type 'integer + :group 'cj/package-resilience) + +(defcustom cj/package-install-retry-delay 2 + "Seconds to wait between package install attempts." + :type 'number + :group 'cj/package-resilience) + +(defcustom cj/package-install-retry-budget 60 + "Seconds this session may spend retrying installs, in total. +Retrying is worth it for a transient failure, which fails alone. A machine +that is simply offline fails every package instead, and without a ceiling the +per-package retry cost would be paid ~190 times over — trading the abort this +module removes for a startup that appears to hang. Once the budget is spent +each package still gets its one attempt, and still gets recorded." + :type 'number + :group 'cj/package-resilience) + +(defcustom cj/package-install-failure-limit 5 + "Consecutive failed installs after which this session stops attempting more. +The retry budget bounds retrying, but not the first attempt, and the first +attempt is where the cost lives when a machine is entirely offline: nothing +populates `package-archive-contents', so `use-package-ensure-elpa' runs a full +`package-refresh-contents' across every configured archive before each install +fails. Paid once per package across ~190 packages, that is a startup that +looks hung. Failures this many times in a row mean the network is gone rather +than one package being unlucky, so the rest are recorded without being tried." + :type 'integer + :group 'cj/package-resilience) + +(defvar cj/failed-package-installs nil + "Archive packages that did not install during this session.") + +(defvar cj/failed-source-package-installs nil + "Packages declared with `:vc' that did not install during this session. +Kept apart from `cj/failed-package-installs' because `package-install' cannot +recover them: some are on no archive at all, and one that happens to be on an +archive would be recovered as the archive build rather than the source +checkout that was asked for, silently and permanently.") + +(defvar cj/--package-retry-spent 0.0 + "Seconds spent retrying package installs so far this session.") + +(defvar cj/--package-consecutive-failures 0 + "How many packages have failed to install in a row.") + +;; ------------------------------ Resolving names ------------------------------ + +(defun cj/--package-as-symbol (name) + "Return NAME as a symbol, whether it arrives as a symbol or a string. +This mirrors `use-package-as-symbol' without depending on use-package-core +being loaded at the point early-init installs this." + (if (symbolp name) name (intern name))) + +(defun cj/--package-ensure-packages (name args) + "Return the package symbols a use-package form requests. +NAME is the form's name and ARGS the values of its :ensure keywords, in the +shape `use-package-ensure-elpa' receives them: t means the form's own name, a +symbol names another package, a cons cell is a pinned (PACKAGE . ARCHIVE), and +nil requests nothing." + (delq nil + (mapcar (lambda (ensure) + (let ((package (if (eq ensure t) + (cj/--package-as-symbol name) + ensure))) + (if (consp package) (car package) package))) + args))) + +(defun cj/--package-ensure-missing (name args) + "Return the packages NAME's :ensure ARGS request that are not installed." + (seq-remove #'package-installed-p (cj/--package-ensure-packages name args))) + +(defun cj/--package-any-retryable-p (packages) + "Return non-nil when some of PACKAGES is one an archive actually carries. +A name no archive has heard of will not appear on a retry either, so retrying +it only spends another refresh on a typo." + (seq-some (lambda (package) (assq package package-archive-contents)) packages)) + +;; -------------------------------- Installing --------------------------------- + +(defun cj/--package-ensure-once (name args state no-refresh) + "Make one install attempt for NAME's :ensure ARGS, with STATE and NO-REFRESH. +Binding `debug-on-error' to nil re-arms the `condition-case-unless-debug' +inside `use-package-ensure-elpa', which early-init's loud-errors setting +otherwise disables. The editing hooks are silenced because installing a +package generates autoloads by visiting .el files: a hook belonging to a +package that failed earlier would run there and break unrelated installs." + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (use-package-ensure-elpa name args state no-refresh))) + +(defun cj/--package-retry-budget-left-p () + "Return non-nil while this session may still spend time retrying installs." + (< cj/--package-retry-spent cj/package-install-retry-budget)) + +(defun cj/--package-ensure-retry (name args state no-refresh) + "Retry NAME's missing :ensure ARGS, passing STATE and NO-REFRESH through. +Stops once the session's retry budget is spent, or once nothing still missing +is carried by an archive." + (let ((left cj/package-install-retries)) + (while (and (> left 0) + (cj/--package-retry-budget-left-p) + (cj/--package-any-retryable-p (cj/--package-ensure-missing name args))) + (setq left (1- left)) + (let ((start (float-time))) + (sleep-for cj/package-install-retry-delay) + (cj/--package-ensure-once name args state no-refresh) + (setq cj/--package-retry-spent + (+ cj/--package-retry-spent (- (float-time) start))))))) + +(defun cj/--package-record-one (package) + "Record PACKAGE as one that did not install." + (when package + (cl-pushnew package cj/failed-package-installs))) + +(defun cj/--package-record-source-one (package) + "Record PACKAGE as a source install that did not complete." + (when package + (cl-pushnew package cj/failed-source-package-installs))) + +(defun cj/--package-record-failures (name args) + "Record any of NAME's :ensure ARGS that are still not installed." + (dolist (package (cj/--package-ensure-missing name args)) + (cj/--package-record-one package))) + +(defun cj/--package-giving-up-p () + "Return non-nil once enough installs have failed in a row to stop trying." + (>= cj/--package-consecutive-failures cj/package-install-failure-limit)) + +(defun cj/--package-note-outcome (name args) + "Count NAME's :ensure ARGS outcome toward the consecutive-failure run." + (if (cj/--package-ensure-missing name args) + (setq cj/--package-consecutive-failures + (1+ cj/--package-consecutive-failures)) + (setq cj/--package-consecutive-failures 0))) + +(defun cj/package-ensure (name args state &optional no-refresh) + "Install NAME's :ensure ARGS without letting a failure abort startup. +STATE and NO-REFRESH are passed through to `use-package-ensure-elpa'. This is +the value of `use-package-ensure-function'; see this file's commentary for why +the stock one cannot survive `debug-on-error'. + +A form whose packages are already present is left alone entirely, so it neither +costs anything nor tells us whether the network is up." + (cond + ((null (cj/--package-ensure-missing name args)) nil) + ((cj/--package-giving-up-p) (cj/--package-record-failures name args)) + (t + (cj/--package-ensure-once name args state no-refresh) + (cj/--package-ensure-retry name args state no-refresh) + (cj/--package-note-outcome name args) + (cj/--package-record-failures name args)))) + +;; ------------------------- Packages installed from source -------------------- + +;; A `:vc' form routes around everything above: use-package nulls :ensure +;; whenever :vc is present (use-package-ensure.el, `use-package-handler/:ensure'), +;; so `use-package-ensure-function' is never consulted. And +;; `use-package-vc-install' carries no error handling of its own, so a failed +;; clone signals straight into init under the loud-errors setting -- the +;; original bug, through a second door. A fresh machine without credentials +;; for the git host yet is exactly the case this module exists for, so the +;; clone gets the same treatment: quiet context, recorded, counted. + +(defun cj/--package-vc-install-once (orig arg local-path) + "Call ORIG with ARG and LOCAL-PATH, surviving a failed clone. +Returns non-nil when the clone worked. Unlike the :ensure path there is no +upstream `condition-case' to re-arm, so this supplies one." + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (condition-case err + (progn (funcall orig arg local-path) t) + (error + (display-warning + 'cj/package-resilience + (format "Failed to install %s from source: %s" + (car arg) (error-message-string err)) + :error) + nil)))) + +(defun cj/--package-vc-install-guard (orig arg &optional local-path) + "Around-advice for `use-package-vc-install', called as ORIG. +ARG is (NAME OPTIONS REVISION) and LOCAL-PATH is passed through." + (let ((package (car arg))) + (cond + ;; Already present: ORIG no-ops, and it would tell us nothing about + ;; whether the host is reachable, so the failure run is left alone. + ((and package (package-installed-p package)) + (funcall orig arg local-path)) + ((cj/--package-giving-up-p) + (cj/--package-record-source-one package)) + (t + (cj/--package-vc-install-once orig arg local-path) + (if (and package (package-installed-p package)) + (setq cj/--package-consecutive-failures 0) + (cj/--package-record-source-one package) + (setq cj/--package-consecutive-failures + (1+ cj/--package-consecutive-failures))))))) + +;; --------------------------------- Recovery ---------------------------------- + +(defun cj/package-still-missing () + "Return the recorded failures that are still not installed. +A package that failed on its own `use-package' form is often installed a +moment later as some other package's dependency, so the recorded list +overstates the damage until it is re-checked against reality." + ;; `append' does not copy its last argument and `delete-dups' splices + ;; destructively, so without the copy this read would edit + ;; `cj/failed-source-package-installs' in place -- and it runs from the + ;; startup report, where losing a record silently is the worst place for it. + (seq-remove #'package-installed-p + (delete-dups + (append cj/failed-package-installs + (copy-sequence cj/failed-source-package-installs))))) + +(defun cj/--package-install-quietly (package) + "Attempt to install PACKAGE. Return non-nil if it is installed afterward." + (unless (package-installed-p package) + (let ((debug-on-error nil) + (find-file-hook nil) + (prog-mode-hook nil) + (lisp-data-mode-hook nil) + (emacs-lisp-mode-hook nil)) + (condition-case err + (package-install package) + (error (message "package-resilience: %s still failing: %s" + package (error-message-string err)))))) + (package-installed-p package)) + +(defun cj/--package-retry-pass () + "Try every package in `cj/failed-package-installs' once. +Return how many were installed on this pass." + (let ((installed 0)) + ;; Only the archive list. Source packages are kept out of it entirely, so + ;; no filter is needed here -- and a filter would be actively wrong: on a + ;; first boot before the network came up nothing has populated + ;; `package-archive-contents', so screening on it would skip every recorded + ;; package and make this command a silent no-op in the case it exists for. + ;; `package-install' populates the archives itself when it needs to. + (dolist (package (copy-sequence cj/failed-package-installs)) + (when (cj/--package-install-quietly package) + (setq cj/failed-package-installs + (delq package cj/failed-package-installs)) + (setq installed (1+ installed)))) + installed)) + +(defun cj/retry-failed-package-installs () + "Install everything that failed earlier, passing over the set until it settles. +A failed package leaves hooks that break other installs, so one package +succeeding can unblock others. Passes repeat while any pass installs +something, which also terminates: a pass that installs nothing ends it." + (interactive) + ;; Asking for a retry asserts the network may be back, so clear the run that + ;; stopped this session attempting installs in the first place. + (setq cj/--package-consecutive-failures 0) + (while (> (cj/--package-retry-pass) 0)) + (when (called-interactively-p 'interactive) + (let ((missing (cj/package-still-missing))) + (message (if missing + (format "Still missing: %s" + (mapconcat #'symbol-name missing " ")) + "All packages installed."))))) + +(defun cj/report-failed-package-installs () + "Warn about packages that failed to install, naming every one of them. +Only packages that are still absent are named; one that arrived later as +another package's dependency is not a failure the user needs to act on." + (let* ((missing (cj/package-still-missing)) + (source (seq-filter (lambda (p) + (memq p cj/failed-source-package-installs)) + missing)) + (archive (seq-difference missing source))) + (when missing + (display-warning + 'cj/package-resilience + (concat + (format "%d package(s) are missing: %s +Startup continued without them, so features they back are missing." + (length missing) (mapconcat #'symbol-name missing ", ")) + ;; Two different recoveries, so name which packages each one covers. + ;; Sending the user to the retry command for a source package wastes + ;; their time every startup: it cannot install one. + (when archive + (format " +Run M-x cj/retry-failed-package-installs for: %s" + (mapconcat #'symbol-name archive ", "))) + (when source + (format " +These install from source, so they need working credentials for the git host +and then 'make bootstrap': %s" + (mapconcat #'symbol-name source ", "))) + (when (cj/--package-giving-up-p) + (format " +Installing stopped after %d failures in a row, so most of these were never +attempted. Check the network and your credentials for the git host." + cj/package-install-failure-limit))) + :error)))) + +;; -------------------------------- Bootstrap ---------------------------------- + +(defun cj/package-bootstrap-batch () + "Entry point for the bootstrap script: retry, report, and exit. +Loading init.el in batch installs whatever `use-package' asks for; this retries +anything that pass missed and turns the outcome into an exit status the shell +can loop on. Exits 0 when nothing is missing, 1 otherwise." + (cj/retry-failed-package-installs) + (let ((missing (cj/package-still-missing))) + (if missing + (progn + (message "package-bootstrap: %d missing: %s" + (length missing) + (mapconcat #'symbol-name missing " ")) + (kill-emacs 1)) + (message "package-bootstrap: all packages installed") + (kill-emacs 0)))) + +;; --------------------------------- Wiring ------------------------------------ + +(setq use-package-ensure-function #'cj/package-ensure) + +;; Named function, never a lambda: an anonymous advice cannot be removed by +;; reference, so a live daemon would keep running it after the form is deleted. +(advice-add 'use-package-vc-install :around #'cj/--package-vc-install-guard) + +(add-hook 'emacs-startup-hook #'cj/report-failed-package-installs 90) + +(provide 'package-resilience) +;;; package-resilience.el ends here diff --git a/scripts/bootstrap-packages.sh b/scripts/bootstrap-packages.sh new file mode 100755 index 00000000..9ba9fc69 --- /dev/null +++ b/scripts/bootstrap-packages.sh @@ -0,0 +1,133 @@ +#!/usr/bin/env bash +# +# Install every package this config asks for, headlessly, before first launch. +# +# On a fresh machine init.el pulls ~190 packages over the network one at a +# time. A single dead download used to abort startup outright; +# modules/package-resilience.el now records the failure and lets init finish, +# and this script is what turns that into a completed install: load init.el in +# batch, retry whatever is still missing, and repeat while progress is being +# made. Doing it here rather than in a GUI session means a fresh install never +# meets the debugger. +# +# Usage: scripts/bootstrap-packages.sh +# Exit: 0 when every package is installed, non-zero otherwise. +# +# Environment: +# EMACS emacs binary to use (default: emacs) +# BOOTSTRAP_PASSES maximum passes over the set (default: 4) +# BOOTSTRAP_TIMEOUT seconds allowed per pass (default: 1800) +# +# Note: a pass loads the whole config in batch, so every :config block runs +# headlessly. stdin is closed and each pass is bounded by a timeout so a +# prompt or a hung network fetch fails the pass instead of stalling forever. + +set -uo pipefail + +emacs_bin="${EMACS:-emacs}" +max_passes="${BOOTSTRAP_PASSES:-4}" +pass_timeout="${BOOTSTRAP_TIMEOUT:-1800}" + +emacs_dir="${BOOTSTRAP_DIR:-$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd)}" +log_dir="$(mktemp -d -t emacs-bootstrap-XXXXXX)" + +cleanup() { rm -rf "$log_dir"; } +trap cleanup EXIT + +# --batch implies -q, which skips early-init.el. That file is where the package +# archives, use-package-always-ensure, and package-resilience all live, so a +# pass that loaded only init.el would install almost nothing and would not even +# have cj/package-bootstrap-batch defined. Load both, in the order a real +# startup does. user-emacs-directory is set first so the pass bootstraps the +# checkout this script lives in rather than whatever $HOME/.emacs.d happens to +# be. +load_form="$(cat <<EOF +(progn + (setq load-prefer-newer t) + (setq user-emacs-directory "${emacs_dir}/") + (setq package-user-dir (expand-file-name "elpa" user-emacs-directory)) + (load (expand-file-name "early-init.el" user-emacs-directory) nil t) + (load (expand-file-name "init.el" user-emacs-directory) nil t) + (cj/package-bootstrap-batch)) +EOF +)" + +echo "bootstrap: installing packages for $emacs_dir" +echo "bootstrap: up to $max_passes passes, ${pass_timeout}s each" + +# use-package calls its ensure function at macro-expansion time when a file is +# being byte-compiled, and emits no runtime call at all. So a pass that loads +# .elc files installs nothing and would still exit 0 -- a false pass, the same +# shape as every other gate in this repo that was green because it never ran. +# Refuse rather than warn: there is no use for a bootstrap that cannot install, +# and a warning above a success line is read as a success. A genuinely fresh +# machine has no .elc and never sees this. +# Every directory the config puts on its load-path, not just modules/, since a +# use-package form anywhere in them would be consumed the same way. +if compgen -G "$emacs_dir/modules/*.elc" >/dev/null 2>&1 \ + || compgen -G "$emacs_dir/custom/*.elc" >/dev/null 2>&1 \ + || compgen -G "$emacs_dir/assets/*.elc" >/dev/null 2>&1 \ + || compgen -G "$emacs_dir/*.elc" >/dev/null 2>&1; then + echo "bootstrap: REFUSING - byte-compiled modules are present." >&2 + echo "bootstrap: use-package consumes :ensure at compile time, so a pass over" >&2 + echo "bootstrap: .elc files installs nothing and would report success anyway." >&2 + echo "bootstrap: run 'make clean-compiled' first, then bootstrap." >&2 + exit 2 +fi + +pass=1 +passes_run=0 +status=1 +while [ "$pass" -le "$max_passes" ]; do + log="$log_dir/pass-$pass.log" + echo "bootstrap: pass $pass of $max_passes ..." + + timeout "$pass_timeout" "$emacs_bin" --batch \ + --eval "$load_form" </dev/null >"$log" 2>&1 + status=$? + passes_run=$((passes_run + 1)) + + case "$status" in + 0) + echo "bootstrap: every package is installed (pass $pass)" + break + ;; + 1) + # Exit 1 is only meaningful when the pass actually said what is + # missing. Anything else exiting 1 is a different failure, and + # retrying it four times then blaming packages would be a lie. + if grep -E '^package-bootstrap: [0-9]+ missing:' "$log"; then + : # another pass can clear them; installing one unblocks others + else + echo "bootstrap: pass $pass exited 1 without reporting missing packages" >&2 + tail -30 "$log" >&2 + break + fi + ;; + 124) + echo "bootstrap: pass $pass hit the ${pass_timeout}s timeout" >&2 + tail -20 "$log" >&2 + ;; + *) + # init itself failed for some reason other than a missing package. + echo "bootstrap: pass $pass failed to load init (exit $status)" >&2 + tail -30 "$log" >&2 + break + ;; + esac + + pass=$((pass + 1)) +done + +if [ "$status" -ne 0 ]; then + echo "bootstrap: FAILED after $passes_run pass(es)" >&2 + # No pass ran at all when the ceiling is zero, and the glob would then match + # nothing and print a tail error over the real message. + if [ "$passes_run" -gt 0 ]; then + echo "bootstrap: tail of the last pass follows" >&2 + tail -30 "$log" >&2 + fi + exit "$status" +fi + +exit 0 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-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 |