;;; ecss-cascade-tests.el --- Cascade tests -*- lexical-binding: t; -*-

;; Copyright (C) 2026 Geekinney
;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Code:

(require 'ert)
(require 'cl-lib)
(require 'ecss-cascade)

(defun ecss-cascade-test--schemas ()
  "Return the standard test schema set."
  (ecss-schema-set-compose
   (ecss-schema-package-create
    'app
    (append
     (list
      (list :id 'app/color :initial "black" :inherits t
            :validator #'stringp :impacts '(paint))
      (list :id 'app/width :initial 0 :validator #'integerp
            :impacts '(geometry))
      (list :id 'app/payload :initial nil :inherits t :impacts '(data)))
     (mapcar (lambda (property)
               (list :id property :initial 0 :validator #'integerp
                     :impacts '(geometry)))
             '(app/padding-top app/padding-right
               app/padding-bottom app/padding-left))
     (list
      (list
       :id 'app/padding :initial nil :impacts '(geometry)
       :shorthand
       (lambda (value)
         (list 'app/padding-top value 'app/padding-right value
               'app/padding-bottom value 'app/padding-left value))))))))

(defun ecss-cascade-test--subject (&rest options)
  "Return a button subject using OPTIONS."
  (apply #'ecss-subject-create :type "button" options))

(defun ecss-cascade-test--value (style property)
  "Return PROPERTY from computed STYLE."
  (ecss-computed-style-value style property :absent))

(ert-deftest ecss-cascade-test-computed-style-copy-with-values-is-defensive ()
  "Copy computed STYLE while replacing values and preserving metadata."
  (let* ((schemas (ecss-cascade-test--schemas))
         (subject (ecss-cascade-test--subject))
         (style (ecss-compute-style schemas subject
                                    :declarations '(app/color "red")))
         (copy (ecss-computed-style-copy-with-values
                style '(app/color "blue")
                :active-properties '(app/color)
                :specified-properties '(app/color)))
         (values (ecss-computed-style-values copy)))
    (should-not (eq style copy))
    (should (equal "blue" (plist-get values 'app/color)))
    (should (equal '(app/color)
                   (ecss-computed-style-active-properties copy)))
    (should (equal '(app/color)
                   (ecss-computed-style-specified-properties copy)))
    (setf (plist-get values 'app/color) "mutated")
    (should (equal "blue"
                   (ecss-computed-style-value copy 'app/color)))))

(ert-deftest ecss-cascade-test-schema-construction-is-atomic ()
  (should-error
   (ecss-schema-package-create
    'app
    '((:id app/width :initial 4 :validator integerp :impacts (geometry))
      (:id app/bad :initial "bad" :validator integerp :impacts (geometry))))
   :type 'ecss-invalid-property-schema)
  (let ((schemas
         (ecss-schema-set-compose
          (ecss-schema-package-create
           'app
           '((:id app/width :initial 4 :validator integerp
                  :impacts (geometry)))))))
    (should (= (ecss-property-schema-initial
                (ecss-schema-set-property schemas 'app/width))
               4))))

(ert-deftest ecss-cascade-test-computed-defaults-are-not-renormalized ()
  (let ((subject (ecss-cascade-test--subject))
        (normalizations 0))
    (let* ((schemas
            (ecss-schema-set-compose
             (ecss-schema-package-create
              'app
              (list
               (list :id 'app/value :initial 2 :inherits t
                     :normalizer
                     (lambda (value) (cl-incf normalizations) (* value 10))
                     :validator #'integerp :impacts '(data))))))
           (initial (ecss-compute-style schemas subject))
           (declared (ecss-compute-style
                      schemas subject :declarations '(app/value 3)))
           (inherited (ecss-compute-style
                       schemas subject :parent-style declared))
           (wide-initial
            (ecss-compute-style
             schemas subject :parent-style declared
             :declarations
             (list 'app/value (ecss-wide-value 'initial)))))
      (should (= (ecss-cascade-test--value initial 'app/value) 20))
      (should (= (ecss-cascade-test--value declared 'app/value) 30))
      (should (= (ecss-cascade-test--value inherited 'app/value) 30))
      (should (= (ecss-cascade-test--value wide-initial 'app/value) 20))
      (should (= normalizations 2)))))

(ert-deftest ecss-cascade-test-shorthand-expands-once-and-preserves-important ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (expanded (ecss-expand-declarations
                    schemas (list 'app/padding (ecss-important 3)))))
    (should (equal (cl-loop for (property _value) on expanded by #'cddr
                            collect property)
                   '(app/padding-top app/padding-right
                     app/padding-bottom app/padding-left)))
    (cl-loop for (_property value) on expanded by #'cddr
             do (should (ecss--important-p value))
             do (should (= (ecss--important-value value) 3)))))

(ert-deftest ecss-cascade-test-merge-declarations-compacts-expanded-longhands ()
  "Later declaration groups should replace expanded longhands without loss."
  (let ((schemas (ecss-cascade-test--schemas)))
    (should
     (equal
      (ecss-merge-declarations
       schemas
       '(app/padding 1 app/color "blue")
       '(app/padding-left 4 app/color nil))
      '(app/padding-top 1 app/padding-right 1
        app/padding-bottom 1 app/padding-left 4 app/color nil)))))

(ert-deftest ecss-cascade-test-merge-declarations-copies-caller-values ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (literal (lambda () :literal))
         (caller-value (vector (copy-sequence "blue") literal))
         (merged (ecss-merge-declarations
                  schemas (list 'app/payload caller-value)))
         (merged-value (plist-get merged 'app/payload)))
    (aset (aref merged-value 0) 0 ?X)
    (should (equal (aref caller-value 0) "blue"))
    (aset (aref caller-value 0) 1 ?Y)
    (should (equal (aref merged-value 0) "Xlue"))
    (should (eq (aref merged-value 1) literal))
    (should (eq (funcall (aref merged-value 1)) :literal))))

(ert-deftest ecss-cascade-test-shorthand-and-longhand-conflict-in-one-source ()
  (let ((schemas (ecss-cascade-test--schemas))
        (subject (ecss-cascade-test--subject)))
    (dolist (declarations
             '((app/padding 1 app/padding-left 2)
               (app/padding-left 2 app/padding 1)))
      (should-error
       (ecss-compute-style schemas subject :declarations declarations)
       :type 'ecss-invalid-declaration))))

(ert-deftest ecss-cascade-test-rule-addition-is-atomic ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create)))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".valid" '(app/color "blue") :layer 'base)
    (should-error
     (ecss-stylesheet-add-rule
      stylesheet schemas ".broken" '(unknown/value 1) :layer 'broken)
     :type 'ecss-invalid-declaration)
    (should (equal (ecss-stylesheet-layers stylesheet) '(base)))
    (should (= (length (ecss-stylesheet-rules stylesheet)) 1))))

(ert-deftest ecss-cascade-test-origin-importance-and-transition-order ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "ua") :origin 'ua)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "user") :origin 'user)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "author") :origin 'author)
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "author"))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/color (ecss-important "author-important"))
     :origin 'author)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/color (ecss-important "user-important"))
     :origin 'user)
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "user-important"))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "transition")
     :origin 'transition)
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "transition"))))

(ert-deftest ecss-cascade-test-standard-origin-levels-are-complete ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (dolist (entry
             (list (list 'author "author")
                   (list 'animation "animation")
                   (list 'author (ecss-important "author-important"))
                   (list 'user (ecss-important "user-important"))
                   (list 'ua (ecss-important "ua-important"))))
      (ecss-stylesheet-add-rule
       stylesheet schemas ".target" (list 'app/color (cadr entry))
       :origin (car entry)))
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "ua-important"))))

(ert-deftest ecss-cascade-test-layer-order-reverses-for-important ()
  (let ((schemas (ecss-cascade-test--schemas))
        (normal (ecss-stylesheet-create))
        (important (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-declare-layers normal '(base components))
    (ecss-stylesheet-add-rule
     normal schemas ".target" '(app/color "base") :layer 'base)
    (ecss-stylesheet-add-rule
     normal schemas ".target" '(app/color "components") :layer 'components)
    (ecss-stylesheet-add-rule normal schemas ".target" '(app/color "plain"))
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet normal)
                    'app/color)
                   "plain"))
    (ecss-stylesheet-declare-layers important '(base components))
    (dolist (entry '((base "base") (components "components") (nil "plain")))
      (ecss-stylesheet-add-rule
       important schemas ".target"
       (list 'app/color (ecss-important (cadr entry)))
       :layer (car entry)))
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet important)
                    'app/color)
                   "base"))
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style
                     schemas subject :stylesheet important
                     :declarations
                     (list 'app/color (ecss-important "inline")))
                    'app/color)
                   "inline"))))

(ert-deftest ecss-cascade-test-layer-order-is-independent-per-origin ()
  (let ((stylesheet (ecss-stylesheet-create)))
    (ecss-stylesheet-declare-layers stylesheet '(base components) 'author)
    (ecss-stylesheet-declare-layers stylesheet '(components base) 'user)
    (should (equal (ecss-stylesheet-layers stylesheet 'author)
                   '(base components)))
    (should (equal (ecss-stylesheet-layers stylesheet 'user)
                   '(components base)))))

(ert-deftest ecss-cascade-test-specificity-source-order-and-selector-list ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject
                  :id "actual" :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas "#other, .target" '(app/color "first"))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "later"))
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "later"))
    (ecss-stylesheet-add-rule
     stylesheet schemas "button#actual" '(app/color "id"))
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "id"))))

(ert-deftest ecss-cascade-test-scope-proximity-follows-specificity ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (stylesheet (ecss-stylesheet-create))
         (target (ecss-cascade-test--subject :classes '("target")))
         (inner (ecss-subject-create
                 :type "section" :classes '("inner")
                 :children (list target)))
         (_outer (ecss-subject-create
                  :type "main" :classes '("outer")
                  :children (list inner))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "outer") :scope ".outer")
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "inner") :scope ".inner")
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "missing") :scope ".missing")
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas target :stylesheet stylesheet)
                    'app/color)
                   "inner"))))

(ert-deftest ecss-cascade-test-inheritance-distinguishes-nil-from-absence ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (subject (ecss-cascade-test--subject))
         (parent (ecss-compute-style
                  schemas subject
                  :declarations '(app/color "red" app/payload nil)))
         (child (ecss-compute-style schemas subject :parent-style parent))
         (initial (ecss-compute-style schemas subject)))
    (should (equal (ecss-cascade-test--value child 'app/color) "red"))
    (should (null (ecss-cascade-test--value child 'app/payload)))
    (should (ecss-computed-style-present-p child 'app/payload))
    (should-not (ecss-computed-style-present-p initial 'app/payload))))

(ert-deftest ecss-cascade-test-css-wide-values-use-cascade-not-symbol-reservation ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (subject (ecss-cascade-test--subject :classes '("target")))
         (parent (ecss-compute-style
                  schemas subject :declarations '(app/color "parent")))
         (inherit (ecss-compute-style
                   schemas subject :parent-style parent
                   :declarations
                   (list 'app/color (ecss-wide-value 'inherit))))
         (initial (ecss-compute-style
                   schemas subject :parent-style parent
                   :declarations
                   (list 'app/color (ecss-wide-value 'initial)))))
    (should (equal (ecss-cascade-test--value inherit 'app/color) "parent"))
    (should (equal (ecss-cascade-test--value initial 'app/color) "black"))
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style
                     schemas subject :declarations '(app/payload inherit))
                    'app/payload)
                   'inherit))))

(ert-deftest ecss-cascade-test-revert-and-revert-layer-select-lower-candidates ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "ua") :origin 'ua)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "author") :origin 'author)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/color (ecss-wide-value 'revert)) :origin 'author)
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "ua"))
    (ecss-stylesheet-clear stylesheet)
    (ecss-stylesheet-declare-layers stylesheet '(base components))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "base") :layer 'base)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "components")
     :layer 'components)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/color (ecss-wide-value 'revert-layer)) :layer 'components)
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "base"))))

(ert-deftest ecss-cascade-test-important-revert-removes-entire-origin ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "user") :origin 'user)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "author-normal")
     :origin 'author)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/color (ecss-important (ecss-wide-value 'revert)))
     :origin 'author)
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "user"))))

(ert-deftest ecss-cascade-test-important-revert-layer-removes-entire-layer ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-declare-layers stylesheet '(base components))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "base") :layer 'base)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "component-normal")
     :layer 'components)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/color (ecss-important (ecss-wide-value 'revert-layer)))
     :layer 'components)
    (should (equal (ecss-cascade-test--value
                    (ecss-compute-style schemas subject :stylesheet stylesheet)
                    'app/color)
                   "base"))))

(ert-deftest ecss-cascade-test-custom-property-revert-removes-entire-origin ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(--theme 7) :origin 'user)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(--theme 8) :origin 'author)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list '--theme (ecss-important (ecss-wide-value 'revert)))
     :origin 'author)
    (let ((style (ecss-compute-style
                  schemas subject :stylesheet stylesheet
                  :declarations (list 'app/width (ecss-var '--theme)))))
      (should (= (ecss-cascade-test--value style 'app/width) 7)))))

(ert-deftest ecss-cascade-test-custom-properties-resolve-nested-values ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (subject (ecss-cascade-test--subject))
         (style (ecss-compute-style
                 schemas subject
                 :declarations
                 (list '--base 12 '--alias (ecss-var '--base)
                       'app/width (ecss-var '--alias)
                       'app/payload (list 'calc (ecss-var '--base))))))
    (should (= (ecss-cascade-test--value style 'app/width) 12))
    (should (equal (ecss-cascade-test--value style 'app/payload)
                   '(calc 12)))
    (should (equal (ecss-computed-style-custom-properties style)
                   '(--alias 12 --base 12)))))

(ert-deftest ecss-cascade-test-custom-properties-inherit-by-default ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (subject (ecss-cascade-test--subject))
         (parent (ecss-compute-style
                  schemas subject :declarations '(--theme 17)))
         (child (ecss-compute-style
                 schemas subject :parent-style parent
                 :declarations (list 'app/width (ecss-var '--theme)))))
    (should (= (ecss-cascade-test--value child 'app/width) 17))
    (should (equal (ecss-computed-style-custom-properties child)
                   '(--theme 17)))))

(ert-deftest ecss-cascade-test-variable-cycle-uses-outer-fallback ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (style (ecss-compute-style
                 schemas (ecss-cascade-test--subject)
                 :declarations
                 (list '--a (ecss-var '--b) '--b (ecss-var '--a)
                       'app/width (ecss-var '--a 9)))))
    (should (= (ecss-cascade-test--value style 'app/width) 9))
    (should (equal (ecss-computed-style-diagnostics style)
                   '((:type variable-cycle :path (--a --b --a)))))
    (let ((diagnostics (ecss-computed-style-diagnostics style)))
      (setcar (plist-get (car diagnostics) :path) 'damaged)
      (should (equal (ecss-computed-style-diagnostics style)
                     '((:type variable-cycle :path (--a --b --a))))))
    (should (null (ecss-computed-style-custom-properties style)))))

(ert-deftest ecss-cascade-test-parent-plist-is-snapshotted ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (payload (list 'original))
         (parent (list 'app/payload payload))
         (style (ecss-compute-style
                 schemas (ecss-cascade-test--subject)
                 :parent-style parent)))
    (setcar payload 'damaged)
    (should (equal (ecss-cascade-test--value style 'app/payload)
                   '(original)))))

(ert-deftest ecss-cascade-test-invalid-winner-does-not-recascade ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/width 10))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/width "invalid"))
    (let* ((style (ecss-compute-style
                   schemas subject :stylesheet stylesheet :provenance t))
           (facts (plist-get (ecss-computed-style-provenance style)
                             'app/width)))
      (should (= (ecss-cascade-test--value style 'app/width) 0))
      (should (eq (plist-get facts :valid) nil))
      (should (eq (plist-get facts :fallback) 'initial))
      (should-not (ecss-computed-style-present-p style 'app/width)))))

(ert-deftest ecss-cascade-test-literal-functions-remain-callable ()
  (let ((schemas (ecss-cascade-test--schemas)) (calls 0))
    (let* ((literal (lambda () (cl-incf calls)))
           (style (ecss-compute-style
                   schemas (ecss-cascade-test--subject)
                   :declarations (list 'app/payload literal)))
           (value (ecss-cascade-test--value style 'app/payload)))
      (should (zerop calls))
      (should (eq value literal))
      (should (functionp value))
      (funcall value)
      (should (= calls 1)))))

(ert-deftest ecss-cascade-test-explicit-resolver-runs-once ()
  (let ((schemas (ecss-cascade-test--schemas)) (calls 0))
    (let* ((source (list :computed (lambda () (cl-incf calls) 42)))
           (style
            (ecss-compute-style
             schemas (ecss-cascade-test--subject)
             :declarations (list 'app/width source)
             :value-resolver
             (lambda (value _property _subject)
               (if (eq (car-safe value) :computed)
                   (funcall (cadr value))
                 value)))))
      (should (= calls 1))
      (should (= (ecss-cascade-test--value style 'app/width) 42)))))

(ert-deftest ecss-cascade-test-resolver-never-runs-for-losing-sources ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target")))
        (calls 0))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/width (list :computed (lambda () (error "loser ran")))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".other"
     (list 'app/width (list :computed (lambda () (error "unmatched ran")))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/width 8))
    (let ((style
           (ecss-compute-style
            schemas subject :stylesheet stylesheet
            :value-resolver
            (lambda (value _property _subject)
              (cl-incf calls)
              (if (eq (car-safe value) :computed)
                  (funcall (cadr value))
                value)))))
      (should (= (ecss-cascade-test--value style 'app/width) 8))
      (should (= calls 1)))))

(ert-deftest ecss-cascade-test-resolver-skips-reverted-origin-losers ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target")))
        (calls 0))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/width 5) :origin 'ua)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/width (list :computed (lambda () (error "reverted loser ran"))))
     :origin 'author)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target"
     (list 'app/width (ecss-wide-value 'revert)) :origin 'author)
    (let ((style
           (ecss-compute-style
            schemas subject :stylesheet stylesheet
            :value-resolver
            (lambda (value _property _subject)
              (cl-incf calls)
              (if (eq (car-safe value) :computed)
                  (funcall (cadr value))
                value)))))
      (should (= (ecss-cascade-test--value style 'app/width) 5))
      (should (= calls 2)))))

(ert-deftest ecss-cascade-test-selected-resolver-errors-propagate ()
  (let ((schemas (ecss-cascade-test--schemas)))
    (should-error
     (ecss-compute-style
      schemas (ecss-cascade-test--subject)
      :declarations '(app/width 1)
      :value-resolver
      (lambda (_value _property _subject) (error "resolver boom")))
     :type 'error)))

(ert-deftest ecss-cascade-test-rule-list-is-an-independent-snapshot ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "snapshot"))
    (let ((rules (ecss-stylesheet-rules stylesheet)))
      (ecss-stylesheet-clear stylesheet)
      (should (equal (ecss-cascade-test--value
                      (ecss-compute-style schemas subject :rules rules)
                      'app/color)
                     "snapshot"))
      (should-error
       (ecss-compute-style
        schemas subject :stylesheet stylesheet :rules rules)
       :type 'ecss-invalid-rule))))

(ert-deftest ecss-cascade-test-rule-snapshot-is-revalidated ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "snapshot"))
    (let ((rules (ecss-stylesheet-rules stylesheet)))
      (setf (ecss-rule-declarations (car rules)) '(foreign/value 1))
      (should-error (ecss-compute-style schemas subject :rules rules)
                    :type 'ecss-invalid-declaration))))

(ert-deftest ecss-cascade-test-authoring-getters-are-defensive ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create)))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "blue") :layer '(theme base))
    (let ((schema (ecss-schema-set-property schemas 'app/color))
          (rules (ecss-stylesheet-rules stylesheet))
          (layers (ecss-stylesheet-layers stylesheet)))
      (setf (ecss-property-schema-initial schema) "damaged")
      (setf (ecss-rule-declarations (car rules)) '(app/color "damaged"))
      (setcar (car layers) 'damaged)
      (should (equal (ecss-property-schema-initial
                      (ecss-schema-set-property schemas 'app/color))
                     "black"))
      (should (equal (ecss-rule-declarations
                      (car (ecss-stylesheet-rules stylesheet)))
                     '(app/color "blue")))
      (should (equal (ecss-stylesheet-layers stylesheet)
                     '((theme base)))))))

(ert-deftest ecss-cascade-test-schema-boundaries-copy-mutable-values ()
  (let* ((caller-initial (vector (copy-sequence "base")))
         (schemas
          (ecss-schema-set-compose
           (ecss-schema-package-create
            'app
            (list (list :id 'app/value :initial caller-initial
                        :impacts '(data)))))))
    (aset (aref caller-initial 0) 0 ?X)
    (let ((stored (ecss-property-schema-initial
                   (ecss-schema-set-property schemas 'app/value))))
      (should (equal stored ["base"]))
      (aset (aref stored 0) 0 ?Y))
    (let ((property-ids (ecss-schema-set-property-ids schemas)))
      (setcar property-ids 'damaged)
      (should (equal (ecss-schema-set-property-ids schemas) '(app/value))))
    (should
     (equal (ecss-property-schema-initial
             (ecss-schema-set-property schemas 'app/value))
            ["base"]))))

(ert-deftest ecss-cascade-test-stylesheet-snapshots-mutable-inputs ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (stylesheet (ecss-stylesheet-create))
         (selector-token (copy-sequence "target"))
         (caller-value (vector (copy-sequence "blue")))
         (layer (vector (copy-sequence "theme"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas (list :class selector-token)
     (list 'app/payload caller-value) :layer layer)
    (aset selector-token 0 ?X)
    (aset (aref caller-value 0) 0 ?X)
    (aset (aref layer 0) 0 ?X)
    (let ((rule (car (ecss-stylesheet-rules stylesheet))))
      (should (equal (ecss-rule-selector rule) '(:class "target")))
      (should (equal (ecss-rule-declarations rule)
                     '(app/payload ["blue"])))
      (should (equal (ecss-stylesheet-layers stylesheet) '(["theme"]))))))

(ert-deftest ecss-cascade-test-stylesheet-getters-copy-mutable-values ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create)))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/payload ["blue"])
     :layer '["theme"])
    (let ((rule (car (ecss-stylesheet-rules stylesheet)))
          (layers (ecss-stylesheet-layers stylesheet)))
      (aset (aref (plist-get (ecss-rule-declarations rule) 'app/payload) 0)
            0 ?Y)
      (aset (aref (ecss-rule-layer rule) 0) 0 ?Y)
      (aset (aref (car layers) 0) 0 ?Y))
    (should (equal (ecss-rule-declarations
                    (car (ecss-stylesheet-rules stylesheet)))
                   '(app/payload ["blue"])))
    (should (equal (ecss-rule-layer
                    (car (ecss-stylesheet-rules stylesheet)))
                   '["theme"]))
    (should (equal (ecss-stylesheet-layers stylesheet) '(["theme"])))))

(ert-deftest ecss-cascade-test-computed-boundaries-copy-mutable-values ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (caller-value (vector (copy-sequence "blue")))
         (style (ecss-compute-style
                 schemas (ecss-cascade-test--subject)
                 :declarations (list 'app/payload caller-value)))
         (returned (plist-get (ecss-computed-style-values style)
                              'app/payload)))
    (aset (aref caller-value 0) 0 ?X)
    (should (equal (ecss-cascade-test--value style 'app/payload) ["blue"]))
    (aset (aref returned 0) 0 ?Y)
    (should (equal (ecss-cascade-test--value style 'app/payload) ["blue"]))
    (let ((active (ecss-computed-style-active-properties style)))
      (setcar active 'damaged)
      (should (equal (ecss-computed-style-active-properties style)
                     '(app/payload))))))

(ert-deftest ecss-cascade-test-custom-getter-copies-mutable-values ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (caller-value (vector (copy-sequence "blue")))
         (style (ecss-compute-style
                 schemas (ecss-cascade-test--subject)
                 :declarations (list '--theme caller-value)))
         (returned (plist-get (ecss-computed-style-custom-properties style)
                              '--theme)))
    (aset (aref caller-value 0) 0 ?X)
    (should (equal (ecss-computed-style-custom-properties style)
                   '(--theme ["blue"])))
    (aset (aref returned 0) 0 ?Y)
    (should (equal (ecss-computed-style-custom-properties style)
                   '(--theme ["blue"])))))

(ert-deftest ecss-cascade-test-specified-properties-track-declaration-winners ()
  (let* ((schemas (ecss-cascade-test--schemas))
         (stylesheet (ecss-stylesheet-create))
         (target (ecss-cascade-test--subject :classes '("target")))
         (initial (ecss-compute-style schemas target))
         parent child declared returned)
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/color "blue"))
    (setq parent
          (ecss-compute-style
           schemas target :declarations '(app/payload ("from-parent")))
          child
          (ecss-compute-style schemas target :parent-style parent)
          declared
          (ecss-compute-style
           schemas target :stylesheet stylesheet
           :declarations '(app/width 12 app/payload ("inline"))))
    (should (equal (ecss-computed-style-specified-properties declared)
                   '(app/color app/width app/payload)))
    (should (ecss-computed-style-specified-p declared 'app/color))
    (should (ecss-computed-style-specified-p declared 'app/width))
    (should (ecss-computed-style-specified-p declared 'app/payload))
    (should-not (ecss-computed-style-specified-p initial 'app/color))
    (should-not (ecss-computed-style-specified-p child 'app/payload))
    (should (ecss-computed-style-present-p child 'app/payload))
    (should (null (ecss-computed-style-provenance declared)))
    (setq returned (ecss-computed-style-specified-properties declared))
    (setcar returned :damaged)
    (should (equal (ecss-computed-style-specified-properties declared)
                   '(app/color app/width app/payload)))))

(ert-deftest ecss-cascade-test-cross-property-projection-reuses-cascade-order ()
  "A consumer projection should choose among property winners without recascade."
  (let* ((schemas (ecss-cascade-test--schemas))
         (stylesheet (ecss-stylesheet-create))
         (subject (ecss-cascade-test--subject
                   :id "hero" :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/padding-left 1))
    (ecss-stylesheet-add-rule
     stylesheet schemas "#hero" '(app/width 2))
    (let* ((ruled (ecss-compute-style
                    schemas subject :stylesheet stylesheet))
           (inline (ecss-compute-style
                     schemas subject :stylesheet stylesheet
                     :declarations '(app/padding-left 3)))
           (copy (ecss-computed-style-copy-with-values
                  inline (ecss-computed-style-values inline))))
      (should (eq (ecss-computed-style-precedence-winner
                   ruled '(app/padding-left app/width))
                  'app/width))
      (should (eq (ecss-computed-style-precedence-winner
                   inline '(app/padding-left app/width))
                  'app/padding-left))
      (should (eq (ecss-computed-style-precedence-winner
                   copy '(app/padding-left app/width))
                  'app/padding-left))
      (should-not (ecss-computed-style-provenance inline)))))

(ert-deftest ecss-cascade-test-cross-property-projection-skips-invalid-winner ()
  "An invalid declaration must not override a valid cross-property fact."
  (let* ((schemas (ecss-cascade-test--schemas))
         (stylesheet (ecss-stylesheet-create))
         (subject (ecss-cascade-test--subject
                   :id "hero" :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(app/padding-left 5))
    (ecss-stylesheet-add-rule
     stylesheet schemas "#hero" '(app/width "invalid"))
    (let ((style (ecss-compute-style
                  schemas subject :stylesheet stylesheet)))
      (should (eq (ecss-computed-style-precedence-winner
                   style '(app/padding-left app/width))
                  'app/padding-left))
      (should (memq 'app/width
                    (ecss-computed-style-specified-properties style)))
      (should-not (memq 'app/width
                        (ecss-computed-style-active-properties style)))
      (should (= (ecss-computed-style-value style 'app/width) 0)))))

(ert-deftest ecss-cascade-test-provenance-getter-copies-selector-data ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule stylesheet schemas ".target" '(app/width 1))
    (let* ((style (ecss-compute-style
                   schemas subject :stylesheet stylesheet :provenance t))
           (facts (plist-get (ecss-computed-style-provenance style) 'app/width))
           (selector (plist-get facts :selector)))
      (aset (cadr selector) 0 ?X)
      (should
       (equal (plist-get
               (plist-get (ecss-computed-style-provenance style) 'app/width)
               :selector)
              '(:class "target"))))))

(ert-deftest ecss-cascade-test-provenance-is-deterministic-and-defensive ()
  (let ((schemas (ecss-cascade-test--schemas))
        (stylesheet (ecss-stylesheet-create))
        (subject (ecss-cascade-test--subject :classes '("target"))))
    (ecss-stylesheet-add-rule
     stylesheet schemas ".target" '(--z 3 --a 1 app/color "blue"))
    (let* ((first (ecss-compute-style
                   schemas subject :stylesheet stylesheet :provenance t))
           (second (ecss-compute-style
                    schemas subject :stylesheet stylesheet :provenance t))
           (values (ecss-computed-style-values first))
           (facts (ecss-computed-style-provenance first)))
      (should (equal (ecss-computed-style-values first)
                     (ecss-computed-style-values second)))
      (should (equal facts (ecss-computed-style-provenance second)))
      (setcar values :damaged)
      (setcar facts :damaged)
      (should (equal (ecss-cascade-test--value first 'app/color) "blue"))
      (should-not (eq (car (ecss-computed-style-provenance first))
                      :damaged)))))

(ert-deftest ecss-cascade-test-computation-never-mutates-a-buffer ()
  (let ((schemas (ecss-cascade-test--schemas))
        (subject (ecss-cascade-test--subject)))
    (with-temp-buffer
      (insert "sentinel")
      (let ((before (buffer-string)))
        (cl-letf (((symbol-function 'insert)
                   (lambda (&rest _args) (error "buffer write")))
                  ((symbol-function 'delete-region)
                   (lambda (&rest _args) (error "buffer write")))
                  ((symbol-function 'add-text-properties)
                   (lambda (&rest _args) (error "buffer write")))
                  ((symbol-function 'put-text-property)
                   (lambda (&rest _args) (error "buffer write")))
                  ((symbol-function 'erase-buffer)
                   (lambda (&rest _args) (error "buffer write")))
                  ((symbol-function 'set-text-properties)
                   (lambda (&rest _args) (error "buffer write")))
                  ((symbol-function 'remove-text-properties)
                   (lambda (&rest _args) (error "buffer write"))))
          (should (ecss-computed-style-p
                   (ecss-compute-style
                    schemas subject :declarations '(app/color "blue")))))
        (should (equal (buffer-string) before))))))

(provide 'ecss-cascade-tests)
;;; ecss-cascade-tests.el ends here