fix(ecss): isolate mutable boundary data
Deep-copy mutable selector, schema, stylesheet, cascade, and computed-style values at public ownership boundaries while preserving function identity.\n\nVerified with make check: 57/57 ERT, WERROR byte compilation, checkdoc, and diff checks.
This commit is contained in:
Kinneyzhang
parent
9f6025ee12
commit
51feda4685
103
ecss-cascade.el
103
ecss-cascade.el
@ -114,11 +114,12 @@
|
||||
|
||||
(defun ecss--normalize-schema-initial (initial normalizer validator)
|
||||
"Normalize and validate schema INITIAL with NORMALIZER and VALIDATOR."
|
||||
(let ((normalized (funcall normalizer (copy-tree initial))))
|
||||
(let ((normalized
|
||||
(funcall normalizer (ecss--copy-boundary-data initial))))
|
||||
(unless (funcall validator normalized)
|
||||
(signal 'ecss-invalid-property-schema
|
||||
(list :invalid-initial initial)))
|
||||
normalized))
|
||||
(ecss--copy-boundary-data normalized)))
|
||||
|
||||
(defun ecss--build-property-schema (id options)
|
||||
"Build a validated property schema for ID from OPTIONS."
|
||||
@ -154,7 +155,8 @@
|
||||
"Return a defensive copy of SCHEMA."
|
||||
(let ((copy (copy-ecss-property-schema schema)))
|
||||
(setf (ecss-property-schema-initial copy)
|
||||
(copy-tree (ecss-property-schema-initial schema)))
|
||||
(ecss--copy-boundary-data
|
||||
(ecss-property-schema-initial schema)))
|
||||
copy))
|
||||
|
||||
(defun ecss-schema-set-property (schemas id)
|
||||
@ -166,7 +168,7 @@
|
||||
(defun ecss-schema-set-property-ids (schemas)
|
||||
"Return property identifiers from SCHEMAS in registration order."
|
||||
(ecss--schema-set-check schemas)
|
||||
(copy-sequence (ecss--schema-set-order schemas)))
|
||||
(ecss--copy-boundary-data (ecss--schema-set-order schemas)))
|
||||
|
||||
(defun ecss-schema-set-clear (schemas)
|
||||
"Remove every property schema from SCHEMAS."
|
||||
@ -254,10 +256,13 @@
|
||||
(if-let ((expander (and schema
|
||||
(ecss-property-schema-shorthand schema))))
|
||||
(pcase-let* ((`(,raw . ,important) (ecss--unwrap-important value))
|
||||
(expanded (funcall expander raw)))
|
||||
(expanded
|
||||
(ecss--copy-boundary-data
|
||||
(funcall expander
|
||||
(ecss--copy-boundary-data raw)))))
|
||||
(ecss--validate-expanded-longhands schemas property expanded)
|
||||
(ecss--tag-important expanded important))
|
||||
(list property value))))
|
||||
(list property (ecss--copy-boundary-data value)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun ecss-expand-declarations (schemas declarations)
|
||||
@ -278,8 +283,7 @@ the same expanded longhand, including explicit nil declarations."
|
||||
(dolist (declarations declaration-groups result)
|
||||
(cl-loop for (property value)
|
||||
on (ecss-expand-declarations schemas declarations) by #'cddr
|
||||
do (setq result
|
||||
(plist-put result property (copy-tree value)))))))
|
||||
do (setq result (plist-put result property value))))))
|
||||
|
||||
(defun ecss-stylesheet-create ()
|
||||
"Create an empty independent stylesheet."
|
||||
@ -294,9 +298,14 @@ the same expanded longhand, including explicit nil declarations."
|
||||
(defun ecss--copy-rule (rule)
|
||||
"Return a defensive copy of RULE."
|
||||
(let ((copy (copy-ecss-rule rule)))
|
||||
(setf (ecss-rule-selector copy) (copy-tree (ecss-rule-selector rule))
|
||||
(ecss-rule-declarations copy) (copy-tree (ecss-rule-declarations rule))
|
||||
(ecss-rule-scope copy) (copy-tree (ecss-rule-scope rule)))
|
||||
(setf (ecss-rule-selector copy)
|
||||
(ecss--copy-boundary-data (ecss-rule-selector rule))
|
||||
(ecss-rule-declarations copy)
|
||||
(ecss--copy-boundary-data (ecss-rule-declarations rule))
|
||||
(ecss-rule-layer copy)
|
||||
(ecss--copy-boundary-data (ecss-rule-layer rule))
|
||||
(ecss-rule-scope copy)
|
||||
(ecss--copy-boundary-data (ecss-rule-scope rule)))
|
||||
copy))
|
||||
|
||||
(defun ecss-stylesheet-rules (stylesheet)
|
||||
@ -320,7 +329,7 @@ the same expanded longhand, including explicit nil declarations."
|
||||
"Return STYLESHEET layers for ORIGIN in declared order.
|
||||
ORIGIN defaults to `author'."
|
||||
(ecss--stylesheet-check stylesheet)
|
||||
(copy-tree
|
||||
(ecss--copy-boundary-data
|
||||
(ecss--origin-layers
|
||||
stylesheet (ecss--validate-origin (or origin 'author)))))
|
||||
|
||||
@ -339,12 +348,14 @@ ORIGIN defaults to `author'."
|
||||
(setq origin (ecss--validate-origin (or origin 'author)))
|
||||
(unless (and (listp layers) (cl-every (lambda (layer) layer) layers))
|
||||
(signal 'ecss-invalid-rule (list :layers layers)))
|
||||
(let ((result (copy-tree (ecss--origin-layers stylesheet origin))))
|
||||
(let ((result (ecss--copy-boundary-data
|
||||
(ecss--origin-layers stylesheet origin))))
|
||||
(dolist (layer layers)
|
||||
(unless (member layer result)
|
||||
(setq result (append result (list (copy-tree layer))))))
|
||||
(setq result
|
||||
(append result (list (ecss--copy-boundary-data layer))))))
|
||||
(ecss--set-origin-layers stylesheet origin result)
|
||||
(copy-tree result)))
|
||||
(ecss--copy-boundary-data result)))
|
||||
|
||||
(defun ecss--validate-origin (origin)
|
||||
"Return ORIGIN when it is a standard cascade origin."
|
||||
@ -364,7 +375,8 @@ ORIGIN defaults to `author'."
|
||||
(layers (ecss--origin-layers stylesheet origin)))
|
||||
(when (and layer (not (member layer layers)))
|
||||
(ecss--set-origin-layers
|
||||
stylesheet origin (append layers (list (copy-tree layer))))))
|
||||
stylesheet origin
|
||||
(append layers (list (ecss--copy-boundary-data layer))))))
|
||||
(setf (ecss--stylesheet-source-order stylesheet)
|
||||
(ecss-rule-source-order rule)
|
||||
(ecss--stylesheet-rules stylesheet)
|
||||
@ -385,8 +397,8 @@ optional selector limiting the rule to a matching subject or ancestor."
|
||||
(expanded (ecss-expand-declarations schemas declarations))
|
||||
(source-order (1+ (ecss--stylesheet-source-order stylesheet)))
|
||||
(rule (ecss--make-rule
|
||||
:selector selector :declarations (copy-tree expanded)
|
||||
:origin origin :layer (copy-tree layer)
|
||||
:selector selector :declarations expanded
|
||||
:origin origin :layer (ecss--copy-boundary-data layer)
|
||||
:layer-rank (ecss--prospective-layer-rank
|
||||
stylesheet origin layer)
|
||||
:scope scope :source-order source-order)))
|
||||
@ -417,12 +429,13 @@ optional selector limiting the rule to a matching subject or ancestor."
|
||||
SPECIFICITY, DISTANCE, and DECLARATION-ORDER are the match precedence facts."
|
||||
(pcase-let ((`(,raw . ,important) (ecss--unwrap-important value)))
|
||||
(ecss--make-candidate
|
||||
:property property :value raw :origin (ecss-rule-origin rule)
|
||||
:property property :value (ecss--copy-boundary-data raw)
|
||||
:origin (ecss-rule-origin rule)
|
||||
:important important :inline nil :layer (ecss-rule-layer rule)
|
||||
:layer-rank (ecss-rule-layer-rank rule) :specificity specificity
|
||||
:scope-distance distance :source-order (ecss-rule-source-order rule)
|
||||
:declaration-order declaration-order
|
||||
:selector (copy-tree (ecss-rule-selector rule)))))
|
||||
:selector (ecss--copy-boundary-data (ecss-rule-selector rule)))))
|
||||
|
||||
(defun ecss--rule-candidates (rule subject adapter)
|
||||
"Return candidates from matching RULE for SUBJECT through ADAPTER."
|
||||
@ -447,7 +460,8 @@ SPECIFICITY, DISTANCE, and DECLARATION-ORDER are the match precedence facts."
|
||||
collect
|
||||
(pcase-let ((`(,raw . ,important) (ecss--unwrap-important value)))
|
||||
(ecss--make-candidate
|
||||
:property property :value raw :origin 'author
|
||||
:property property :value (ecss--copy-boundary-data raw)
|
||||
:origin 'author
|
||||
:important important :inline t :layer nil :layer-rank nil
|
||||
:specificity '(0 0 0)
|
||||
:scope-distance most-positive-fixnum
|
||||
@ -560,7 +574,9 @@ SCHEMAS validates inline declarations and ADAPTER exposes SUBJECT."
|
||||
|
||||
(defun ecss--resolve-source (value property subject resolver)
|
||||
"Resolve VALUE for PROPERTY and SUBJECT only through explicit RESOLVER."
|
||||
(if resolver (funcall resolver value property subject) value))
|
||||
(if resolver
|
||||
(ecss--copy-boundary-data (funcall resolver value property subject))
|
||||
value))
|
||||
|
||||
(defun ecss--parent-values (parent-style)
|
||||
"Return computed values from PARENT-STYLE."
|
||||
@ -585,8 +601,10 @@ SCHEMAS validates inline declarations and ADAPTER exposes SUBJECT."
|
||||
(values (ecss--parent-values parent-style)))
|
||||
(if (and (ecss-property-schema-inherits schema)
|
||||
(plist-member values property))
|
||||
(cons (copy-tree (plist-get values property)) 'inherit)
|
||||
(cons (copy-tree (ecss-property-schema-initial schema)) 'initial))))
|
||||
(cons (ecss--copy-boundary-data (plist-get values property)) 'inherit)
|
||||
(cons (ecss--copy-boundary-data
|
||||
(ecss-property-schema-initial schema))
|
||||
'initial))))
|
||||
|
||||
(defun ecss--wide-default (wide schema parent-style)
|
||||
"Resolve non-revert WIDE value for SCHEMA using PARENT-STYLE."
|
||||
@ -596,12 +614,16 @@ SCHEMAS validates inline declarations and ADAPTER exposes SUBJECT."
|
||||
(let ((values (ecss--parent-values parent-style))
|
||||
(property (ecss-property-schema-id schema)))
|
||||
(if (plist-member values property)
|
||||
(cons (copy-tree (plist-get values property)) 'inherit)
|
||||
(cons (copy-tree (ecss-property-schema-initial schema)) 'initial))))
|
||||
(cons (ecss--copy-boundary-data (plist-get values property))
|
||||
'inherit)
|
||||
(cons (ecss--copy-boundary-data
|
||||
(ecss-property-schema-initial schema))
|
||||
'initial))))
|
||||
('unset (if (ecss-property-schema-inherits schema)
|
||||
(ecss--wide-default (ecss-wide-value 'inherit)
|
||||
schema parent-style)
|
||||
(cons (copy-tree (ecss-property-schema-initial schema))
|
||||
(cons (ecss--copy-boundary-data
|
||||
(ecss-property-schema-initial schema))
|
||||
'initial)))))
|
||||
|
||||
(defun ecss--candidate-provenance (candidate &rest extra)
|
||||
@ -609,11 +631,13 @@ SCHEMAS validates inline declarations and ADAPTER exposes SUBJECT."
|
||||
(append
|
||||
(if candidate
|
||||
(list :source 'declaration
|
||||
:selector (copy-tree (ecss--candidate-selector candidate))
|
||||
:selector (ecss--copy-boundary-data
|
||||
(ecss--candidate-selector candidate))
|
||||
:origin (ecss--candidate-origin candidate)
|
||||
:important (and (ecss--candidate-important candidate) t)
|
||||
:inline (and (ecss--candidate-inline candidate) t)
|
||||
:layer (copy-tree (ecss--candidate-layer candidate))
|
||||
:layer (ecss--copy-boundary-data
|
||||
(ecss--candidate-layer candidate))
|
||||
:specificity (copy-sequence
|
||||
(ecss--candidate-specificity candidate))
|
||||
:scope-distance (ecss--candidate-scope-distance candidate)
|
||||
@ -665,7 +689,7 @@ sources. Retain winner facts when PROVENANCE-P is non-nil."
|
||||
(let ((table (make-hash-table :test #'eq)) provenance)
|
||||
(cl-loop for (property value) on (ecss--parent-custom-properties parent-style)
|
||||
by #'cddr
|
||||
do (puthash property value table)
|
||||
do (puthash property (ecss--copy-boundary-data value) table)
|
||||
when provenance-p
|
||||
do (setq provenance
|
||||
(plist-put provenance property '(:source inherit))))
|
||||
@ -793,9 +817,10 @@ STACK detects cycles and DIAGNOSTICS records them."
|
||||
(if (eq value ecss--invalid)
|
||||
value
|
||||
(let ((normalized
|
||||
(funcall (ecss-property-schema-normalizer schema) value)))
|
||||
(funcall (ecss-property-schema-normalizer schema)
|
||||
(ecss--copy-boundary-data value))))
|
||||
(if (funcall (ecss-property-schema-validator schema) normalized)
|
||||
normalized
|
||||
(ecss--copy-boundary-data normalized)
|
||||
ecss--invalid))))
|
||||
|
||||
(defun ecss--compute-candidate-value
|
||||
@ -811,7 +836,7 @@ explicit sources, and DIAGNOSTICS records variable failures."
|
||||
source schema parent-style custom diagnostics)))
|
||||
(cons (if (eq (cdr resolved) 'declaration)
|
||||
(ecss--normalize-property-value schema (car resolved))
|
||||
(copy-tree (car resolved)))
|
||||
(ecss--copy-boundary-data (car resolved)))
|
||||
(cdr resolved))))
|
||||
|
||||
(defun ecss--fallback-value (schema parent-style)
|
||||
@ -961,27 +986,29 @@ non-nil, is the only function allowed to evaluate caller-owned value sources;
|
||||
(defun ecss-computed-style-values (style)
|
||||
"Return a defensive values plist from computed STYLE."
|
||||
(ecss--computed-style-check style)
|
||||
(copy-tree (ecss--computed-style-values style)))
|
||||
(ecss--copy-boundary-data (ecss--computed-style-values style)))
|
||||
|
||||
(defun ecss-computed-style-custom-properties (style)
|
||||
"Return a defensive custom property plist from computed STYLE."
|
||||
(ecss--computed-style-check style)
|
||||
(copy-tree (ecss--computed-style-custom-properties style)))
|
||||
(ecss--copy-boundary-data
|
||||
(ecss--computed-style-custom-properties style)))
|
||||
|
||||
(defun ecss-computed-style-active-properties (style)
|
||||
"Return actively supplied property identifiers from computed STYLE."
|
||||
(ecss--computed-style-check style)
|
||||
(copy-sequence (ecss--computed-style-active-properties style)))
|
||||
(ecss--copy-boundary-data
|
||||
(ecss--computed-style-active-properties style)))
|
||||
|
||||
(defun ecss-computed-style-provenance (style)
|
||||
"Return defensive winner provenance from computed STYLE."
|
||||
(ecss--computed-style-check style)
|
||||
(copy-tree (ecss--computed-style-provenance style)))
|
||||
(ecss--copy-boundary-data (ecss--computed-style-provenance style)))
|
||||
|
||||
(defun ecss-computed-style-diagnostics (style)
|
||||
"Return defensive diagnostics from computed STYLE."
|
||||
(ecss--computed-style-check style)
|
||||
(copy-tree (ecss--computed-style-diagnostics style)))
|
||||
(ecss--copy-boundary-data (ecss--computed-style-diagnostics style)))
|
||||
|
||||
(defun ecss-computed-style-value (style property &optional fallback)
|
||||
"Return PROPERTY from computed STYLE, or FALLBACK when absent."
|
||||
|
||||
@ -44,6 +44,23 @@
|
||||
(defvar ecss--selector-anchor nil
|
||||
"Dynamically bound subject anchoring a relative selector.")
|
||||
|
||||
(defun ecss--copy-boundary-data (value)
|
||||
"Return a detached copy of mutable caller boundary VALUE.
|
||||
Function values retain identity so executable literals remain callable."
|
||||
(cond
|
||||
((functionp value) value)
|
||||
((consp value)
|
||||
(cons (ecss--copy-boundary-data (car value))
|
||||
(ecss--copy-boundary-data (cdr value))))
|
||||
((stringp value) (copy-sequence value))
|
||||
((bool-vector-p value) (copy-sequence value))
|
||||
((or (vectorp value) (recordp value))
|
||||
(let ((copy (copy-sequence value)))
|
||||
(dotimes (index (length copy))
|
||||
(aset copy index (ecss--copy-boundary-data (aref copy index))))
|
||||
copy))
|
||||
(t value)))
|
||||
|
||||
(defun ecss--adapter-callback-p (value)
|
||||
"Return non-nil when VALUE is a valid adapter callback."
|
||||
(functionp value))
|
||||
@ -79,9 +96,11 @@ an alist. PARENT and CHILDREN establish its initial tree position."
|
||||
(when (and parent (not (ecss-subject-p parent)))
|
||||
(signal 'wrong-type-argument (list 'ecss-subject-p parent)))
|
||||
(let ((subject (ecss--make-subject
|
||||
:type type :id id :classes (copy-sequence classes)
|
||||
:attributes (copy-tree attributes)
|
||||
:states (copy-sequence states))))
|
||||
:type (ecss--copy-boundary-data type)
|
||||
:id (ecss--copy-boundary-data id)
|
||||
:classes (ecss--copy-boundary-data classes)
|
||||
:attributes (ecss--copy-boundary-data attributes)
|
||||
:states (ecss--copy-boundary-data states))))
|
||||
(ecss-subject-set-children subject children)
|
||||
(when parent
|
||||
(ecss-subject-set-children
|
||||
@ -464,7 +483,7 @@ an alist. PARENT and CHILDREN establish its initial tree position."
|
||||
(defun ecss-selector-normalize (selector)
|
||||
"Return a validated defensive AST for string or structured SELECTOR."
|
||||
(let ((ast (if (stringp selector) (ecss-selector-parse selector) selector)))
|
||||
(copy-tree (ecss--validate-selector ast))))
|
||||
(ecss--copy-boundary-data (ecss--validate-selector ast))))
|
||||
|
||||
(defun ecss--subject-attribute-cell (subject adapter name)
|
||||
"Return SUBJECT attribute NAME through ADAPTER."
|
||||
|
||||
@ -101,6 +101,20 @@
|
||||
'(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-follow-declaration-order ()
|
||||
(let ((schemas (ecss-cascade-test--schemas))
|
||||
(subject (ecss-cascade-test--subject)))
|
||||
@ -419,6 +433,10 @@
|
||||
(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 ()
|
||||
@ -449,14 +467,18 @@
|
||||
(should (eq (plist-get facts :fallback) 'initial))
|
||||
(should-not (ecss-computed-style-present-p style 'app/width)))))
|
||||
|
||||
(ert-deftest ecss-cascade-test-literal-functions-are-never-called ()
|
||||
(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))))
|
||||
:declarations (list 'app/payload literal)))
|
||||
(value (ecss-cascade-test--value style 'app/payload)))
|
||||
(should (zerop calls))
|
||||
(should (functionp (ecss-cascade-test--value style 'app/payload))))))
|
||||
(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))
|
||||
@ -582,6 +604,109 @@
|
||||
(should (equal (ecss-stylesheet-layers stylesheet)
|
||||
'((theme base)))))))
|
||||
|
||||
(ert-deftest ecss-cascade-test-schema-boundaries-copy-mutable-values ()
|
||||
(let* ((schemas (ecss-schema-set-create))
|
||||
(caller-initial (vector (copy-sequence "base"))))
|
||||
(ecss-schema-set-define schemas 'app/value :initial caller-initial)
|
||||
(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-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))
|
||||
|
||||
@ -95,6 +95,35 @@
|
||||
(should (ecss-selector-match-p '(:class "primary") subject))
|
||||
(should (ecss-selector-match-p '(:state "focus") subject))))
|
||||
|
||||
(ert-deftest ecss-selector-test-normalize-copies-structured-selector-data ()
|
||||
(let* ((token (copy-sequence "target"))
|
||||
(selector (list :class token))
|
||||
(normalized (ecss-selector-normalize selector)))
|
||||
(aset (cadr normalized) 0 ?X)
|
||||
(should (equal selector '(:class "target")))
|
||||
(aset token 1 ?Y)
|
||||
(should (equal normalized '(:class "Xarget")))))
|
||||
|
||||
(ert-deftest ecss-selector-test-subject-snapshots-mutable-fields ()
|
||||
(let* ((type (copy-sequence "button"))
|
||||
(id (copy-sequence "save"))
|
||||
(classes (list (copy-sequence "primary")))
|
||||
(attributes (list (cons "role" (copy-sequence "submit"))))
|
||||
(states (list (copy-sequence "active")))
|
||||
(subject (ecss-subject-create
|
||||
:type type :id id :classes classes
|
||||
:attributes attributes :states states)))
|
||||
(aset type 0 ?X)
|
||||
(aset id 0 ?X)
|
||||
(aset (car classes) 0 ?X)
|
||||
(aset (cdar attributes) 0 ?X)
|
||||
(aset (car states) 0 ?X)
|
||||
(should (equal (ecss-subject-type subject) "button"))
|
||||
(should (equal (ecss-subject-id subject) "save"))
|
||||
(should (equal (ecss-subject-classes subject) '("primary")))
|
||||
(should (equal (ecss-subject-attributes subject) '(("role" . "submit"))))
|
||||
(should (equal (ecss-subject-states subject) '("active")))))
|
||||
|
||||
(ert-deftest ecss-selector-test-caller-owned-subject-adapter ()
|
||||
(let* ((root (vector "panel" "root" '("app") nil nil nil nil))
|
||||
(child (vector "button" "save" '("primary")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user