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
()
53 ;;;; We cannot ever redefine this class ic think...
54 ;;; as attributes are also slot meta-objects.
55 (unless (find-class 'test-attribute-class nil
)
57 test-attribute-class
(lol::standard-attribute
)
58 ((some-slot :initarg
:some-slot
:layered-accessor some-slot
))))
60 (define-description test-attribute-with-different-class-description
()
61 ((attribute-with-different-class :attribute-class test-attribute-class
:some-slot
"BRILLANT!")))))
63 (let* ((d (find-description 'test-attribute-with-different-class-description
))
65 (a (find-attribute d
'attribute-with-different-class
)))
67 (find-class 'test-attribute-class
)))
68 (is (equalp "BRILLANT!" (some-slot a
)))))