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 (define-description attribute-test
)
14 (define-description attribute-test-description
()
15 ((attribute-1 :value
"VALUE2")
16 (attribute-2 :function
(constantly "VALUE2")))
17 (:in-description attribute-test
))))
19 (funcall-with-described-object
21 (a1 (find-attribute *description
* 'attribute-1
))
22 (a2 (find-attribute *description
* 'attribute-2
))
24 (is (equalp "VALUE" (attribute-value a1
)))
25 (is (equalp "VALUE" (attribute-value a2
)))
26 (with-active-descriptions (attribute-test)
27 (is (equalp "VALUE2" (attribute-value a1
)))
28 (is (equalp "VALUE2" (attribute-value a2
)))))
30 (find-description 'attribute-test-description
)))
32 (deftest test-attribute-property-inheriting
()
33 (test-attribute-value)
35 (define-description attribute-property-test
)
36 (define-description attribute-test-description
()
37 ((attribute-1 :label
"attribute1")
38 (attribute-2 :label
"attribute2"))
39 (:in-description attribute-property-test
))))
41 (with-active-descriptions (attribute-property-test)
42 (with-described-object (nil (find-description 'attribute-test-description
))
43 (let ((d (dynamic description
)))
44 (is (equalp "VALUE" (slot-value (find-attribute d
'attribute-1
) 'lol
::value
)))
46 (is (equalp "attribute1" (attribute-label (find-attribute d
'attribute-1
))))
47 (is (equalp "attribute2" (attribute-label (find-attribute d
'attribute-2
))))
50 (with-active-descriptions (attribute-test)
51 (is (equalp (attribute-value (find-attribute d
'attribute-1
))
52 (attribute-value (find-attribute d
'attribute-2
))))
53 (is (equalp "VALUE2" (attribute-value (find-attribute d
'attribute-1
)))))))
56 (deftest (test-attribute-with-different-class :compile-before-run t
) ()
59 test-attribute-class
(standard-attribute)
60 ((some-slot :initarg
:some-slot
63 :layered-accessor some-slot
)))
65 (define-description test-attribute-with-different-class-description
()
66 ((attribute-with-different-class :attribute-class test-attribute-class
:some-slot
"BRILLANT!")))))
68 (let* ((d (find-description 'test-attribute-with-different-class-description
))
70 (a (find-attribute d
'attribute-with-different-class
)))
72 (find-class 'test-attribute-class
)))
73 (is (equalp "BRILLANT!" (some-slot a
)))))
75 (deftest (test-attribute-with-different-class-and-subclassed-description :compile-before-run t
) ()
76 (test-attribute-with-different-class)
78 (define-description test-attribute-with-different-class-description-sub
79 (test-attribute-with-different-class-description)
82 (let* ((d (find-description 'test-attribute-with-different-class-description-sub
))
84 (a (find-attribute d
'attribute-with-different-class
)))
86 (find-class 'test-attribute-class
)))
87 (is (equalp "BRILLANT!" (some-slot a
)))))