| 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 | |
HCoop / clinton / lisp-on-lines.git / blame