294 lines
12 KiB
EmacsLisp
294 lines
12 KiB
EmacsLisp
;;; etaf-render-view-tests.el --- Ordinary Elisp View frontend -*- lexical-binding: t; -*-
|
|
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; The render frontend shares View compilation and retained runtime semantics.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'bytecomp)
|
|
(require 'etaf)
|
|
|
|
(defvar etaf-rv--renders 0)
|
|
(defvar etaf-rv--left-reads 0)
|
|
(defvar etaf-rv--right-reads 0)
|
|
(defvar etaf-rv--events nil)
|
|
|
|
(defun etaf-rv--define (name arguments &rest clauses)
|
|
"Define test Component NAME with ARGUMENTS and CLAUSES lexically."
|
|
(etaf-component-redefine-run
|
|
(lambda ()
|
|
(eval `(etaf-define-component ,name ,arguments ,@clauses) t))))
|
|
|
|
(defmacro etaf-rv--with-buffer (&rest body)
|
|
"Run BODY in a temporary buffer and always dispose its Runtime."
|
|
(declare (indent 0) (debug t))
|
|
`(with-temp-buffer
|
|
(unwind-protect
|
|
(progn ,@body)
|
|
(when-let* ((runtime (etaf-runtime-for-buffer (current-buffer))))
|
|
(etaf-unmount runtime)))))
|
|
|
|
(ert-deftest etaf-render-view-equivalent-to-view-and-node ()
|
|
"All frontends produce the same visible structure and Host properties."
|
|
(etaf-rv--define 'etaf-rv-view '(&key label)
|
|
:view '(column :padding-inline 1
|
|
(text :font-weight 'bold (expr label))
|
|
(text "Body")))
|
|
(etaf-rv--define 'etaf-rv-render '(&key label)
|
|
:render '(let ((caption label))
|
|
(etaf-view
|
|
(column :padding-inline 1
|
|
(text :font-weight 'bold (expr caption))
|
|
(text "Body")))))
|
|
(etaf-rv--define 'etaf-rv-node '(&key label)
|
|
:render '(etaf-node
|
|
'column '(:padding-inline 1)
|
|
(list (etaf-node 'text '(:font-weight bold)
|
|
(list label))
|
|
(etaf-node 'text nil '("Body")))))
|
|
(let ((outputs
|
|
(mapcar
|
|
(lambda (name)
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount (current-buffer)
|
|
(etaf-node name '(:label "Title") nil))
|
|
(list (buffer-substring-no-properties (point-min) (point-max))
|
|
(progn
|
|
(goto-char (point-min))
|
|
(search-forward "Title")
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
'(etaf-rv-view etaf-rv-render etaf-rv-node))))
|
|
(should (equal (car outputs) (cadr outputs)))
|
|
(should (equal (car outputs) (caddr outputs)))))
|
|
|
|
(ert-deftest etaf-render-view-prop-loop-conflicts-match-view ()
|
|
"Nested Views use Component prop validation during definition expansion."
|
|
(dolist (body '((etaf-view
|
|
(column (text :for (item '("A")) :key item (expr item))))
|
|
(let ((prefix "item"))
|
|
(etaf-view
|
|
(column (text :for (item '("A")) :key item
|
|
(expr (concat prefix item))))))
|
|
(funcall
|
|
(lambda ()
|
|
(etaf-view
|
|
(column (text :for (item '("A")) :key item
|
|
(expr item))))))))
|
|
(let ((failure
|
|
(should-error
|
|
(macroexpand
|
|
`(etaf-define-component etaf-rv-conflict (&key item)
|
|
:render ,body))
|
|
:type 'etaf-view-syntax-error)))
|
|
(should (string-match-p "conflicts with a Component prop"
|
|
(error-message-string failure)))))
|
|
(should-error
|
|
(macroexpand
|
|
'(etaf-define-component etaf-rv-conflict (&key item)
|
|
:view (column (text :for (item '("A")) :key item (expr item)))))
|
|
:type 'etaf-view-syntax-error))
|
|
|
|
(ert-deftest etaf-render-view-preserves-ordinary-lexical-shadowing ()
|
|
"Let and lambda bindings shadow prop shorthand using normal Elisp scope."
|
|
(etaf-rv--define
|
|
'etaf-rv-shadow '(&key label)
|
|
:render
|
|
'(let* ((original label)
|
|
(label "local")
|
|
(caption (funcall (lambda (label) (concat original "/" label))
|
|
label)))
|
|
(etaf-view
|
|
(box :ref 'etaf-rv-shadow-button
|
|
:on-press (lambda () (push caption etaf-rv--events))
|
|
(text (expr caption))))))
|
|
(let ((etaf-rv--events nil))
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount (current-buffer)
|
|
(etaf-node 'etaf-rv-shadow '(:label "prop") nil))
|
|
(should (equal "prop/local" (buffer-string)))
|
|
(etaf-dispatch-event (etaf-runtime-for-buffer (current-buffer))
|
|
'etaf-rv-shadow-button 'press)
|
|
(should (equal '("prop/local") etaf-rv--events)))))
|
|
|
|
(ert-deftest etaf-render-view-retains-surrounding-macro-environment ()
|
|
"A lexically scoped macro cannot hide a View from prop grammar checks."
|
|
(should-error
|
|
(macroexpand-all
|
|
'(cl-macrolet
|
|
((local-view ()
|
|
'(etaf-view
|
|
(column (text :for (item '("A")) :key item (expr item))))))
|
|
(etaf-define-component etaf-rv-macro-conflict (&key item)
|
|
:render (local-view))))
|
|
:type 'etaf-view-syntax-error))
|
|
|
|
(ert-deftest etaf-render-view-props-shadow-surrounding-symbol-macros ()
|
|
"A Component's prop scope overrides same-named outer symbol macros."
|
|
(etaf-component-redefine-run
|
|
(lambda ()
|
|
(eval
|
|
'(cl-symbol-macrolet ((label "Outer"))
|
|
(etaf-define-component etaf-rv-outer-shadow (&key label)
|
|
:render (etaf-view (text (expr label)))))
|
|
t)))
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount (current-buffer)
|
|
(etaf-node 'etaf-rv-outer-shadow '(:label "Prop") nil))
|
|
(should (equal "Prop" (buffer-string)))))
|
|
|
|
(ert-deftest etaf-render-view-byte-compiled-callback-retains-lexical-props ()
|
|
"Compiled Component definitions preserve the same delayed callback scope."
|
|
(let ((byte-compile-error-on-warn t)
|
|
(etaf-rv--events nil))
|
|
(etaf-component-redefine-run
|
|
(lambda ()
|
|
(funcall
|
|
(byte-compile
|
|
'(lambda ()
|
|
(etaf-define-component etaf-rv-compiled (&key label)
|
|
:render
|
|
(let ((caption label))
|
|
(etaf-view
|
|
(box :ref 'etaf-rv-compiled-button
|
|
:on-press (lambda () (push caption etaf-rv--events))
|
|
(text (expr caption)))))))))))
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount (current-buffer)
|
|
(etaf-node 'etaf-rv-compiled '(:label "Compiled") nil))
|
|
(should (equal "Compiled" (buffer-string)))
|
|
(etaf-dispatch-event (etaf-runtime-for-buffer (current-buffer))
|
|
'etaf-rv-compiled-button 'press)
|
|
(should (equal '("Compiled") etaf-rv--events)))))
|
|
|
|
(ert-deftest etaf-render-view-keeps-deferred-dependencies-local ()
|
|
"Capturing stable handles does not pull reactive reads into Component render."
|
|
(etaf-rv--define
|
|
'etaf-rv-deferred '(&key left right)
|
|
:setup '(list left right)
|
|
:render
|
|
'(progn
|
|
(cl-incf etaf-rv--renders)
|
|
(let* ((state (etaf-state))
|
|
(left-ref (car state))
|
|
(right-ref (cadr state)))
|
|
(etaf-view
|
|
(column
|
|
(text (expr (progn (cl-incf etaf-rv--left-reads)
|
|
(etaf-value left-ref))))
|
|
(text (expr (progn (cl-incf etaf-rv--right-reads)
|
|
(etaf-value right-ref)))))))))
|
|
(let ((left (etaf-ref "Left A"))
|
|
(right (etaf-ref "Right A"))
|
|
(etaf-rv--renders 0)
|
|
(etaf-rv--left-reads 0)
|
|
(etaf-rv--right-reads 0))
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount (current-buffer)
|
|
(etaf-node 'etaf-rv-deferred (list :left left :right right)
|
|
nil))
|
|
(let ((renders etaf-rv--renders)
|
|
(left-reads etaf-rv--left-reads)
|
|
(right-reads etaf-rv--right-reads))
|
|
(setf (etaf-value left) "Left B")
|
|
(should (string-match-p "Left B" (buffer-string)))
|
|
(should (= renders etaf-rv--renders))
|
|
(should (> etaf-rv--left-reads left-reads))
|
|
(should (= right-reads etaf-rv--right-reads))))))
|
|
|
|
(ert-deftest etaf-render-view-projects-caller-owned-slots ()
|
|
"Embedded Views distinguish projections from named inputs and caller props."
|
|
(etaf-rv--define
|
|
'etaf-rv-panel '(&key label)
|
|
:render '(let ((heading label))
|
|
(etaf-view
|
|
(column
|
|
(text (expr heading))
|
|
(slot)
|
|
(slot :name 'footer (text "Fallback"))))))
|
|
(etaf-rv--define
|
|
'etaf-rv-slot-owner '(&key label)
|
|
:render '(let ((caption label))
|
|
(etaf-view
|
|
(etaf-rv-panel :label "Panel"
|
|
(text (expr label))
|
|
(slot :name 'footer (text (expr (concat caption " footer"))))))))
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount (current-buffer)
|
|
(etaf-node 'etaf-rv-slot-owner '(:label "Caller") nil))
|
|
(should (string-match-p "Panel[[:space:]]+Caller[[:space:]]+Caller footer"
|
|
(buffer-string)))
|
|
(should-not (string-match-p "Fallback" (buffer-string))))
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount (current-buffer)
|
|
(etaf-node 'etaf-rv-panel '(:label "Panel") nil))
|
|
(should (string-match-p "Fallback" (buffer-string)))))
|
|
|
|
(ert-deftest etaf-render-view-callback-captures-committed-prop-snapshot ()
|
|
"A normal lexical callback uses new committed props and survives rollback."
|
|
(etaf-rv--define
|
|
'etaf-rv-snapshot '(&key label)
|
|
:render '(let ((caption label))
|
|
(etaf-view
|
|
(box :ref 'etaf-rv-snapshot-button
|
|
:on-press (lambda () (push caption etaf-rv--events))
|
|
(text (expr caption))))))
|
|
(let ((label (etaf-ref "A"))
|
|
(etaf-rv--events nil))
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount
|
|
(current-buffer)
|
|
(lambda ()
|
|
(etaf-node
|
|
'column nil
|
|
(list (etaf-node 'etaf-rv-snapshot
|
|
(list :label (etaf-value label)) nil)
|
|
(etaf-view
|
|
(text (expr (if (equal (etaf-value label) "Failed")
|
|
(error "Rejected sibling")
|
|
"Sibling"))))))))
|
|
(let ((runtime (etaf-runtime-for-buffer (current-buffer))))
|
|
(etaf-dispatch-event runtime 'etaf-rv-snapshot-button 'press)
|
|
(setf (etaf-value label) "B")
|
|
(etaf-dispatch-event runtime 'etaf-rv-snapshot-button 'press)
|
|
(let ((published (buffer-string)))
|
|
(should-error (setf (etaf-value label) "Failed"))
|
|
(should (equal-including-properties published (buffer-string))))
|
|
(etaf-dispatch-event runtime 'etaf-rv-snapshot-button 'press)
|
|
(should (equal '("B" "B" "A") etaf-rv--events))))))
|
|
|
|
(ert-deftest etaf-render-view-callback-live-ref-is-not-a-ui-snapshot ()
|
|
"An explicit shared ref remains live even when a sibling rejects its UI."
|
|
(etaf-rv--define
|
|
'etaf-rv-live '(&key model)
|
|
:render '(let ((shared model))
|
|
(etaf-view
|
|
(box :ref 'etaf-rv-live-button
|
|
:on-press (lambda ()
|
|
(push (etaf-value shared) etaf-rv--events))
|
|
(text "Read live")))))
|
|
(let ((model (etaf-ref "A"))
|
|
(etaf-rv--events nil))
|
|
(etaf-rv--with-buffer
|
|
(etaf-mount
|
|
(current-buffer)
|
|
(etaf-node
|
|
'column nil
|
|
(list (etaf-node 'etaf-rv-live (list :model model) nil)
|
|
(etaf-view
|
|
(text (expr (if (equal (etaf-value model) "B")
|
|
(error "Rejected live value")
|
|
"Sibling")))))))
|
|
(let ((runtime (etaf-runtime-for-buffer (current-buffer)))
|
|
(published (buffer-string)))
|
|
(should-error (setf (etaf-value model) "B"))
|
|
(should (equal-including-properties published (buffer-string)))
|
|
(etaf-dispatch-event runtime 'etaf-rv-live-button 'press)
|
|
(should (equal '("B") etaf-rv--events))))))
|
|
|
|
(provide 'etaf-render-view-tests)
|
|
;;; etaf-render-view-tests.el ends here
|