diff --git a/ansi-tests/deftype.lsp b/ansi-tests/deftype.lsp index bd1f12fb211c2289c473079568c3aa665982079e..71abdd0a8cbb52c3f77fa3602a88e48fa0b00f68 100644 --- a/ansi-tests/deftype.lsp +++ b/ansi-tests/deftype.lsp @@ -36,7 +36,192 @@ '(even-array (unsigned-byte 8)))) t) +(deftest deftype.7 + (let ((sym (gensym))) + (assert (eq (eval `(deftype ,sym () '(integer 0 10))) sym)) + (documentation sym 'type)) + nil) + +(deftest deftype.8 + (let ((sym (gensym))) + (assert (eq (eval `(deftype ,sym () "FOO" '(integer 0 10))) sym)) + (or (documentation sym 'type) "FOO")) + "FOO") + +(deftest deftype.9 + (let* ((sym (gensym)) + (form `(deftype ,sym (&optional x) `(integer 0 ,x)))) + (values + (eqlt (eval form) sym) + (multiple-value-list (subtypep* `(,sym) 'unsigned-byte)) + (multiple-value-list (subtypep* 'unsigned-byte `(,sym))) + (multiple-value-list (subtypep* `(,sym 4) '(integer 0 4))) + (multiple-value-list (subtypep* '(integer 0 4) `(,sym 4))) + (loop for x in '(a -1 0 1 2 3 4 5 b) + collect (notnot (typep x sym))) + (loop for x in '(a -1 0 1 2 3 4 5 b) + collect (notnot (typep x `(,sym 4)))) + )) + t (t t) (t t) (t t) (t t) + (nil nil t t t t t t nil) + (nil nil t t t t t nil nil)) + +(deftest deftype.10 + (let* ((sym (gensym)) + (form `(deftype ,sym (&optional (x 14)) `(integer 0 ,x)))) + (values + (eqlt (eval form) sym) + (multiple-value-list (subtypep* `(,sym) '(integer 0 14))) + (multiple-value-list (subtypep* '(integer 0 14) `(,sym))) + (multiple-value-list (subtypep* `(,sym 4) '(integer 0 4))) + (multiple-value-list (subtypep* '(integer 0 4) `(,sym 4))) + (loop for x in '(a -1 0 1 2 3 4 5 14 15 b) + collect (notnot (typep x sym))) + (loop for x in '(a -1 0 1 2 3 4 5 14 15 b) + collect (notnot (typep x `(,sym 4)))) + )) + t (t t) (t t) (t t) (t t) + (nil nil t t t t t t t nil nil) + (nil nil t t t t t nil nil nil nil)) + +(deftest deftype.11 + (let* ((sym (gensym)) + (form `(deftype ,sym (&key foo bar) `(integer ,foo ,bar)))) + (values + (eqlt (eval form) sym) + (multiple-value-list (subtypep* `(,sym) 'integer)) + (multiple-value-list (subtypep* 'integer `(,sym))) + + (multiple-value-list (subtypep* `(,sym :allow-other-keys nil) 'integer)) + (multiple-value-list (subtypep* 'integer `(,sym :allow-other-keys nil))) + (multiple-value-list (subtypep* `(,sym :xyz 17 :allow-other-keys t) 'integer)) + (multiple-value-list (subtypep* 'integer `(,sym :allow-other-keys t abc nil))) + + (multiple-value-list (subtypep* `(,sym :foo 3) '(integer 3))) + (multiple-value-list (subtypep* '(integer 3) `(,sym :foo 3))) + (multiple-value-list (subtypep* `(,sym :bar 10) '(integer * 10))) + (multiple-value-list (subtypep* '(integer * 10) `(,sym :bar 10))) + + (multiple-value-list (subtypep* `(,sym :foo 3 :foo 4 :bar 6) '(integer 3 6))) + (multiple-value-list (subtypep* '(integer 3 6) `(,sym :foo 3 :foo 4 :bar 6))) + (multiple-value-list (subtypep* `(,sym :bar * :foo (1)) '(integer 2))) + (multiple-value-list (subtypep* '(integer 2) `(,sym :bar * :foo (1)))) + )) + t + (t t) (t t) + (t t) (t t) (t t) (t t) + (t t) (t t) (t t) (t t) + (t t) (t t) (t t) (t t) + ) + +(deftest deftype.12 + (let* ((sym (gensym)) + (form `(deftype ,sym (&key foo bar &allow-other-keys) `(integer ,foo ,bar)))) + (values + (eqlt (eval form) sym) + (multiple-value-list (subtypep* `(,sym :xyz t) 'integer)) + (multiple-value-list (subtypep* 'integer `(,sym :xyz t))) + + (multiple-value-list (subtypep* `(,sym :allow-other-keys nil abc t) 'integer)) + (multiple-value-list (subtypep* 'integer `(,sym :allow-other-keys nil abc t))) + (multiple-value-list (subtypep* `(,sym :foo -10 :bar 20) '(integer -10 20))) + (multiple-value-list (subtypep* '(integer -10 20) `(,sym :foo -10 :bar 20))) + )) + t + (t t) (t t) + (t t) (t t) (t t) (t t) + ) + +(deftest deftype.13 + (let* ((sym (gensym)) + (form `(deftype ,sym (&rest args) (if args `(member ,@args) nil)))) + (values + (eqlt (eval form) sym) +;; (multiple-value-list (subtypep* sym nil)) +;; (multiple-value-list (subtypep* nil sym)) + (multiple-value-list (subtypep* `(,sym) nil)) + (multiple-value-list (subtypep* nil `(,sym))) + (notnot (typep 'a `(,sym a))) + (notnot (typep 'b `(,sym a))) + (notnot (typep '* `(,sym a))) + (notnot (typep 'a `(,sym a b))) + (notnot (typep 'b `(,sym a b))) + (notnot (typep 'c `(,sym a b))))) + t + (t t) (t t) + t nil nil t t nil) + +(deftest deftype.14 + (let* ((sym (gensym)) + (*f* nil) + (form `(let ((x 1)) + (declare (special *f*)) + (setf *f* #'(lambda (y) (setf x y))) + (deftype ,sym () `(integer 0 ,x))))) + (declare (special *f*)) + (values + (eqlt (eval form) sym) + (loop for i from -1 to 3 collect (typep* i sym)) + (funcall *f* 2) + (loop for i from -1 to 3 collect (typep* i sym)))) + t (nil t t nil nil) 2 (nil t t t nil)) + +(deftest deftype.15 + (let* ((sym (gensym)) + (a 1) + (form `(deftype ,sym (&optional (x a)) + (declare (special a)) + `(integer 0 ,x)))) + (values + (eqlt (eval form) sym) + (let ((a 2)) + (declare (special a)) + (loop for i from -1 to 3 collect (typep* i `(,sym 1)))) + (let ((a 2)) + (declare (special a)) + (loop for i from -1 to 3 collect (typep* i sym))))) + t + (nil t t nil nil) + (nil t t nil nil)) + +(deftest deftype.16 + (let* ((sym (gensym)) + (form `(deftype ,sym () (return-from ,sym 'integer)))) + (values + (eqlt (eval form) sym) + (subtypep* sym 'integer) + (subtypep* 'integer sym))) + t t t) + +(deftest deftype.17 + (let* ((sym (gensym)) + (form `(deftype ,sym () (values 'integer t)))) + (values + (eqlt (eval form) sym) + (subtypep* sym 'integer) + (subtypep* 'integer sym))) + t t t) + +(deftest deftype.18 + (let* ((sym (gensym)) + (form `(deftype ,sym ()))) + (values + (eqlt (eval form) sym) + (subtypep* sym nil) + (subtypep* nil sym))) + t t t) +(deftest deftype.19 + (let* ((sym (gensym)) + (form `(deftype ,sym () + (declare (optimize speed safety debug compilation-speed space)) + 'integer))) + (values + (eqlt (eval form) sym) + (subtypep* sym 'integer) + (subtypep* 'integer sym))) + t t t) + ;;; Error tests (deftest deftype.error.1