3 (in-suite lisp-on-lines
)
5 (deftest test-attribute-value
()
8 (define-description attribute-test-description
()
9 ((attribute-1 :value
"VALUE")
10 (attribute-2 :function
(constantly "VALUE"))))
12 (deflayer attribute-test
)
14 (define-description attribute-test-description
()
15 ((attribute-1 :value
"VALUE2")
16 (attribute-2 :function
(constantly "VALUE2")))
17 (:in-layer . attribute-test
))))
19 (let ((d (find-description 'attribute-test-description
)))
20 (dletf (((described-object d
) nil
))
21 (is (equalp "VALUE" (slot-value (find-attribute d
'attribute-1
) 'lol
::value
)))
23 (with-active-layers (attribute-test)
24 (is (equalp (attribute-value (find-attribute d
'attribute-1
))
25 (attribute-value (find-attribute d
'attribute-2
))))
26 (is (equalp "VALUE2" (attribute-value (find-attribute d
'attribute-1
))))))))
28 (deftest test-attribute-property-inheriting
()
29 (test-attribute-value)
31 (deflayer attribute-property-test
)
32 (define-description attribute-test-description
()
33 ((attribute-1 :label
"attribute1")
34 (attribute-2 :label
"attribute2"))
35 (:in-layer . attribute-property-test
))))
36 (with-active-layers (attribute-property-test)
37 (let ((d (find-description 'attribute-test-description
)))
38 (dletf (((described-object d
) nil
))
40 (is (equalp "VALUE" (slot-value (find-attribute d
'attribute-1
) 'lol
::value
)))
42 (is (equalp "attribute1" (attribute-label (find-attribute d
'attribute-1
))))
43 (is (equalp "attribute2" (attribute-label (find-attribute d
'attribute-2
))))
46 (with-active-layers (attribute-test)
47 (is (equalp (attribute-value (find-attribute d
'attribute-1
))
48 (attribute-value (find-attribute d
'attribute-2
))))
49 (is (equalp "VALUE2" (attribute-value (find-attribute d
'attribute-1
)))))))))
51 (deftest (test-attribute-with-different-class :compile-before-run t
) ()
54 test-attribute-class
(lol::standard-attribute
)
55 ((some-slot :initarg
:some-slot
57 :layered-accessor some-slot
)))
59 (define-description test-attribute-with-different-class-description
()
60 ((attribute-with-different-class :attribute-class test-attribute-class
:some-slot
"BRILLANT!")))))
62 (let* ((d (find-description 'test-attribute-with-different-class-description
))
64 (a (find-attribute d
'attribute-with-different-class
)))
66 (find-class 'test-attribute-class
)))
67 (is (equalp "BRILLANT!" (some-slot a
)))))
69 (deftest (test-attribute-with-different-class-and-subclassed-description :compile-before-run t
) ()
70 (test-attribute-with-different-class)
72 (define-description test-attribute-with-different-class-description-sub
73 (test-attribute-with-different-class-description)
76 (let* ((d (find-description 'test-attribute-with-different-class-description-sub
))
78 (a (find-attribute d
'attribute-with-different-class
)))
80 (find-class 'test-attribute-class
)))
81 (is (equalp "BRILLANT!" (some-slot a
)))))