Include some more new stuff.
[clinton/lisp-on-lines.git] / src / description-test.lisp
CommitLineData
e7c5f95a 1(in-package :lol-test)
2
3(defsuite lisp-on-lines)
4
5(in-suite lisp-on-lines)
6
7(defclass lol-test-class ()
8 ((string-slot
9 :accessor string-slot
10 :initform "test"
11 :type string)
12 (number-slot
13 :accessor number-slot
14 :initform 12345
15 :type number)
16 (symbol-slot
17 :accessor symbol-slot
18 :initform 'symbol
19 :type symbol)))
20
21(deftest test-simple-define-description ()
22 (eval '(lol:define-description test-description ()
23 ((test-attribute :label "BRILLANT!"))))
24
25 (eval '(deflayer test-description-layer))
26
27 (eval '(lol:define-description test-description ()
28 ((test-attribute :label "BRILLANT-IN-LAYER"))
29 (:in-layer . test-description-layer))))
30
31(deftest test-T-description ()
32 (let ((d (find-description t)))
33 (is (find-attribute d 'identity))))
34
35(deftest test-simple-attributes ()
36 (test-simple-define-description)
37 (let* ((desc (find-description 'test-description))
38 (att (find-attribute desc 'test-attribute)))
39 (is (equal "BRILLANT!" (slot-value att 'lol::label)))
40 (with-active-layers (test-description-layer)
41 (is (equal "BRILLANT-IN-LAYER" (slot-value att 'lol::label))))))
42
43(deftest test-special-slot-values ()
44 (test-simple-attributes)
45 (is (equalp '(lol::label "BRILLANT!")
46 (lol::special-slot-values
47 (find-description 'test-description) 'test-attribute))))
48
49(defparameter *atomic-type-specifiers*
50 '(arithmetic-error function simple-condition
51 array generic-function simple-error
52 atom hash-table simple-string
53 base-char integer simple-type-error
54 base-string keyword simple-vector
55 bignum list simple-warning
56 bit logical-pathname single-float
57 bit-vector long-float standard-char
58 broadcast-stream method standard-class
59 built-in-class method-combination standard-generic-function
60 cell-error nil standard-method
61 character null standard-object
62 class number storage-condition
63 compiled-function package stream
64 complex package-error stream-error
65 concatenated-stream parse-error string
66 condition pathname string-stream
67 cons print-not-readable structure-class
68 control-error program-error structure-object
69 division-by-zero random-state style-warning
70 double-float ratio symbol
71 echo-stream rational synonym-stream
72 end-of-file reader-error t
73 error readtable two-way-stream
74 extended-char real type-error
75 file-error restart unbound-slot
76 file-stream sequence unbound-variable
77 fixnum serious-condition undefined-function
78 float short-float unsigned-byte
79 floating-point-inexact signed-byte vector
80 floating-point-invalid-operation simple-array warning
81 floating-point-overflow simple-base-string
82 floating-point-underflow simple-bit-vector))
83
84(deftest test-basic-types-description-of ()
85 (let* ((symbol 'symbol)
86 (string "string")
87 (number 0)
88 (list (list symbol string number)))))
89
90
91
92
93
94
95