From bbc166754a45a20312cbffecded19db6c3f7d717 Mon Sep 17 00:00:00 2001 From: Duc Dang Date: Thu, 3 Sep 2026 09:59:52 +0700 Subject: [PATCH 1/3] test(fuzz): add deterministic state models --- .github/workflows/fuzz.yaml | 52 +++++ fuzz/Makefile | 26 +++ fuzz/README.md | 57 +++++ fuzz/fzfa-fuzz-core.el | 122 +++++++++++ fuzz/fzfa-fuzz-state.el | 406 ++++++++++++++++++++++++++++++++++++ 5 files changed, 663 insertions(+) create mode 100644 .github/workflows/fuzz.yaml create mode 100644 fuzz/Makefile create mode 100644 fuzz/README.md create mode 100644 fuzz/fzfa-fuzz-core.el create mode 100644 fuzz/fzfa-fuzz-state.el diff --git a/.github/workflows/fuzz.yaml b/.github/workflows/fuzz.yaml new file mode 100644 index 0000000..d504b4a --- /dev/null +++ b/.github/workflows/fuzz.yaml @@ -0,0 +1,52 @@ +name: Fuzz + +on: + workflow_dispatch: + pull_request: + push: + branches: ["main"] + schedule: + - cron: "17 4 * * 1" + +permissions: + contents: read + +concurrency: + group: fuzz-${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: ${{ github.event_name == 'pull_request' }} + +jobs: + state: + name: State / Emacs ${{ matrix.emacs-version }} + runs-on: ubuntu-latest + timeout-minutes: 15 + strategy: + fail-fast: false + matrix: + emacs-version: [29.1, 30.1, snapshot] + steps: + - uses: actions/checkout@v4 + with: + path: fzf-async + + - uses: actions/checkout@v4 + with: + repository: dangduc/fzf-native + ref: "2.7" + path: fzf-native + + - uses: jcs090218/setup-emacs@master + with: + version: ${{ matrix.emacs-version }} + + - name: Replay fixed cases and fuzz state transitions + shell: bash + run: | + cases=300 + steps=40 + if [[ "$GITHUB_EVENT_NAME" == "schedule" ]]; then + cases=5000 + steps=100 + fi + make -C fzf-async/fuzz compile replay state \ + CASES="$cases" STEPS="$steps" diff --git a/fuzz/Makefile b/fuzz/Makefile new file mode 100644 index 0000000..9d9147c --- /dev/null +++ b/fuzz/Makefile @@ -0,0 +1,26 @@ +.PHONY: compile replay state clean + +EMACS ?= emacs +FZF_NATIVE_DIR ?= ../../fzf-native +CASES ?= 300 +STEPS ?= 40 + +ELISP_LOAD_PATH := -L .. -L . -L $(FZF_NATIVE_DIR) +FUZZ_SRC := $(wildcard fzfa-fuzz-*.el) +STATE_RUNNER := $(EMACS) -Q --batch $(ELISP_LOAD_PATH) \ + -l fzfa-fuzz-core.el -l fzfa-fuzz-state.el + +compile: clean + $(EMACS) -Q --batch $(ELISP_LOAD_PATH) \ + --eval "(setq byte-compile-error-on-warn t)" \ + -f batch-byte-compile $(FUZZ_SRC) + +replay: + $(STATE_RUNNER) -f fzfa-fuzz-replay-batch + +state: + FZFA_FUZZ_CASES=$(CASES) FZFA_FUZZ_STEPS=$(STEPS) \ + $(STATE_RUNNER) -f fzfa-fuzz-state-batch + +clean: + rm -f *.elc diff --git a/fuzz/README.md b/fuzz/README.md new file mode 100644 index 0000000..b605203 --- /dev/null +++ b/fuzz/README.md @@ -0,0 +1,57 @@ +# fzfa fuzz tests + +These tests exercise the boundaries where the recent fzfa bugs appeared. They +live under `fuzz/`, are not loaded by the package, and do not replace any fzfa +function. + +The targets are: + +- `make compile`: byte-compile every fuzz harness and treat warnings as errors. +- `make replay`: run small fixed regression cases. +- `make state`: generate candidate-list mutations, late producer callbacks, + restart/stop races, stale poll publications, and message ownership contexts. + +`state` uses a fake clock and timer queue, but it calls fzfa's real state +functions. + +## Run locally + +The default directory layout is: + +```text +parent/ + fzf-async/ + fzf-native/ +``` + +From `fzf-async/fuzz`: + +```sh +make replay state +``` + +If fzf-native is elsewhere, pass it explicitly: + +```sh +make state FZF_NATIVE_DIR=/path/to/fzf-native +``` + +The state job covers Emacs 29.1, 30.1, and the current snapshot. + +## Reproduce a failure + +Every failure prints its seed and generated trace. Run one case from that seed: + +```sh +FZFA_FUZZ_SEED=123 make state CASES=1 +``` + +Useful controls are: + +- `CASES`: number of generated state cases. +- `STEPS`: operations in each producer-lifecycle state trace. +- `FZFA_FUZZ_SEED`: first deterministic seed. + +The state lane currently labels the process-buffer `fzfa--print` ownership +case as `KNOWN` when it occurs. It does not require that gap to remain: once the +production behavior is fixed, the same replay prints `RESOLVED` and continues. diff --git a/fuzz/fzfa-fuzz-core.el b/fuzz/fzfa-fuzz-core.el new file mode 100644 index 0000000..8cc8c62 --- /dev/null +++ b/fuzz/fzfa-fuzz-core.el @@ -0,0 +1,122 @@ +;;; fzfa-fuzz-core.el --- Shared deterministic fuzz helpers -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 James Nguyen +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; Deterministic random generation, trace reporting, and a controllable timer +;; queue for the fzfa fuzz targets. This file is test-only and is not loaded by +;; the package. + +;;; Code: + +(require 'cl-lib) +(require 'fzfa) + +(cl-defstruct (fzfa-fuzz-rng (:constructor fzfa-fuzz-rng-create)) + state) + +(defun fzfa-fuzz--env-natural (name default) + "Read non-negative integer NAME, or return DEFAULT." + (if-let* ((raw (getenv name)) + ((string-match-p "\\`[0-9]+\\'" raw))) + (string-to-number raw) + default)) + +(defun fzfa-fuzz--seed () + "Return the configured fuzz seed." + (fzfa-fuzz--env-natural "FZFA_FUZZ_SEED" 1)) + +(defun fzfa-fuzz--next (rng) + "Advance RNG and return a deterministic 31-bit integer." + (let ((next (logand #x7fffffff + (+ (* 1103515245 (fzfa-fuzz-rng-state rng)) 12345)))) + (setf (fzfa-fuzz-rng-state rng) next) + next)) + +(defun fzfa-fuzz--integer (rng limit) + "Return an integer in [0, LIMIT) from RNG." + (if (<= limit 0) 0 + (% (fzfa-fuzz--next rng) limit))) + +(defun fzfa-fuzz--pick (rng values) + "Choose one element of non-empty VALUES using RNG." + (nth (fzfa-fuzz--integer rng (length values)) values)) + +(defun fzfa-fuzz--chance (rng numerator denominator) + "Return non-nil with NUMERATOR/DENOMINATOR probability using RNG." + (< (fzfa-fuzz--integer rng denominator) numerator)) + +(defun fzfa-fuzz--fail (seed trace format-string &rest args) + "Signal a fuzz failure with SEED, TRACE, and FORMAT-STRING with ARGS." + (error "Fzfa fuzz failure\nseed: %s\ntrace: %S\n%s" + seed trace (apply #'format format-string args))) + +(defun fzfa-fuzz--proper-list-p (value) + "Return non-nil when VALUE is a finite proper list." + (and (listp value) (numberp (proper-list-p value)))) + +(defun fzfa-fuzz--copy-strings (strings) + "Copy the list spine and every string in STRINGS." + (mapcar #'copy-sequence strings)) + +(cl-defstruct (fzfa-fuzz-task (:constructor fzfa-fuzz-task-create)) + id kind function args cancelled) + +(cl-defstruct (fzfa-fuzz-scheduler + (:constructor fzfa-fuzz-scheduler-create)) + (next-id 0) + (now 0.0) + queue) + +(defun fzfa-fuzz--schedule (scheduler kind function args) + "Queue FUNCTION with ARGS as KIND on SCHEDULER and return its task." + (let ((task (fzfa-fuzz-task-create + :id (cl-incf (fzfa-fuzz-scheduler-next-id scheduler)) + :kind kind :function function :args args))) + (setf (fzfa-fuzz-scheduler-queue scheduler) + (append (fzfa-fuzz-scheduler-queue scheduler) (list task))) + task)) + +(defun fzfa-fuzz--pending-tasks (scheduler) + "Return SCHEDULER's non-cancelled queued tasks." + (cl-remove-if #'fzfa-fuzz-task-cancelled + (fzfa-fuzz-scheduler-queue scheduler))) + +(defun fzfa-fuzz--run-task (scheduler index) + "Run pending task INDEX from SCHEDULER, returning the task or nil." + (let ((task (nth index (fzfa-fuzz--pending-tasks scheduler)))) + (when task + (setf (fzfa-fuzz-scheduler-queue scheduler) + (delq task (fzfa-fuzz-scheduler-queue scheduler)) + (fzfa-fuzz-scheduler-now scheduler) + (+ 0.01 (fzfa-fuzz-scheduler-now scheduler))) + (unless (fzfa-fuzz-task-cancelled task) + (apply (fzfa-fuzz-task-function task) (fzfa-fuzz-task-args task))) + task))) + +(defun fzfa-fuzz--run-all-tasks (scheduler) + "Run every pending task on SCHEDULER in queue order." + (while (fzfa-fuzz--pending-tasks scheduler) + (fzfa-fuzz--run-task scheduler 0))) + +(defun fzfa-fuzz--call-with-scheduler (scheduler function) + "Call FUNCTION while SCHEDULER owns timer creation and time." + (cl-letf (((symbol-function 'run-with-timer) + (lambda (_seconds _repeat fn &rest args) + (fzfa-fuzz--schedule scheduler 'timer fn args))) + ((symbol-function 'run-with-idle-timer) + (lambda (_seconds _repeat fn &rest args) + (fzfa-fuzz--schedule scheduler 'idle fn args))) + ((symbol-function 'cancel-timer) + (lambda (task) + (when (fzfa-fuzz-task-p task) + (setf (fzfa-fuzz-task-cancelled task) t)))) + ((symbol-function 'float-time) + (lambda (&optional _time) + (fzfa-fuzz-scheduler-now scheduler)))) + (funcall function))) + +(provide 'fzfa-fuzz-core) +;;; fzfa-fuzz-core.el ends here diff --git a/fuzz/fzfa-fuzz-state.el b/fuzz/fzfa-fuzz-state.el new file mode 100644 index 0000000..1c27321 --- /dev/null +++ b/fuzz/fzfa-fuzz-state.el @@ -0,0 +1,406 @@ +;;; fzfa-fuzz-state.el --- Model fuzzing for fzfa state -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 James Nguyen +;; SPDX-License-Identifier: GPL-3.0-or-later + +;;; Commentary: + +;; Drives fzfa's real completion tables and source lifecycle functions with +;; deterministic generated traces. Dependencies such as timers and native +;; status calls are controlled at their existing boundaries; fzfa itself is +;; neither copied nor patched by this harness. + +;;; Code: + +(require 'cl-lib) +(require 'fzfa-fuzz-core) + +(defconst fzfa-fuzz-state--words + '("alpha" "beta" "gamma" "delta" "same" "naive" "你好" "a b" "x:y") + "Small candidate alphabet used by the state fuzzer.") + +(defun fzfa-fuzz-state--candidate (rng source-index candidate-index) + "Generate a candidate using RNG for SOURCE-INDEX and CANDIDATE-INDEX." + (let ((value (copy-sequence (fzfa-fuzz--pick rng fzfa-fuzz-state--words)))) + (add-text-properties + 0 (length value) + `(fzfa-fuzz-origin (,source-index . ,candidate-index)) value) + value)) + +(defun fzfa-fuzz-state--candidate-list (rng source-index) + "Generate one non-empty candidate list for SOURCE-INDEX using RNG." + (cl-loop for index below (1+ (fzfa-fuzz--integer rng 7)) + collect (fzfa-fuzz-state--candidate rng source-index index))) + +(defun fzfa-fuzz-state--mutate-list (value operation rng) + "Apply destructive list OPERATION to VALUE using RNG." + (pcase operation + ('nconc + (when value (nconc value (fzfa-fuzz--integer rng 20)))) + ('truncate + (when value + (setcdr (nthcdr (fzfa-fuzz--integer rng (length value)) value) nil))) + ('dot + (when value + (setcdr (nthcdr (fzfa-fuzz--integer rng (length value)) value) + (fzfa-fuzz--integer rng 20)))) + ('reverse (nreverse value)) + ('sort (sort value #'string-lessp)) + ('dedup (delete-dups value)))) + +(defun fzfa-fuzz-state--mutation-case (seed rng) + "Run one completion-list ownership case using SEED and RNG." + (let* ((source-count (1+ (fzfa-fuzz--integer rng 3))) + (operation (fzfa-fuzz--pick + rng '(nconc truncate dot reverse sort dedup))) + (specs + (cl-loop for source-index below source-count + collect + (list :name (format "source-%d" source-index) + :candidates + (fzfa-fuzz-state--candidate-list rng source-index) + :category 'fzfa-fuzz + :action #'identity))) + (trace (list :target 'completion-list + :sources source-count :operation operation)) + (scheduler (fzfa-fuzz-scheduler-create)) + (original-maker (symbol-function 'fzfa-make-source)) + made-sources) + (fzfa-fuzz--call-with-scheduler + scheduler + (lambda () + (let ((completion-category-overrides nil) + (minibuffer-setup-hook nil) + (minibuffer-exit-hook nil) + (post-command-hook nil)) + (cl-letf (((symbol-function 'fzfa-make-source) + (lambda (&rest args) + (let ((source (apply original-maker args))) + (setq made-sources + (append made-sources (list source))) + source))) + ((symbol-function 'sit-for) (lambda (&rest _) nil)) + ((symbol-function 'fzfa--sessions-push) + (lambda (&rest _) nil)) + ((symbol-function 'completing-read) + (lambda (_prompt table &rest _) + (let* ((returned (funcall table "" nil t)) + (snapshots + (mapcar + (lambda (source) + (fzfa-fuzz--copy-strings + (fzfa-source-snapshot source))) + made-sources))) + (unless (fzfa-fuzz--proper-list-p returned) + (fzfa-fuzz--fail + seed trace "initial result is not a proper list: %S" + returned)) + (fzfa-fuzz-state--mutate-list returned operation rng) + (cl-mapc + (lambda (source expected) + (let ((actual (fzfa-source-snapshot source))) + (unless (and (fzfa-fuzz--proper-list-p actual) + (equal-including-properties + actual expected)) + (fzfa-fuzz--fail + seed trace + (concat "frontend mutation changed snapshot: " + "%S, expected %S") + actual expected)))) + made-sources snapshots) + (let ((second (funcall table "" nil t))) + (unless (fzfa-fuzz--proper-list-p second) + (fzfa-fuzz--fail + seed trace + "second result is not reusable: %S" second))) + nil)))) + (fzfa--read specs :prompt "fuzz: "))))) + t)) + +(cl-defstruct (fzfa-fuzz-state--callback + (:constructor fzfa-fuzz-state--callback-create)) + token kind function) + +(defun fzfa-fuzz-state--producer-trace (rng steps) + "Generate a producer lifecycle trace from RNG with at most STEPS operations." + (let ((trace (list (list 'fetch "a"))) + stopped) + (dotimes (_ (max 0 (1- steps))) + (let ((roll (fzfa-fuzz--integer rng 100))) + (push + (cond + (stopped + (if (< roll 65) + (list 'deliver (fzfa-fuzz--integer rng 32) + (fzfa-fuzz-state--candidate-list rng 0)) + (list 'run (fzfa-fuzz--integer rng 32)))) + ((< roll 30) + (list 'fetch (fzfa-fuzz--pick rng '("" "a" "ab" "b" "same")))) + ((< roll 60) + (list 'deliver (fzfa-fuzz--integer rng 32) + (fzfa-fuzz-state--candidate-list rng 0))) + ((< roll 78) (list 'run (fzfa-fuzz--integer rng 32))) + ((< roll 92) + (list 'restart (fzfa-fuzz--pick rng '("" "a" "new" "other")))) + (t (setq stopped t) '(stop))) + trace))) + (nreverse trace))) + +(defun fzfa-fuzz-state--producer-case (seed rng steps) + "Run one generated producer lifecycle case for SEED using RNG and STEPS." + (let* ((trace (fzfa-fuzz-state--producer-trace rng steps)) + (scheduler (fzfa-fuzz-scheduler-create)) + callbacks model-tasks + source current-kind + (model-token 0) + (model-input :unfetched) + model-snapshot + (model-total 0) + model-command + (model-request-epoch 0) + (refreshes 0) + (model-refreshes 0) + (producer + (lambda (_input callback) + (setq callbacks + (append + callbacks + (list + (fzfa-fuzz-state--callback-create + :token (fzfa-source-prod-token source) + :kind current-kind :function callback))))))) + (setq source (fzfa-make-source + :spec (list :name "state" :candidates producer))) + (fzfa-fuzz--call-with-scheduler + scheduler + (lambda () + (dolist (operation trace) + (pcase operation + (`(fetch ,query) + (let ((changed (not (equal query model-input)))) + (setq current-kind 'fetch) + (unwind-protect + (fzfa--source-fetch source query + (lambda () (cl-incf refreshes))) + (setq current-kind nil)) + (when changed + (setq model-input query) + (cl-incf model-token)))) + (`(restart ,query) + (setq current-kind 'restart) + (unwind-protect + (fzfa-source--restart + source query (lambda () (cl-incf refreshes))) + (setq current-kind nil)) + (cl-incf model-request-epoch) + (cl-incf model-token) + (setq model-command query)) + (`(deliver ,selector ,candidates) + (when callbacks + (let* ((entry (nth (% selector (length callbacks)) callbacks)) + (token (fzfa-fuzz-state--callback-token entry)) + (kind (fzfa-fuzz-state--callback-kind entry))) + (funcall (fzfa-fuzz-state--callback-function entry) candidates) + (when (= token model-token) + (setq model-snapshot candidates + model-total (length candidates)) + (if (eq kind 'fetch) + (setq model-tasks + (append model-tasks (list (cons token nil)))) + (cl-incf model-refreshes)))))) + (`(run ,selector) + (let ((pending-model + (cl-remove-if #'cdr model-tasks))) + (when pending-model + (let* ((index (% selector (length pending-model))) + (model-task (nth index pending-model))) + (setcdr model-task t) + (when (= (car model-task) model-token) + (cl-incf model-refreshes)) + (fzfa-fuzz--run-task scheduler index))))) + (`(stop) + (fzfa-source--stop source) + (cl-incf model-request-epoch) + (cl-incf model-token))) + (unless (= (fzfa-source-prod-token source) model-token) + (fzfa-fuzz--fail + seed trace "producer token is %S, expected %S after %S" + (fzfa-source-prod-token source) model-token operation)) + (unless (equal (fzfa-source-prod-input source) model-input) + (fzfa-fuzz--fail + seed trace "producer input is %S, expected %S after %S" + (fzfa-source-prod-input source) model-input operation)) + (unless (= (fzfa-source-request-epoch source) model-request-epoch) + (fzfa-fuzz--fail + seed trace "request epoch is %S, expected %S after %S" + (fzfa-source-request-epoch source) model-request-epoch operation)) + (unless (equal (fzfa-source-current-cmd source) model-command) + (fzfa-fuzz--fail + seed trace "current command is %S, expected %S after %S" + (fzfa-source-current-cmd source) model-command operation)) + (unless (equal-including-properties + (fzfa-source-snapshot source) model-snapshot) + (fzfa-fuzz--fail + seed trace "snapshot is %S, expected %S after %S" + (fzfa-source-snapshot source) model-snapshot operation)) + (unless (= (fzfa-source-total source) model-total) + (fzfa-fuzz--fail + seed trace "total is %S, expected %S after %S" + (fzfa-source-total source) model-total operation)) + (unless (= refreshes model-refreshes) + (fzfa-fuzz--fail + seed trace "refresh count is %S, expected %S after %S" + refreshes model-refreshes operation))))) + ;; Teardown must make every captured callback and queued refresh inert. + (unless (and trace (eq (caar (last trace)) 'stop)) + (fzfa-source--stop source) + (cl-incf model-request-epoch) + (cl-incf model-token)) + (let ((snapshot model-snapshot) + (total model-total) + (before-refreshes refreshes)) + (dolist (entry callbacks) + (funcall (fzfa-fuzz-state--callback-function entry) '("late"))) + (fzfa-fuzz--run-all-tasks scheduler) + (unless (and (equal-including-properties + (fzfa-source-snapshot source) snapshot) + (= (fzfa-source-total source) total) + (= refreshes before-refreshes)) + (fzfa-fuzz--fail seed trace "teardown allowed stale work to publish"))) + t)) + +(defun fzfa-fuzz-state--poller-replay (seed) + "Replay publication after handle replacement for SEED." + (let* ((trace '((generation old 1) tick (replace-handle) run)) + (source (fzfa-make-source :command "producer")) + (generations '((old . 1) (new . 0))) + scheduled + (refreshes 0) + (alive t)) + (setf (fzfa-source-handle source) 'old) + (cl-letf (((symbol-function 'fzfa--poll-generation) + (lambda (handle) (alist-get handle generations))) + ((symbol-function 'input-pending-p) (lambda () nil)) + ((symbol-function 'float-time) (lambda (&optional _) 1.0))) + (let ((poll + (fzfa--make-poll-fn + (vector source) (lambda () alive) + (lambda () (cl-incf refreshes) t) + (lambda () nil) + (lambda (transaction) (setq scheduled transaction))))) + (funcall poll) + (unless scheduled + (fzfa-fuzz--fail seed trace "poller did not schedule publication")) + (setf (fzfa-source-handle source) 'new) + (funcall scheduled) + (unless (= (fzfa-source-last-gen source) -1) + (fzfa-fuzz--fail + seed trace "old handle generation committed after replacement")))) + t)) + +(defun fzfa-fuzz-state--message-events (context) + "Return `fzfa--print' events for CONTEXT. + +CONTEXT is `owner', `process', or `none'. The owner and process variants +model an active fzfa minibuffer; only the current buffer differs." + (let* ((window (selected-window)) + (original-buffer (window-buffer window)) + (owner (generate-new-buffer " *fzfa fuzz owner*")) + (worker (generate-new-buffer " *fzfa fuzz process*")) + (session (list 'session)) + events) + (unwind-protect + (progn + (set-window-buffer window owner) + (with-current-buffer owner + (setq-local fzfa--minibuffer-session session)) + (cl-letf (((symbol-function 'active-minibuffer-window) + (lambda () (unless (eq context 'none) window))) + ((symbol-function 'minibufferp) + (lambda (&optional buffer &rest _) + (eq (or buffer (current-buffer)) owner))) + ((symbol-function 'message) + (lambda (format-string &rest args) + (push (list 'log + (apply #'format format-string args) + inhibit-message (current-buffer)) + events))) + ((symbol-function 'minibuffer-message) + (lambda (format-string &rest args) + (push (list 'inline + (apply #'format format-string args) + (current-buffer)) + events)))) + (with-current-buffer (if (eq context 'owner) owner worker) + (fzfa--print "problem %d" 7)))) + (set-window-buffer window original-buffer) + (kill-buffer owner) + (kill-buffer worker)) + (nreverse events))) + +(defun fzfa-fuzz-state--message-violation (context events) + "Return a message ownership violation for CONTEXT and EVENTS, or nil." + (let* ((log (assq 'log events)) + (inline (assq 'inline events)) + (active (not (eq context 'none)))) + (cond + ((not (= (length (cl-remove-if-not + (lambda (event) (eq (car event) 'log)) events)) 1)) + 'log-count) + ((and active (not (nth 2 log))) 'echo-not-inhibited) + ((and active (null inline)) 'inline-missing) + ((and (not active) inline) 'inline-without-owner) + ((and (not active) (nth 2 log)) 'echo-inhibited-without-owner)))) + +(defun fzfa-fuzz-state--message-case (seed rng) + "Run one message ownership case for SEED using RNG. + +Return non-nil for the one known worker-buffer ownership gap." + (let* ((context (fzfa-fuzz--pick rng '(owner process none))) + (trace (list :target 'message-owner :context context)) + (events (fzfa-fuzz-state--message-events context)) + (violation (fzfa-fuzz-state--message-violation context events))) + (cond + ((and (eq context 'process) + (memq violation '(echo-not-inhibited inline-missing))) + (list trace violation events)) + (violation + (fzfa-fuzz--fail seed trace "message events violate ownership: %S (%S)" + events violation)) + (t nil)))) + +(defun fzfa-fuzz-replay-batch () + "Run fixed regression seeds in batch mode." + (let* ((seed (fzfa-fuzz--seed)) + (rng (fzfa-fuzz-rng-create :state seed))) + (fzfa-fuzz-state--mutation-case seed rng) + (fzfa-fuzz-state--producer-case seed rng 30) + (fzfa-fuzz-state--poller-replay seed) + (let* ((events (fzfa-fuzz-state--message-events 'process)) + (violation (fzfa-fuzz-state--message-violation 'process events))) + (if violation + (princ (format "KNOWN message-owner/process: %S\n" violation)) + (princ "RESOLVED message-owner/process\n"))) + (princ (format "fzfa fuzz replay passed (seed %d)\n" seed)))) + +(defun fzfa-fuzz-state-batch () + "Run deterministic randomized state cases in batch mode." + (let* ((root-seed (fzfa-fuzz--seed)) + (cases (fzfa-fuzz--env-natural "FZFA_FUZZ_CASES" 300)) + (steps (fzfa-fuzz--env-natural "FZFA_FUZZ_STEPS" 40)) + (known-message-gaps 0)) + (dotimes (index cases) + (let* ((seed (+ root-seed index)) + (rng (fzfa-fuzz-rng-create :state seed))) + (fzfa-fuzz-state--mutation-case seed rng) + (fzfa-fuzz-state--producer-case seed rng steps) + (when (fzfa-fuzz-state--message-case seed rng) + (cl-incf known-message-gaps)))) + (princ + (format + (concat "fzfa state fuzz passed (%d cases x %d steps, root seed %d); " + "%d cases reached the known process-buffer message gap\n") + cases steps root-seed known-message-gaps)))) + +(provide 'fzfa-fuzz-state) +;;; fzfa-fuzz-state.el ends here From 4091c015baba77e86b969ac58b8c52959614bdaf Mon Sep 17 00:00:00 2001 From: Duc Dang Date: Thu, 3 Sep 2026 16:10:47 +0700 Subject: [PATCH 2/3] docs(fuzz): define tested contracts --- fuzz/CONTRACTS.md | 335 ++++++++++++++++++++++++++++++++++++++++++++++ fuzz/README.md | 5 + 2 files changed, 340 insertions(+) create mode 100644 fuzz/CONTRACTS.md diff --git a/fuzz/CONTRACTS.md b/fuzz/CONTRACTS.md new file mode 100644 index 0000000..1ca7664 --- /dev/null +++ b/fuzz/CONTRACTS.md @@ -0,0 +1,335 @@ +# fzfa fuzz contract catalog + +This file defines the behavior that the fuzz harness is intended to test. It +is based on the fixes between `9927468` and `caec167`, their ERT regressions, +and the observed gaps in the draft fuzz PRs. + +The catalog separates three questions: + +1. What behavior does fzfa promise? +2. What short event sequence can distinguish that behavior from a bug? +3. Does the current fuzz harness have an independent oracle for it? + +A case reaching the relevant function is not sufficient. A row is `partial` +until its generator can reach the witness and its oracle rejects a controlled +broken implementation. + +## Scope + +The catalog covers fzfa's Elisp-visible contracts at these boundaries: + +- callback producers and their lifecycle; +- request-owned fzf-native sessions; +- frontend publication and ownership; +- process output as it crosses into Elisp; +- live completion frontend behavior; and +- teardown of buffers, processes, timers, and advice. + +The fzf-native C implementation has its own ERT, C, session, and libFuzzer +coverage. fzfa should test the contract at that seam rather than duplicate +the native parser and scorer internals. + +Ordering, layout, or backend-tool behavior is a fuzz contract only when fzfa +documents it. A differential mismatch in unspecified behavior is a triage +candidate, not automatically an fzfa bug. + +## Status meanings + +- `partial`: a draft fuzz lane reaches some of the contract, but an oracle, + input dimension, or negative control is missing. +- `ERT only`: a deterministic regression exists outside `fuzz/`. +- `gap`: no draft fuzz lane exercises the contract. +- `known product gap`: the desired contract is recorded, but current fzfa is + known not to satisfy it in every context. + +No row is marked `covered` during phase one. Coverage requires the mutation +qualification planned for the next phase. + +## Historical contract matrix + +### FZFA-C01: only the newest producer callback may publish + +- **Contract:** After a new fetch starts, callbacks from an older fetch must + not change the source snapshot, total, or visible frontend state. +- **Minimal witness:** Fetch `"a"`; fetch `"ab"`; deliver the callback for + `"a"`; observe the source before delivering `"ab"`. +- **Oracle:** Build the expected snapshot and total before calling the old + callback. Observe both immediately afterward. Expected values must not + share list structure or strings with callback input or fzfa state. +- **Generator neighborhood:** Repeated queries, equal queries, old/new callback + permutations, duplicate candidate strings, and text properties. +- **Evidence:** `fzfa-source-fetch-stale-callback-discarded` and the token + checks added around `fzfa--source-fetch`. +- **Draft status:** `partial` in #21. The current model can alias callback + values, so a destructive publication mutation can corrupt expected and + actual state together. + +### FZFA-C02: stopped sources are inert + +- **Contract:** After source cleanup, a captured producer callback or already + queued refresh must not change source state or ask a frontend to redraw. +- **Minimal witness:** Fetch; deliver a result that queues refresh; stop; + invoke the queued refresh and every captured callback. +- **Oracle:** Record snapshot, total, producer token, refresh count, and queued + work at stop. They must remain unchanged except for documented teardown + fields. +- **Generator neighborhood:** Stop before delivery, stop after delivery but + before refresh, repeated stop, restart then stop, and late callbacks from + every prior fetch. +- **Evidence:** `f0fd0e0`, `e712837`, + `fzfa-source-fetch-queued-refresh-rechecks-token`, and + `fzfa-source-fetch-callback-after-stop-is-inert`. +- **Draft status:** `partial` in #21. The final teardown sweep exercises the + contract, but most random operations after the first stop repeat inert work + instead of exploring live transitions. + +### FZFA-C03: classifying a producer must not run it + +- **Contract:** Constructing a Helm source may inspect a candidate function's + arity, but it must not call a producer. The first real fetch calls it once. +- **Minimal witness:** Construct a source around a producer that increments a + counter; observe zero calls; request candidates; observe one call. +- **Oracle:** Count calls and visible side effects before construction, after + construction, and after the first fetch. +- **Generator neighborhood:** Lists, zero-argument functions, producer + functions, optional arguments, synchronous callbacks, and asynchronous + callbacks. +- **Evidence:** `0c4fcc7`, `fzfa-helm-producer-is-not-fired-during-construction`, + and `fzfa-candidates-kind-preserves-existing-function-classes`. +- **Draft status:** `ERT only`. + +### FZFA-C04: native request results belong to one request epoch + +- **Contract:** A native result may publish only when handle, request ID, + request signature, and local request epoch still identify the request that + produced it. Reusing equal numeric IDs must not revive revoked ownership. +- **Minimal witness:** Submit request ID 7; clear or restart the source; + receive ID 7 again; finish materializing the first request. +- **Oracle:** Observe source state before materialization and after every + reentrant native or reporting callback. The obsolete candidates, counts, + generation, and failure must not commit. +- **Generator neighborhood:** Equal-ID ABA, handle replacement, changed query, + changed cap or matching policy, restart during snapshot, and restart during + error reporting. +- **Evidence:** `84641e9`, `f28e18d`, + `fzfa-session-snapshot-restart-discards-obsolete-result`, + `fzfa-session-request-epoch-blocks-equal-id-aba-result`, and + `fzfa-session-failure-report-rechecks-request-owner`. +- **Draft status:** `partial` in #21. Its poller replay covers handle + replacement, but not request-signature changes, equal-ID ABA, or reentrancy + during snapshot and error callbacks. + +### FZFA-C05: publication is committed only after the owning frontend renders + +- **Contract:** Observing a new native generation does not acknowledge it. + The generation is committed only after the owning frontend completes the + scheduled refresh. Revocation during that refresh leaves it uncommitted. +- **Minimal witness:** Poll generation 1; schedule publication; replace the + owner or handle; run the publication closure. +- **Oracle:** Record frontend owner, handle, generation, exhibit result, and + committed generation at callback time, not only after the trace finishes. +- **Generator neighborhood:** Unsupported frontend, nested minibuffer, + ownership change during candidate lookup, handle replacement before the + scheduled callback, and revocation during exhibit. +- **Evidence:** `dba133b`, `fzfa-minibuffer-owner-rejects-nested-session`, + `fzfa-frontend-exhibit-acknowledges-supported-refresh`, + `fzfa-session-poller-commits-after-scheduled-publication`, and + `fzfa-session-poller-rejects-revoked-publication`. +- **Draft status:** `partial` in #21. The fixed poller replay covers one + replacement ordering; the generated model does not preserve callback-time + observations. + +### FZFA-C06: native redraws preserve completed work + +- **Contract:** Re-rendering an unchanged request must poll rather than submit + again. An unchanged completed generation reuses the materialized result. + A presentation-policy change may rematerialize without rescoring. While a + replacement request is pending or has failed, core and Helm frontends retain + the last completed candidates; their displayed total may advance to the + native live-pool boundary. +- **Minimal witness:** Complete one request; submit a replacement; return a + running status with a larger pool; then fail it. Separately render one + completed request twice and change only highlight policy. +- **Oracle:** Count submits, status calls, and snapshots. Compare candidate + identity, filtered count, live total, and presentation after each status. +- **Generator neighborhood:** Query, cap, case mode, fuzzy mode, filter-only + settings, highlight policy, stable versus growing pool generations, and + single versus multi-source core and Helm adapters. +- **Evidence:** `84641e9`, `6e0c0f2`, `648a3a1`, + `fzfa-source-submit-deduplicates-locally`, + `fzfa-session-render-polls-without-resubmitting`, and + `fzfa-session-presentation-change-rematerializes-without-rescore`, plus the + `fzfa-helm-*-preserves-last-result-on-failure` regressions. +- **Draft status:** `gap`. + +### FZFA-C07: producer and matcher failures are terminal and reported once + +- **Contract:** A failed submit or matcher request does not retry forever. + A producer failure is reported once even when useful partial candidates + remain visible and the frontend redraws repeatedly. +- **Minimal witness:** Emit `"partial\n"`; exit 7; poll and redraw more than + once. +- **Oracle:** Require the partial candidate, exact terminal state, one message, + no extra submit, and stable repeated output including candidates and counts. +- **Generator neighborhood:** Failure before output, after partial output, + during a running matcher request, repeated status reads, and stopped source. +- **Evidence:** `1ba6033`, + `fzfa-session-running-status-reports-producer-failure-once`, + `fzfa-producer-failure-with-partial-output-reports-once`, and + `fzfa-session-end-to-end-reports-partial-producer-failure`. +- **Draft status:** `partial` in #22. The terminal result is checked, but + publishable interim results and the complete stable redraw value are not. + +### FZFA-C08: fzfa matching settings remain local to an fzfa call + +- **Contract:** fzfa may bridge its matching policy into fzf-native while it + scores, but setup and later direct native calls must retain their own global + settings. +- **Minimal witness:** Configure direct native matching; run `fzfa-setup` and + an fzfa scoring call with different policy; call fzf-native directly again. +- **Oracle:** Capture every dynamically visible setting at each call boundary + and compare the final global values with their initial values. +- **Generator neighborhood:** Case mode, fuzzy mode, filter-only length and + logic, highlight policy, normal return, interruption, and signaled error. +- **Evidence:** `e75ab46`, + `fzfa-setup-does-not-change-direct-native-matching-options`, and + `fzfa-all-completions-lazy-highlight-uses-fzfa-policy`. +- **Draft status:** `gap`. + +### FZFA-C09: frontend mutation cannot corrupt cached candidate snapshots + +- **Contract:** Completion frontends may destructively modify the list spine + they receive. That must not change fzfa's cached per-source snapshots, + candidate multiplicity, or text properties. +- **Minimal witness:** Return the empty-query result; destructively sort, + reverse, truncate, deduplicate, or attach a dotted tail; fetch it again. +- **Oracle:** Construct independent expected candidate values before invoking + the completion table. Require the mutation to change the returned list and + compare every source snapshot and second lookup, including properties and + duplicates. +- **Generator neighborhood:** One and multiple sources, duplicate values, + shared-looking strings, source tags, empty query, and every destructive list + operation above. +- **Evidence:** `836ae54` and the empty-query copies in the Ivy and pull-model + collection paths. +- **Draft status:** `partial` in #21. It snapshots expectations only after the + production table runs and does not assert complete second-lookup semantics. + +### FZFA-C10: user messages respect minibuffer ownership + +- **Contract:** Every notification is logged once. With an active owning + fzfa minibuffer, echo-area output is inhibited and the inline cue runs from + that owner buffer. Without an owner, no inline cue is emitted. +- **Minimal witness:** Call `fzfa--print` from the owner buffer, a producer + worker buffer while the owner exists, and a normal buffer with no active + minibuffer. +- **Oracle:** Check all event counts, inhibition flags, event order, and event + buffers. A known exception must match one exact event shape. +- **Generator neighborhood:** The three contexts above, owner replacement, + nested minibuffers, buffer death, and errors during reporting. +- **Evidence:** `e04916c` and the draft #21 message ownership harness. +- **Draft status:** `known product gap` for the worker-buffer context and + `partial` in #21. Its current oracle ignores recorded event buffers and + accepts more than the exact known failure shape. + +### FZFA-C11: the producer seam preserves valid records and rejects invalid tails + +- **Contract:** Complete valid records before a protocol failure remain + usable. No NUL-bearing or post-NUL candidate may reach the frontend. Raw + non-UTF-8 pathname bytes remain byte-for-byte unchanged when valid. +- **Minimal witness:** Produce `valid\nabcd\nlate\n`, with output split at + different byte boundaries. +- **Oracle:** Validate every publishable interim and terminal result, including + proper list shape, candidate bytes, forbidden NULs, filtered count, total, + and stable redraw equality. +- **Generator neighborhood:** LF and CRLF, UTF-8 split inside a code point, + invalid UTF-8, ANSI split inside an escape, empty rows, duplicates, long + lines, partial final lines, NUL position, and nonzero exit. +- **Evidence:** fzf-native 2.7's producer contract, + `fzfa-async-submit-preserves-raw-byte-query`, and draft #22. +- **Draft status:** `partial` in #22. It validates the reader-done result but + can miss an invalid interim publication. + +### FZFA-C12: the configured line cap is part of producer behavior + +- **Contract:** Unless a caller explicitly disables it, the ambient + `fzfa-max-line-length` policy reaches the producer command and bounds rows as + documented. +- **Minimal witness:** Generate rows at cap minus one, cap, and cap plus one; + repeat with an explicit unlimited setting. +- **Oracle:** Inspect the command bridge and final candidates. The expected + treatment of overlong rows must follow the selected backend's documented + max-column behavior. +- **Generator neighborhood:** Boundary lengths, multibyte display width versus + byte length, backend kind, nil, zero, and positive caps. +- **Evidence:** `fzfa--max-columns-flag` and draft #22's long-row category. +- **Draft status:** `partial` in #22. Generated cases currently bind the cap + to nil when the case omits the key, bypassing the default policy. + +### FZFA-C13: the ugrep adapter keeps valid output while excluding known NUL paths + +- **Contract:** The assembled ugrep command succeeds and returns an ordinary + matching file. GNU Info files and `emms/cache` do not reach stdout or the + final native candidate list. An unrelated late-NUL file is either excluded + by ugrep or rejected by the native seam. +- **Minimal witness:** Search a directory containing `normal.txt`, + `manual.info`, `manual.info-1`, `emms/cache`, and `late.bin`; put a unique + sentinel in the normal file. +- **Oracle:** Require exit status zero and the exact sentinel in raw stdout and + final candidates before asserting the excluded sentinels are absent. +- **Generator neighborhood:** NUL near and far from the header, matching and + nonmatching normal files, spaces in paths, and continuation suffixes. +- **Evidence:** `90f721a` and draft #22's tools lane. +- **Draft status:** `partial` in #22. The negative assertions lack the normal + file as a positive control. + +### FZFA-C14: live icomplete growth follows a fresh render + +- **Contract:** Initial multiline icomplete output grows a one-line + mini-window. A narrowing query displays fewer logical candidates. Deleting + back to empty produces a fresh broad display without collapsing the window. +- **Minimal witness:** Open with many distinguishable candidates; observe the + initial empty render; type `alpha`; wait for its render; delete the query; + wait for a new empty render. +- **Oracle:** Use observation-driven handshakes. For initial growth require + `before < target <= after`. Compare candidate identities or a discriminating + count for narrow and broad displays. Identify renders by sequence number, + not just query text. +- **Generator neighborhood:** Empty-to-narrow and narrow-to-empty edits, + different query lengths, no matches, one match, many matches, repeated + exhibits, max-height caps, and nested advice installation. +- **Evidence:** `9633ff6` and draft #23. +- **Draft status:** `partial` in #23. No-filter, no-fit, and stale-empty + controlled mutations currently pass. + +## New behavior without a historical failure witness + +These contracts were introduced in the same range but were not reconstructed +from a reported regression. Keep them separate from the historical set until +a failing witness or controlled mutant demonstrates the oracle. + +### FZFA-N01: Emacs 31 built-in completion remains bounded and refreshable + +- **Contract:** The built-in eager `*Completions*` frontend receives at most + `fzfa-default-minibuffer-max-candidates` when that positive cap is active, + can refresh after an async generation, and returns the logical candidate at + its visible selection. +- **Minimal witness:** Open more candidates than the frontend cap; publish a + new generation; navigate and accept a candidate. +- **Evidence:** `caec167`. +- **Draft status:** `gap`; #23 covers icomplete only. + +## Cross-cutting cleanup contract + +Every witness above must finish with the same externally observable resource +inventory it started with, except for explicitly retained user results: + +- no live producer or native handle owned by the finished session; +- no uncancelled session timer or queued publication; +- no leaked temporary buffer or process; +- no stale session ownership marker; and +- no additional frontend advice or positive advice refcount. + +The current drafts check parts of this inventory. Phase two should give it one +shared oracle and qualify that oracle by deliberately leaking each resource in +turn. diff --git a/fuzz/README.md b/fuzz/README.md index b605203..3cd9b56 100644 --- a/fuzz/README.md +++ b/fuzz/README.md @@ -4,6 +4,11 @@ These tests exercise the boundaries where the recent fzfa bugs appeared. They live under `fuzz/`, are not loaded by the package, and do not replace any fzfa function. +[`CONTRACTS.md`](CONTRACTS.md) records the historical failure witnesses, +expected behavior, generator neighborhoods, and current coverage gaps. A +contract remains partial until a controlled broken implementation makes its +oracle fail. + The targets are: - `make compile`: byte-compile every fuzz harness and treat warnings as errors. From 7a3cb358c80884390a70dff27d62973a7ae9a5a5 Mon Sep 17 00:00:00 2001 From: Duc Dang Date: Thu, 3 Sep 2026 20:03:13 +0700 Subject: [PATCH 3/3] test(fuzz): qualify state model oracles --- .github/workflows/fuzz.yaml | 2 +- fuzz/CONTRACTS.md | 32 ++- fuzz/Makefile | 5 +- fuzz/README.md | 5 +- fuzz/fzfa-fuzz-core.el | 26 +- fuzz/fzfa-fuzz-state.el | 525 ++++++++++++++++++++++++++++++------ 6 files changed, 498 insertions(+), 97 deletions(-) diff --git a/.github/workflows/fuzz.yaml b/.github/workflows/fuzz.yaml index d504b4a..deeb2ec 100644 --- a/.github/workflows/fuzz.yaml +++ b/.github/workflows/fuzz.yaml @@ -48,5 +48,5 @@ jobs: cases=5000 steps=100 fi - make -C fzf-async/fuzz compile replay state \ + make -C fzf-async/fuzz compile selftest replay state \ CASES="$cases" STEPS="$steps" diff --git a/fuzz/CONTRACTS.md b/fuzz/CONTRACTS.md index 1ca7664..35cec40 100644 --- a/fuzz/CONTRACTS.md +++ b/fuzz/CONTRACTS.md @@ -41,9 +41,11 @@ candidate, not automatically an fzfa bug. - `gap`: no draft fuzz lane exercises the contract. - `known product gap`: the desired contract is recorded, but current fzfa is known not to satisfy it in every context. +- `qualified`: the generator reaches the witness and the named oracle rejects + a controlled broken behavior. -No row is marked `covered` during phase one. Coverage requires the mutation -qualification planned for the next phase. +Phase-two qualification is recorded per row. A qualified row names the +controlled failure that its self-test rejects. ## Historical contract matrix @@ -60,9 +62,9 @@ qualification planned for the next phase. permutations, duplicate candidate strings, and text properties. - **Evidence:** `fzfa-source-fetch-stale-callback-discarded` and the token checks added around `fzfa--source-fetch`. -- **Draft status:** `partial` in #21. The current model can alias callback - values, so a destructive publication mutation can corrupt expected and - actual state together. +- **Draft status:** `qualified` in #21. Expected callback values are copied + before delivery. The self-test rejects both an aliased snapshot mutation + and a stale callback that publishes. ### FZFA-C02: stopped sources are inert @@ -79,9 +81,9 @@ qualification planned for the next phase. - **Evidence:** `f0fd0e0`, `e712837`, `fzfa-source-fetch-queued-refresh-rechecks-token`, and `fzfa-source-fetch-callback-after-stop-is-inert`. -- **Draft status:** `partial` in #21. The final teardown sweep exercises the - contract, but most random operations after the first stop repeat inert work - instead of exploring live transitions. +- **Draft status:** `qualified` in #21. Generated traces end at the first stop, + a reachability check requires a queued refresh at stop, and the self-test + rejects a late publication after teardown. ### FZFA-C03: classifying a producer must not run it @@ -212,8 +214,11 @@ qualification planned for the next phase. operation above. - **Evidence:** `836ae54` and the empty-query copies in the Ivy and pull-model collection paths. -- **Draft status:** `partial` in #21. It snapshots expectations only after the - production table runs and does not assert complete second-lookup semantics. +- **Draft status:** `qualified` in #21. The oracle builds independent expected + strings and list spines before the table runs, requires every mutation to + change its input, and compares the first result, cached snapshots, and second + result including properties and duplicates. Its self-test rejects nil + results, stripped properties, and a result that aliases the snapshot. ### FZFA-C10: user messages respect minibuffer ownership @@ -228,9 +233,10 @@ qualification planned for the next phase. - **Generator neighborhood:** The three contexts above, owner replacement, nested minibuffers, buffer death, and errors during reporting. - **Evidence:** `e04916c` and the draft #21 message ownership harness. -- **Draft status:** `known product gap` for the worker-buffer context and - `partial` in #21. Its current oracle ignores recorded event buffers and - accepts more than the exact known failure shape. +- **Draft status:** `known product gap` for the worker-buffer context; its #21 + oracle is `qualified`. All three contexts run deterministically. The known + exception must match one exact event sequence, and the self-test rejects a + partial repair that emits the inline cue from the worker buffer. ### FZFA-C11: the producer seam preserves valid records and rejects invalid tails diff --git a/fuzz/Makefile b/fuzz/Makefile index 9d9147c..0402469 100644 --- a/fuzz/Makefile +++ b/fuzz/Makefile @@ -1,4 +1,4 @@ -.PHONY: compile replay state clean +.PHONY: compile selftest replay state clean EMACS ?= emacs FZF_NATIVE_DIR ?= ../../fzf-native @@ -15,6 +15,9 @@ compile: clean --eval "(setq byte-compile-error-on-warn t)" \ -f batch-byte-compile $(FUZZ_SRC) +selftest: + $(STATE_RUNNER) -f fzfa-fuzz-state-selftest-batch + replay: $(STATE_RUNNER) -f fzfa-fuzz-replay-batch diff --git a/fuzz/README.md b/fuzz/README.md index 3cd9b56..cf9f4e1 100644 --- a/fuzz/README.md +++ b/fuzz/README.md @@ -12,6 +12,9 @@ oracle fail. The targets are: - `make compile`: byte-compile every fuzz harness and treat warnings as errors. +- `make selftest`: require generated producer traces to reach their intended + race witnesses, then inject eight controlled defects and require the matching + state oracle to reject each one. - `make replay`: run small fixed regression cases. - `make state`: generate candidate-list mutations, late producer callbacks, restart/stop races, stale poll publications, and message ownership contexts. @@ -32,7 +35,7 @@ parent/ From `fzf-async/fuzz`: ```sh -make replay state +make selftest replay state ``` If fzf-native is elsewhere, pass it explicitly: diff --git a/fuzz/fzfa-fuzz-core.el b/fuzz/fzfa-fuzz-core.el index 8cc8c62..11b0302 100644 --- a/fuzz/fzfa-fuzz-core.el +++ b/fuzz/fzfa-fuzz-core.el @@ -14,6 +14,8 @@ (require 'cl-lib) (require 'fzfa) +(define-error 'fzfa-fuzz-failure "Fzfa fuzz failure") + (cl-defstruct (fzfa-fuzz-rng (:constructor fzfa-fuzz-rng-create)) state) @@ -50,8 +52,28 @@ (defun fzfa-fuzz--fail (seed trace format-string &rest args) "Signal a fuzz failure with SEED, TRACE, and FORMAT-STRING with ARGS." - (error "Fzfa fuzz failure\nseed: %s\ntrace: %S\n%s" - seed trace (apply #'format format-string args))) + (signal + 'fzfa-fuzz-failure + (list (format "Fzfa fuzz failure\nseed: %s\ntrace: %S\n%s" + seed trace (apply #'format format-string args))))) + +(defun fzfa-fuzz--expect-detection (name message-pattern function) + "Require FUNCTION's oracle to kill canary NAME. + +Only `fzfa-fuzz-failure' counts as detection. MESSAGE-PATTERN must match the +failure so a canary cannot pass because an unrelated assertion happened to +fire." + (condition-case err + (progn + (funcall function) + (error "Fzfa fuzz canary survived: %s" name)) + (fzfa-fuzz-failure + (let ((message (error-message-string err))) + (unless (string-match-p message-pattern message) + (error "Fzfa fuzz canary %s hit the wrong oracle: %s" + name message)) + (princ (format "KILLED canary %s\n" name)) + t)))) (defun fzfa-fuzz--proper-list-p (value) "Return non-nil when VALUE is a finite proper list." diff --git a/fuzz/fzfa-fuzz-state.el b/fuzz/fzfa-fuzz-state.el index 1c27321..b742951 100644 --- a/fuzz/fzfa-fuzz-state.el +++ b/fuzz/fzfa-fuzz-state.el @@ -19,6 +19,24 @@ '("alpha" "beta" "gamma" "delta" "same" "naive" "你好" "a b" "x:y") "Small candidate alphabet used by the state fuzzer.") +(defvar fzfa-fuzz-state--mutation-source-count nil + "Test-only source-count override for completion ownership canaries.") + +(defvar fzfa-fuzz-state--mutation-operation nil + "Test-only operation override for completion ownership canaries.") + +(defvar fzfa-fuzz-state--completion-result-mutator nil + "Test-only function for corrupting a completion result before its oracle.") + +(defvar fzfa-fuzz-state--producer-before-delivery-hook nil + "Test-only function called immediately before a producer callback.") + +(defvar fzfa-fuzz-state--producer-after-delivery-hook nil + "Test-only function called immediately after a producer callback.") + +(defvar fzfa-fuzz-state--producer-after-teardown-hook nil + "Test-only function called after late teardown work has run.") + (defun fzfa-fuzz-state--candidate (rng source-index candidate-index) "Generate a candidate using RNG for SOURCE-INDEX and CANDIDATE-INDEX." (let ((value (copy-sequence (fzfa-fuzz--pick rng fzfa-fuzz-state--words)))) @@ -32,35 +50,81 @@ (cl-loop for index below (1+ (fzfa-fuzz--integer rng 7)) collect (fzfa-fuzz-state--candidate rng source-index index))) +(defun fzfa-fuzz-state--mutation-candidate-list (rng source-index) + "Generate a mutation-discriminating candidate list using RNG. + +The first two values are out of order, the last two have equal text with +different origin properties, and the endpoints differ. Thus sort, dedup, +reverse, and truncation all have an observable effect." + (cl-loop for value in + (list "zeta" "alpha" + (fzfa-fuzz--pick rng fzfa-fuzz-state--words) + "same" "same") + for candidate-index from 0 + collect + (let ((candidate (copy-sequence value))) + (add-text-properties + 0 (length candidate) + `(fzfa-fuzz-origin (,source-index . ,candidate-index)) + candidate) + candidate))) + +(defun fzfa-fuzz-state--expected-tag (candidate source-index multi-p) + "Build CANDIDATE's expected source tag without calling `fzfa--tag'." + (let ((copy (copy-sequence candidate))) + (if (not multi-p) + copy + (let ((tagged (concat copy (string (+ fzfa--tofu-base source-index))))) + (add-text-properties + (1- (length tagged)) (length tagged) + '(invisible t display "" fzfa-multi-action identity) + tagged) + tagged)))) + (defun fzfa-fuzz-state--mutate-list (value operation rng) "Apply destructive list OPERATION to VALUE using RNG." (pcase operation - ('nconc - (when value (nconc value (fzfa-fuzz--integer rng 20)))) + ('nconc (when value (nconc value (list "frontend-tail")))) ('truncate - (when value - (setcdr (nthcdr (fzfa-fuzz--integer rng (length value)) value) nil))) + (when value (setcdr value nil) value)) ('dot - (when value - (setcdr (nthcdr (fzfa-fuzz--integer rng (length value)) value) - (fzfa-fuzz--integer rng 20)))) + (when value (setcdr value (fzfa-fuzz--integer rng 20)) value)) ('reverse (nreverse value)) ('sort (sort value #'string-lessp)) ('dedup (delete-dups value)))) (defun fzfa-fuzz-state--mutation-case (seed rng) "Run one completion-list ownership case using SEED and RNG." - (let* ((source-count (1+ (fzfa-fuzz--integer rng 3))) - (operation (fzfa-fuzz--pick - rng '(nconc truncate dot reverse sort dedup))) + (let* ((source-count (or fzfa-fuzz-state--mutation-source-count + (1+ (fzfa-fuzz--integer rng 3)))) + (multi-p (> source-count 1)) + (operation (or fzfa-fuzz-state--mutation-operation + (fzfa-fuzz--pick + rng '(nconc truncate dot reverse sort dedup)))) (specs (cl-loop for source-index below source-count collect (list :name (format "source-%d" source-index) :candidates - (fzfa-fuzz-state--candidate-list rng source-index) + (fzfa-fuzz-state--mutation-candidate-list + rng source-index) :category 'fzfa-fuzz :action #'identity))) + ;; Build the oracle before fzfa creates a source or invokes a + ;; producer callback. Its list spines and strings share nothing with + ;; the values that production code will cache or return. + (expected-snapshots + (cl-loop + for spec in specs + for source-index from 0 + collect + (mapcar + (lambda (candidate) + (fzfa-fuzz-state--expected-tag + candidate source-index multi-p)) + (plist-get spec :candidates)))) + (expected-result + (cl-mapcan #'fzfa-fuzz--copy-strings expected-snapshots)) (trace (list :target 'completion-list :sources source-count :operation operation)) (scheduler (fzfa-fuzz-scheduler-create)) @@ -85,17 +149,32 @@ ((symbol-function 'completing-read) (lambda (_prompt table &rest _) (let* ((returned (funcall table "" nil t)) - (snapshots - (mapcar - (lambda (source) - (fzfa-fuzz--copy-strings - (fzfa-source-snapshot source))) - made-sources))) + (returned + (if fzfa-fuzz-state--completion-result-mutator + (funcall + fzfa-fuzz-state--completion-result-mutator + returned made-sources) + returned))) (unless (fzfa-fuzz--proper-list-p returned) (fzfa-fuzz--fail seed trace "initial result is not a proper list: %S" returned)) - (fzfa-fuzz-state--mutate-list returned operation rng) + (unless (equal-including-properties + returned expected-result) + (fzfa-fuzz--fail + seed trace + "initial result is %S, expected %S" + returned expected-result)) + (let ((before + (fzfa-fuzz--copy-strings returned))) + (setq returned + (fzfa-fuzz-state--mutate-list + returned operation rng)) + (when (equal-including-properties returned before) + (fzfa-fuzz--fail + seed trace + "frontend operation did not change result: %S" + operation))) (cl-mapc (lambda (source expected) (let ((actual (fzfa-source-snapshot source))) @@ -107,33 +186,32 @@ (concat "frontend mutation changed snapshot: " "%S, expected %S") actual expected)))) - made-sources snapshots) + made-sources expected-snapshots) (let ((second (funcall table "" nil t))) - (unless (fzfa-fuzz--proper-list-p second) + (unless (and (fzfa-fuzz--proper-list-p second) + (equal-including-properties + second expected-result)) (fzfa-fuzz--fail seed trace - "second result is not reusable: %S" second))) + "second result is %S, expected %S" + second expected-result))) nil)))) (fzfa--read specs :prompt "fuzz: "))))) t)) (cl-defstruct (fzfa-fuzz-state--callback (:constructor fzfa-fuzz-state--callback-create)) - token kind function) + token kind function refresh) (defun fzfa-fuzz-state--producer-trace (rng steps) "Generate a producer lifecycle trace from RNG with at most STEPS operations." (let ((trace (list (list 'fetch "a"))) + (remaining (max 0 (1- steps))) stopped) - (dotimes (_ (max 0 (1- steps))) + (while (and (> remaining 0) (not stopped)) (let ((roll (fzfa-fuzz--integer rng 100))) (push (cond - (stopped - (if (< roll 65) - (list 'deliver (fzfa-fuzz--integer rng 32) - (fzfa-fuzz-state--candidate-list rng 0)) - (list 'run (fzfa-fuzz--integer rng 32)))) ((< roll 30) (list 'fetch (fzfa-fuzz--pick rng '("" "a" "ab" "b" "same")))) ((< roll 60) @@ -143,23 +221,125 @@ ((< roll 92) (list 'restart (fzfa-fuzz--pick rng '("" "a" "new" "other")))) (t (setq stopped t) '(stop))) - trace))) + trace) + (cl-decf remaining))) (nreverse trace))) -(defun fzfa-fuzz-state--producer-case (seed rng steps) - "Run one generated producer lifecycle case for SEED using RNG and STEPS." - (let* ((trace (fzfa-fuzz-state--producer-trace rng steps)) +(defun fzfa-fuzz-state--producer-trace-features (trace) + "Return lifecycle witnesses reached by generated TRACE. + +This is a reachability check, not a correctness oracle. It mirrors only +token creation and queued-refresh selection so the harness can report whether +its generator ever built the short traces its state oracle is meant to judge." + (let ((token 0) + (input :unfetched) + callbacks tasks features) + (dolist (operation trace) + (pcase operation + (`(fetch ,query) + (unless (equal query input) + (setq input query) + (cl-incf token) + (setq callbacks + (append callbacks (list (cons token 'fetch)))))) + (`(restart ,_query) + (cl-incf token) + (setq callbacks + (append callbacks (list (cons token 'restart)))) + (cl-pushnew 'restart features)) + (`(deliver ,selector ,_candidates) + (when callbacks + (let ((entry (nth (% selector (length callbacks)) callbacks))) + (if (= (car entry) token) + (progn + (cl-pushnew 'current-delivery features) + (if (eq (cdr entry) 'fetch) + (setq tasks (append tasks (list (cons token nil)))) + (cl-pushnew 'inline-refresh features))) + (cl-pushnew 'stale-delivery features))))) + (`(run ,selector) + (let ((pending (cl-remove-if #'cdr tasks))) + (when pending + (let ((task (nth (% selector (length pending)) pending))) + (setcdr task t) + (when (= (car task) token) + (cl-pushnew 'scheduled-refresh features)))))) + (`(stop) + (when (cl-some (lambda (task) + (and (not (cdr task)) (= (car task) token))) + tasks) + (cl-pushnew 'queued-refresh-at-stop features)) + (cl-pushnew 'stop features) + (cl-incf token)))) + features)) + +(defun fzfa-fuzz-state--check-producer-generator () + "Require the producer generator to reach its discriminating witnesses." + (let ((required '(current-delivery stale-delivery + queued-refresh-at-stop restart stop)) + reached + (seeds 2000) + (steps 40)) + (dotimes (index seeds) + (let* ((rng (fzfa-fuzz-rng-create :state (1+ index))) + (trace (fzfa-fuzz-state--producer-trace rng steps))) + (when-let* ((stop-tail (member '(stop) trace))) + (unless (null (cdr stop-tail)) + (error "Producer generator emitted operations after stop: %S" + trace))) + (dolist (feature (fzfa-fuzz-state--producer-trace-features trace)) + (cl-pushnew feature reached)))) + (dolist (feature required) + (unless (memq feature reached) + (error "Producer generator did not reach %S in %d seeds" + feature seeds))) + (princ + (format "REACHED producer witnesses %S (%d seeds x %d steps)\n" + required seeds steps)))) + +(defun fzfa-fuzz-state--source-view (source) + "Return an immutable view of producer-owned state in SOURCE." + (list :token (fzfa-source-prod-token source) + :input (fzfa-source-prod-input source) + :snapshot (fzfa-fuzz--copy-strings (fzfa-source-snapshot source)) + :total (fzfa-source-total source) + :filtered (fzfa-source-filtered source) + :last-result + (fzfa-fuzz--copy-strings (fzfa-source-last-result source)) + :command (fzfa-source-current-cmd source) + :request-epoch (fzfa-source-request-epoch source))) + +(defun fzfa-fuzz-state--model-view + (token input snapshot total filtered last-result command request-epoch) + "Return an immutable expected producer-state view." + (list :token token :input input + :snapshot (fzfa-fuzz--copy-strings snapshot) + :total total :filtered filtered + :last-result (fzfa-fuzz--copy-strings last-result) + :command command :request-epoch request-epoch)) + +(defun fzfa-fuzz-state--producer-case (seed rng steps &optional fixed-trace) + "Run one producer lifecycle case for SEED using RNG and STEPS. + +Use FIXED-TRACE instead of generating operations when it is non-nil." + (let* ((trace (if fixed-trace + (copy-tree fixed-trace) + (fzfa-fuzz-state--producer-trace rng steps))) (scheduler (fzfa-fuzz-scheduler-create)) callbacks model-tasks - source current-kind + source current-kind current-refresh (model-token 0) (model-input :unfetched) model-snapshot (model-total 0) + (model-filtered 0) + model-last-result model-command (model-request-epoch 0) (refreshes 0) (model-refreshes 0) + refresh-observations + model-refresh-observations (producer (lambda (_input callback) (setq callbacks @@ -168,7 +348,8 @@ (list (fzfa-fuzz-state--callback-create :token (fzfa-source-prod-token source) - :kind current-kind :function callback))))))) + :kind current-kind :function callback + :refresh current-refresh))))))) (setq source (fzfa-make-source :spec (list :name "state" :candidates producer))) (fzfa-fuzz--call-with-scheduler @@ -179,19 +360,34 @@ (`(fetch ,query) (let ((changed (not (equal query model-input)))) (setq current-kind 'fetch) + (setq current-refresh + (lambda () + (cl-incf refreshes) + (setq refresh-observations + (append refresh-observations + (list + (fzfa-fuzz-state--source-view source)))))) (unwind-protect - (fzfa--source-fetch source query - (lambda () (cl-incf refreshes))) - (setq current-kind nil)) + (fzfa--source-fetch source query current-refresh) + (setq current-kind nil + current-refresh nil)) (when changed (setq model-input query) (cl-incf model-token)))) (`(restart ,query) (setq current-kind 'restart) + (setq current-refresh + (lambda () + (cl-incf refreshes) + (setq refresh-observations + (append refresh-observations + (list + (fzfa-fuzz-state--source-view source)))))) (unwind-protect (fzfa-source--restart - source query (lambda () (cl-incf refreshes))) - (setq current-kind nil)) + source query current-refresh) + (setq current-kind nil + current-refresh nil)) (cl-incf model-request-epoch) (cl-incf model-token) (setq model-command query)) @@ -199,15 +395,32 @@ (when callbacks (let* ((entry (nth (% selector (length callbacks)) callbacks)) (token (fzfa-fuzz-state--callback-token entry)) - (kind (fzfa-fuzz-state--callback-kind entry))) + (kind (fzfa-fuzz-state--callback-kind entry)) + (expected (fzfa-fuzz--copy-strings candidates))) + (when fzfa-fuzz-state--producer-before-delivery-hook + (funcall fzfa-fuzz-state--producer-before-delivery-hook + source candidates entry)) (funcall (fzfa-fuzz-state--callback-function entry) candidates) + (when fzfa-fuzz-state--producer-after-delivery-hook + (funcall fzfa-fuzz-state--producer-after-delivery-hook + source candidates entry)) (when (= token model-token) - (setq model-snapshot candidates - model-total (length candidates)) + (setq model-snapshot expected + model-total (length expected)) (if (eq kind 'fetch) (setq model-tasks (append model-tasks (list (cons token nil)))) - (cl-incf model-refreshes)))))) + (setq model-filtered (length expected) + model-last-result expected) + (cl-incf model-refreshes) + (setq model-refresh-observations + (append + model-refresh-observations + (list + (fzfa-fuzz-state--model-view + model-token model-input model-snapshot model-total + model-filtered model-last-result model-command + model-request-epoch))))))))) (`(run ,selector) (let ((pending-model (cl-remove-if #'cdr model-tasks))) @@ -216,7 +429,15 @@ (model-task (nth index pending-model))) (setcdr model-task t) (when (= (car model-task) model-token) - (cl-incf model-refreshes)) + (cl-incf model-refreshes) + (setq model-refresh-observations + (append + model-refresh-observations + (list + (fzfa-fuzz-state--model-view + model-token model-input model-snapshot model-total + model-filtered model-last-result model-command + model-request-epoch))))) (fzfa-fuzz--run-task scheduler index))))) (`(stop) (fzfa-source--stop source) @@ -247,6 +468,20 @@ (fzfa-fuzz--fail seed trace "total is %S, expected %S after %S" (fzfa-source-total source) model-total operation)) + (unless (= (fzfa-source-filtered source) model-filtered) + (fzfa-fuzz--fail + seed trace "filtered count is %S, expected %S after %S" + (fzfa-source-filtered source) model-filtered operation)) + (unless (equal-including-properties + (fzfa-source-last-result source) model-last-result) + (fzfa-fuzz--fail + seed trace "last result is %S, expected %S after %S" + (fzfa-source-last-result source) model-last-result operation)) + (unless (equal-including-properties + refresh-observations model-refresh-observations) + (fzfa-fuzz--fail + seed trace "refresh observations are %S, expected %S after %S" + refresh-observations model-refresh-observations operation)) (unless (= refreshes model-refreshes) (fzfa-fuzz--fail seed trace "refresh count is %S, expected %S after %S" @@ -256,16 +491,28 @@ (fzfa-source--stop source) (cl-incf model-request-epoch) (cl-incf model-token)) - (let ((snapshot model-snapshot) + (let ((snapshot (fzfa-fuzz--copy-strings model-snapshot)) (total model-total) + (filtered model-filtered) + (last-result (fzfa-fuzz--copy-strings model-last-result)) + (token model-token) + (request-epoch model-request-epoch) (before-refreshes refreshes)) (dolist (entry callbacks) (funcall (fzfa-fuzz-state--callback-function entry) '("late"))) (fzfa-fuzz--run-all-tasks scheduler) + (when fzfa-fuzz-state--producer-after-teardown-hook + (funcall fzfa-fuzz-state--producer-after-teardown-hook source)) (unless (and (equal-including-properties (fzfa-source-snapshot source) snapshot) (= (fzfa-source-total source) total) - (= refreshes before-refreshes)) + (= (fzfa-source-filtered source) filtered) + (equal-including-properties + (fzfa-source-last-result source) last-result) + (= (fzfa-source-prod-token source) token) + (= (fzfa-source-request-epoch source) request-epoch) + (= refreshes before-refreshes) + (null (fzfa-fuzz--pending-tasks scheduler))) (fzfa-fuzz--fail seed trace "teardown allowed stale work to publish"))) t)) @@ -308,6 +555,12 @@ model an active fzfa minibuffer; only the current buffer differs." (owner (generate-new-buffer " *fzfa fuzz owner*")) (worker (generate-new-buffer " *fzfa fuzz process*")) (session (list 'session)) + (buffer-role + (lambda () + (cond + ((eq (current-buffer) owner) 'owner) + ((eq (current-buffer) worker) 'process) + (t 'other)))) events) (unwind-protect (progn @@ -323,13 +576,13 @@ model an active fzfa minibuffer; only the current buffer differs." (lambda (format-string &rest args) (push (list 'log (apply #'format format-string args) - inhibit-message (current-buffer)) + inhibit-message (funcall buffer-role)) events))) ((symbol-function 'minibuffer-message) (lambda (format-string &rest args) (push (list 'inline (apply #'format format-string args) - (current-buffer)) + (funcall buffer-role)) events)))) (with-current-buffer (if (eq context 'owner) owner worker) (fzfa--print "problem %d" 7)))) @@ -338,37 +591,151 @@ model an active fzfa minibuffer; only the current buffer differs." (kill-buffer worker)) (nreverse events))) -(defun fzfa-fuzz-state--message-violation (context events) - "Return a message ownership violation for CONTEXT and EVENTS, or nil." - (let* ((log (assq 'log events)) - (inline (assq 'inline events)) - (active (not (eq context 'none)))) - (cond - ((not (= (length (cl-remove-if-not - (lambda (event) (eq (car event) 'log)) events)) 1)) - 'log-count) - ((and active (not (nth 2 log))) 'echo-not-inhibited) - ((and active (null inline)) 'inline-missing) - ((and (not active) inline) 'inline-without-owner) - ((and (not active) (nth 2 log)) 'echo-inhibited-without-owner)))) - -(defun fzfa-fuzz-state--message-case (seed rng) - "Run one message ownership case for SEED using RNG. - -Return non-nil for the one known worker-buffer ownership gap." - (let* ((context (fzfa-fuzz--pick rng '(owner process none))) - (trace (list :target 'message-owner :context context)) +(defconst fzfa-fuzz-state--known-process-message-events + '((log "problem 7" nil process)) + "Exact event shape of the known worker-buffer ownership gap.") + +(defun fzfa-fuzz-state--message-violations (context events) + "Return every message ownership violation in CONTEXT and EVENTS." + (let* ((logs (cl-remove-if-not + (lambda (event) (eq (car event) 'log)) events)) + (inlines (cl-remove-if-not + (lambda (event) (eq (car event) 'inline)) events)) + (active (not (eq context 'none))) + (expected-log-role (if (eq context 'owner) 'owner 'process)) + violations) + (unless (= (length logs) 1) + (push 'log-count violations)) + (when (= (length logs) 1) + (let ((log (car logs))) + (unless (equal (nth 1 log) "problem 7") + (push 'log-text violations)) + (unless (eq (nth 3 log) expected-log-role) + (push 'log-buffer violations)) + (if active + (unless (eq (nth 2 log) t) + (push 'echo-not-inhibited violations)) + (when (nth 2 log) + (push 'echo-inhibited-without-owner violations))))) + (if active + (progn + (unless (= (length inlines) 1) + (push 'inline-count violations)) + (when (= (length inlines) 1) + (let ((inline (car inlines))) + (unless (equal (nth 1 inline) "problem 7") + (push 'inline-text violations)) + (unless (eq (nth 2 inline) 'owner) + (push 'inline-buffer violations))))) + (when inlines + (push 'inline-without-owner violations))) + (unless (equal (mapcar #'car events) + (if active '(log inline) '(log))) + (push 'event-order violations)) + (nreverse violations))) + +(defun fzfa-fuzz-state--message-case (seed context) + "Run one message ownership case for SEED in deterministic CONTEXT. + +Return non-nil only for the exact known worker-buffer event shape." + (let* ((trace (list :target 'message-owner :context context)) (events (fzfa-fuzz-state--message-events context)) - (violation (fzfa-fuzz-state--message-violation context events))) + (violations (fzfa-fuzz-state--message-violations context events))) (cond ((and (eq context 'process) - (memq violation '(echo-not-inhibited inline-missing))) - (list trace violation events)) - (violation - (fzfa-fuzz--fail seed trace "message events violate ownership: %S (%S)" - events violation)) + (equal events fzfa-fuzz-state--known-process-message-events)) + (list trace violations events)) + (violations + (fzfa-fuzz--fail + seed trace "message events violate ownership: %S (%S)" + events violations)) (t nil)))) +(defun fzfa-fuzz-state-selftest-batch () + "Qualify state-fuzz generators and oracles with controlled canaries." + (fzfa-fuzz-state--check-producer-generator) + (fzfa-fuzz--expect-detection + "completion-result-nil" "initial result is" + (lambda () + (let ((fzfa-fuzz-state--mutation-source-count 1) + (fzfa-fuzz-state--mutation-operation 'truncate) + (fzfa-fuzz-state--completion-result-mutator + (lambda (&rest _) nil))) + (fzfa-fuzz-state--mutation-case + 9101 (fzfa-fuzz-rng-create :state 9101))))) + (fzfa-fuzz--expect-detection + "completion-properties-stripped" "initial result is" + (lambda () + (let ((fzfa-fuzz-state--mutation-source-count 1) + (fzfa-fuzz-state--mutation-operation 'reverse) + (fzfa-fuzz-state--completion-result-mutator + (lambda (returned _sources) + (mapcar #'substring-no-properties returned)))) + (fzfa-fuzz-state--mutation-case + 9102 (fzfa-fuzz-rng-create :state 9102))))) + (fzfa-fuzz--expect-detection + "completion-result-aliases-snapshot" "frontend mutation changed snapshot" + (lambda () + (let ((fzfa-fuzz-state--mutation-source-count 1) + (fzfa-fuzz-state--mutation-operation 'truncate) + (fzfa-fuzz-state--completion-result-mutator + (lambda (_returned sources) + (fzfa-source-snapshot (car sources))))) + (fzfa-fuzz-state--mutation-case + 9103 (fzfa-fuzz-rng-create :state 9103))))) + (fzfa-fuzz--expect-detection + "producer-snapshot-alias" "snapshot is" + (lambda () + (let ((fzfa-fuzz-state--producer-after-delivery-hook + (lambda (_source candidates _entry) + (setcar candidates "corrupt")))) + (fzfa-fuzz-state--producer-case + 9201 (fzfa-fuzz-rng-create :state 9201) 2 + '((fetch "a") (deliver 0 ("alpha" "beta"))))))) + (fzfa-fuzz--expect-detection + "stale-producer-publication" "snapshot is" + (lambda () + (let ((fzfa-fuzz-state--producer-after-delivery-hook + (lambda (source candidates entry) + (when (/= (fzfa-fuzz-state--callback-token entry) + (fzfa-source-prod-token source)) + (setf (fzfa-source-snapshot source) candidates + (fzfa-source-total source) (length candidates)))))) + (fzfa-fuzz-state--producer-case + 9202 (fzfa-fuzz-rng-create :state 9202) 3 + '((fetch "a") (fetch "ab") (deliver 0 ("stale"))))))) + (fzfa-fuzz--expect-detection + "refresh-before-publication" "refresh observations are" + (lambda () + (let ((fzfa-fuzz-state--producer-before-delivery-hook + (lambda (_source _candidates entry) + (funcall (fzfa-fuzz-state--callback-refresh entry))))) + (fzfa-fuzz-state--producer-case + 9203 (fzfa-fuzz-rng-create :state 9203) 2 + '((fetch "a") (deliver 0 ("fresh"))))))) + (fzfa-fuzz--expect-detection + "teardown-late-publication" "teardown allowed stale work to publish" + (lambda () + (let ((fzfa-fuzz-state--producer-after-teardown-hook + (lambda (source) + (setf (fzfa-source-snapshot source) '("late") + (fzfa-source-total source) 1)))) + (fzfa-fuzz-state--producer-case + 9204 (fzfa-fuzz-rng-create :state 9204) 3 + '((fetch "a") (deliver 0 ("fresh")) (stop)))))) + (fzfa-fuzz--expect-detection + "message-inline-from-worker" "inline-buffer" + (lambda () + (cl-letf (((symbol-function 'fzfa--print) + (lambda (format-string &rest args) + (let ((message-text + (apply #'format format-string args))) + (let ((inhibit-message t)) + (message "%s" message-text)) + (minibuffer-message "%s" message-text))))) + (fzfa-fuzz-state--message-case 9301 'process)))) + (princ "fzfa state fuzz self-test passed (8 canaries killed)\n")) + (defun fzfa-fuzz-replay-batch () "Run fixed regression seeds in batch mode." (let* ((seed (fzfa-fuzz--seed)) @@ -376,10 +743,9 @@ Return non-nil for the one known worker-buffer ownership gap." (fzfa-fuzz-state--mutation-case seed rng) (fzfa-fuzz-state--producer-case seed rng 30) (fzfa-fuzz-state--poller-replay seed) - (let* ((events (fzfa-fuzz-state--message-events 'process)) - (violation (fzfa-fuzz-state--message-violation 'process events))) - (if violation - (princ (format "KNOWN message-owner/process: %S\n" violation)) + (let ((known (fzfa-fuzz-state--message-case seed 'process))) + (if known + (princ (format "KNOWN message-owner/process: %S\n" (nth 1 known))) (princ "RESOLVED message-owner/process\n"))) (princ (format "fzfa fuzz replay passed (seed %d)\n" seed)))) @@ -394,7 +760,8 @@ Return non-nil for the one known worker-buffer ownership gap." (rng (fzfa-fuzz-rng-create :state seed))) (fzfa-fuzz-state--mutation-case seed rng) (fzfa-fuzz-state--producer-case seed rng steps) - (when (fzfa-fuzz-state--message-case seed rng) + (when (fzfa-fuzz-state--message-case + seed (nth (% index 3) '(owner process none))) (cl-incf known-message-gaps)))) (princ (format