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
)))
21 (is (equalp "VALUE" (slot-value (find-attribute d
'attribute-1
) 'lol
::value
)))
24 (with-active-layers (attribute-test)
25 (is (equalp (attribute-value nil
(find-attribute d
'attribute-1
))
26 (attribute-value nil
(find-attribute d
'attribute-2
))))
27 (is (equalp "VALUE2" (attribute-value nil
(find-attribute d
'attribute-1
)))))))
29 (deftest test-attribute-property-inheriting
()
30 (test-attribute-value)
32 (deflayer attribute-property-test
)
33 (define-description attribute-test-description
()
34 ((attribute-1 :label
"attribute1")
35 (attribute-2 :label
"attribute2"))
36 (:in-layer . attribute-property-test
))))
37 (with-active-layers (attribute-property-test)
38 (let ((d (find-description 'attribute-test-description
)))
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 nil
(find-attribute d
'attribute-1
))
48 (attribute-value nil
(find-attribute d
'attribute-2
))))
49 (is (equalp "VALUE2" (attribute-value nil
(find-attribute d
'attribute-1
))))))))
51 (deftest (test-attribute-with-different-class :compile-before-run t
) ()
53 ;;;; We cannot ever redefine this class ic think...
54 ;;; as attributes are also slot meta-objects.
58 test-attribute-class
(lol::standard-attribute
)
59 ((some-slot :initarg
:some-slot
61 :layered-accessor some-slot
)))
63 (define-description test-attribute-with-different-class-description
()
64 ((attribute-with-different-class :attribute-class test-attribute-class
:some-slot
"BRILLANT!")))))
66 (let* ((d (find-description 'test-attribute-with-different-class-description
))
68 (a (find-attribute d
'attribute-with-different-class
)))
70 (find-class 'test-attribute-class
)))
71 (is (equalp "BRILLANT!" (some-slot a
)))))