279 lines
12 KiB
EmacsLisp
279 lines
12 KiB
EmacsLisp
;;; etaf-docs-tests.el --- ETAF documentation contract tests -*- lexical-binding: t; -*-
|
|
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'cl-lib)
|
|
(require 'json)
|
|
(require 'macroexp)
|
|
(require 'etaf)
|
|
|
|
(declare-function etaf-m0b-component-manifest-write-json
|
|
"etaf-m0b-component-manifest" ())
|
|
|
|
(defconst etaf-docs-test--root
|
|
(file-name-directory
|
|
(directory-file-name (file-name-directory (or load-file-name
|
|
buffer-file-name))))
|
|
"Absolute path of the ETAF repository under test.")
|
|
|
|
(defun etaf-docs-test--read (relative-file)
|
|
"Return the contents of RELATIVE-FILE in the repository."
|
|
(with-temp-buffer
|
|
(insert-file-contents (expand-file-name relative-file etaf-docs-test--root))
|
|
(buffer-string)))
|
|
|
|
(defun etaf-docs-test--elisp-blocks (contents)
|
|
"Return the fenced Elisp blocks found in documentation CONTENTS."
|
|
(let (blocks)
|
|
(with-temp-buffer
|
|
(insert contents)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "^```elisp[[:space:]]*$" nil t)
|
|
(let ((start (line-beginning-position 2)))
|
|
(unless (re-search-forward "^```[[:space:]]*$" nil t)
|
|
(error "Unclosed Elisp documentation block"))
|
|
(push (buffer-substring-no-properties start
|
|
(match-beginning 0))
|
|
blocks))))
|
|
(nreverse blocks)))
|
|
|
|
(defun etaf-docs-test--read-all (source)
|
|
"Read every form in Elisp documentation SOURCE and return its count."
|
|
(with-temp-buffer
|
|
(insert source)
|
|
(goto-char (point-min))
|
|
(let ((count 0))
|
|
(condition-case err
|
|
(while t
|
|
(read (current-buffer))
|
|
(cl-incf count))
|
|
(end-of-file count)
|
|
(error (error "Cannot read documentation form: %S" err))))))
|
|
|
|
(defun etaf-docs-test--forms (source)
|
|
"Read and return every form in documentation SOURCE."
|
|
(with-temp-buffer
|
|
(insert source)
|
|
(goto-char (point-min))
|
|
(let (forms)
|
|
(condition-case nil
|
|
(while t (push (read (current-buffer)) forms))
|
|
(end-of-file (nreverse forms))))))
|
|
|
|
(defun etaf-docs-test--mounted-collection-probe (forms)
|
|
"Load exact documentation FORMS and mount the collection composition."
|
|
(etaf-component-redefine-run
|
|
(lambda ()
|
|
(dolist (form forms)
|
|
(eval form t))))
|
|
(let ((buffer (generate-new-buffer " *etaf-docs-m0b*")))
|
|
(unwind-protect
|
|
(progn
|
|
(let ((view
|
|
(eval
|
|
'(etaf-view
|
|
(etaf-docs-collection-card
|
|
:items '((1 . "One") (2 . "Two"))
|
|
:footer-view (etaf-view (text "Dynamic"))
|
|
(slot :name 'footer (text "Footer"))))
|
|
t)))
|
|
(etaf-mount buffer view))
|
|
(let ((text (with-current-buffer buffer (buffer-string))))
|
|
(dolist (expected '("One" "Two" "Dynamic" "Footer"))
|
|
(should (string-match-p expected text)))))
|
|
(when-let* ((runtime (etaf-runtime-for-buffer buffer)))
|
|
(etaf-unmount runtime))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest etaf-docs-have-paired-long-lived-files ()
|
|
"Keep the public architecture, guide, and plan in both languages."
|
|
(dolist (file '("README.md"
|
|
"README.zh-CN.md"
|
|
"DESIGN.md"
|
|
"DESIGN.zh-CN.md"
|
|
"examples/README.md"
|
|
"examples/README.zh-CN.md"
|
|
"docs/architecture.en.md"
|
|
"docs/architecture.zh.md"
|
|
"docs/user-guide.en.md"
|
|
"docs/user-guide.zh.md"
|
|
"docs/implementation-plan.en.md"
|
|
"docs/implementation-plan.zh.md"
|
|
"docs/migration-0.2.en.md"
|
|
"docs/migration-0.2.zh.md"
|
|
"postmortem/2026-08-05-executable-core-examples.en.md"
|
|
"postmortem/2026-08-05-executable-core-examples.zh.md"))
|
|
(should (file-exists-p (expand-file-name file etaf-docs-test--root)))))
|
|
|
|
(ert-deftest etaf-docs-user-surface-has-one-current-vocabulary ()
|
|
"Reject old public entry names and stale View examples in user docs."
|
|
(dolist (file '("README.md" "README.zh-CN.md"
|
|
"examples/README.md" "examples/README.zh-CN.md"
|
|
"docs/architecture.en.md" "docs/architecture.zh.md"
|
|
"docs/user-guide.en.md" "docs/user-guide.zh.md"
|
|
"docs/implementation-plan.en.md"
|
|
"docs/implementation-plan.zh.md"))
|
|
(let ((contents (etaf-docs-test--read file)))
|
|
(should-not
|
|
(string-match-p
|
|
(regexp-opt '("etaf-template" "etaf-create-app")) contents))
|
|
(should-not (string-match-p "(text \"[^\"]+\" :" contents))))
|
|
(let ((guide (etaf-docs-test--read "docs/user-guide.en.md")))
|
|
(dolist (token '("etaf-view" "etaf-mount" "etaf-define-component"
|
|
"etaf-data-grid" "etaf-resource"))
|
|
(should (string-match-p (regexp-quote token) guide)))))
|
|
|
|
(ert-deftest etaf-docs-elisp-examples-are-readable ()
|
|
"Keep fenced Elisp examples syntactically readable by Emacs."
|
|
(dolist (file '("README.md" "README.zh-CN.md"
|
|
"examples/README.md" "examples/README.zh-CN.md"
|
|
"docs/architecture.en.md" "docs/architecture.zh.md"
|
|
"docs/user-guide.en.md" "docs/user-guide.zh.md"
|
|
"docs/implementation-plan.en.md"
|
|
"docs/implementation-plan.zh.md"))
|
|
(dolist (block (etaf-docs-test--elisp-blocks
|
|
(etaf-docs-test--read file)))
|
|
(should (> (etaf-docs-test--read-all block) 0)))))
|
|
|
|
(ert-deftest etaf-docs-component-contract-is-current ()
|
|
"Keep public Component prose aligned with the authoritative macro contract."
|
|
(dolist (file '("docs/architecture.en.md" "docs/architecture.zh.md"
|
|
"docs/user-guide.en.md" "docs/user-guide.zh.md"
|
|
"docs/implementation-plan.en.md"
|
|
"docs/implementation-plan.zh.md"))
|
|
(let ((contents (etaf-docs-test--read file)))
|
|
(should (string-match-p (regexp-quote ":view") contents))
|
|
(should (string-match-p (regexp-quote ":render") contents))
|
|
(should (string-match-p (regexp-quote ":setup") contents))
|
|
(should (string-match-p (regexp-opt '("opaque state" "opaque 状态"))
|
|
contents))
|
|
(should-not
|
|
(string-match-p
|
|
(regexp-opt '("setup returns a zero-argument render function"
|
|
":setup` runs once per retained identity and returns a zero-argument render function"
|
|
":setup` runs once for a retained Component instance and must return a zero-argument render function"
|
|
"返回零参数 render 函数"
|
|
"必须返回零参数 render 函数"))
|
|
contents)))))
|
|
|
|
(ert-deftest etaf-docs-data-grid-selection-contract-is-current ()
|
|
"Document only selection inputs actually declared by `etaf-data-grid'."
|
|
(dolist (file '("docs/user-guide.en.md" "docs/user-guide.zh.md"))
|
|
(let ((contents (etaf-docs-test--read file)))
|
|
(should (string-match-p (regexp-quote ":row-selected-p") contents))
|
|
(should-not (string-match-p (regexp-quote ":selected-key") contents)))))
|
|
|
|
(ert-deftest etaf-docs-superseded-proposals-not-current-contract ()
|
|
"Keep the old Component proposal explicitly historical."
|
|
(let ((contents
|
|
(etaf-docs-test--read "docs/proposals/component-definition.zh.md")))
|
|
(should (string-match-p "SUPERSEDED" contents))
|
|
(should (string-match-p "historical" contents))
|
|
(should (string-match-p (regexp-quote "docs/architecture.zh.md") contents))
|
|
(should-not (string-match-p "尚未实现" contents))))
|
|
|
|
(ert-deftest etaf-docs-module-boundaries-target-vocabulary-is-paired ()
|
|
"Keep the English and Chinese target Component vocabulary equivalent."
|
|
(dolist (file '("docs/proposals/module-boundaries.en.md"
|
|
"docs/proposals/module-boundaries.zh.md"))
|
|
(let ((contents (etaf-docs-test--read file)))
|
|
(dolist (token '(":view" ":render" ":setup" "etaf-state" "etaf-node"
|
|
"opaque"))
|
|
(should (string-match-p (regexp-quote token) contents))))))
|
|
|
|
(ert-deftest etaf-docs-interaction-contract-is-current ()
|
|
"Keep the public Action/Behavior/event composition contract explicit."
|
|
(dolist (file '("docs/architecture.en.md" "docs/architecture.zh.md"
|
|
"docs/user-guide.en.md" "docs/user-guide.zh.md"))
|
|
(let ((contents (etaf-docs-test--read file)))
|
|
(dolist (token '("Host" "Behavior" "short-circuit" "first"
|
|
"capture" "bubble" "application" "feature"
|
|
"etaf-action-redefine-run" "dispatch"))
|
|
(should (string-match-p (regexp-quote token) contents))))))
|
|
|
|
(ert-deftest etaf-docs-component-manifest-is-machine-readable ()
|
|
"Validate the three-column Component manifest and observed evidence."
|
|
(let* ((script (expand-file-name "scripts/etaf-m0b-component-manifest.el"
|
|
etaf-docs-test--root))
|
|
(json-object-type 'alist)
|
|
(json-array-type 'list)
|
|
(manifest
|
|
(with-temp-buffer
|
|
(let ((standard-output (current-buffer)))
|
|
(load script nil t)
|
|
(etaf-m0b-component-manifest-write-json))
|
|
(goto-char (point-min))
|
|
(json-read))))
|
|
(should (equal 1 (alist-get 'schema-version manifest)))
|
|
(should (equal "observed" (alist-get 'evidence-mode manifest)))
|
|
(dolist (entry (alist-get 'components manifest))
|
|
(should (alist-get 'declared-business-props entry))
|
|
(should (alist-get 'forwarded-host-attrs entry))
|
|
(should (alist-get 'root-shape-forwarding-guarantee entry))
|
|
(should (eq t (alist-get 'mounted-validation entry))))))
|
|
|
|
(ert-deftest etaf-docs-executable-suite-is-fail-closed ()
|
|
"Classify exact blocks before macroexpansion, loading, or mounted smoke."
|
|
(let ((fixture (expand-file-name
|
|
"tests/fixtures/etaf-m0b-doc-examples.sexp"
|
|
etaf-docs-test--root)))
|
|
(should (file-readable-p fixture))
|
|
(let ((records (with-temp-buffer
|
|
(insert-file-contents fixture)
|
|
(goto-char (point-min))
|
|
(read (current-buffer)))))
|
|
(should records)
|
|
(dolist (record records)
|
|
(let* ((file (plist-get record :file))
|
|
(index (plist-get record :block))
|
|
(classification (plist-get record :classification))
|
|
(blocks (etaf-docs-test--elisp-blocks
|
|
(etaf-docs-test--read file)))
|
|
(source (nth (1- index) blocks)))
|
|
(should source)
|
|
(should (equal (secure-hash 'sha256 source)
|
|
(plist-get record :sha256)))
|
|
(should (memq classification
|
|
'(macroexpand-only load-safe mounted-smoke)))
|
|
(pcase classification
|
|
('macroexpand-only
|
|
(should (> (etaf-docs-test--read-all source) 0)))
|
|
((or 'load-safe 'mounted-smoke)
|
|
(let ((forms (etaf-docs-test--forms source)))
|
|
(dolist (form forms)
|
|
(should (macroexpand-all (copy-tree form))))
|
|
(pcase (plist-get record :probe)
|
|
('collection-composition
|
|
(etaf-docs-test--mounted-collection-probe forms))
|
|
('nil (dolist (form forms) (eval form t)))
|
|
(_ (ert-fail "Unknown safe documentation probe")))))))))))
|
|
|
|
(ert-deftest etaf-source-uses-only-public-ebox-names ()
|
|
"Keep the ETAF implementation independent of Ebox private functions."
|
|
(dolist (file
|
|
(append
|
|
(directory-files etaf-docs-test--root t "\\.el\\'")
|
|
(directory-files
|
|
(expand-file-name "examples" etaf-docs-test--root)
|
|
t "\\.el\\'")))
|
|
(with-temp-buffer
|
|
(insert-file-contents file)
|
|
(should-not (re-search-forward "ebox--" nil t)))))
|
|
|
|
(ert-deftest etaf-examples-use-only-public-etaf-names ()
|
|
"Keep executable examples on the public ETAF contract."
|
|
(dolist (file
|
|
(directory-files
|
|
(expand-file-name "examples" etaf-docs-test--root)
|
|
t "\\.el\\'"))
|
|
(with-temp-buffer
|
|
(insert-file-contents file)
|
|
(should-not
|
|
(re-search-forward (regexp-opt '("etaf--" "ebox--")) nil t)))))
|
|
|
|
;;; etaf-docs-tests.el ends here
|