diff --git a/ansi-tests/structure-00.lsp b/ansi-tests/structure-00.lsp index 7d20c76f64471e5ada666af169614fb35212749b..968c6ae6ce02bef22208a4c91860e77e75660fc9 100644 --- a/ansi-tests/structure-00.lsp +++ b/ansi-tests/structure-00.lsp @@ -243,8 +243,8 @@ do the defstruct." (and (fboundp (quote ,make-fn)) (functionp (function ,make-fn)) (symbol-function (quote ,make-fn)) - ,@(unless type-option - `((typep (,make-fn) (quote ,name)))) + (typep (,make-fn) (quote ,(if type-option struct-type + name))) t) t) @@ -263,7 +263,6 @@ do the defstruct." `((deftest ,(make-struct-test-name name 3) (count-if (function ,p-fn) *universe*) 0))) - ,@(unless type-option `((deftest ,(make-struct-test-name name 4) (count-if (function (lambda (x) (typep x (quote ,name)))) @@ -375,6 +374,22 @@ do the defstruct." when read-only collect `(not (fboundp '(setf ,field-fn)))) t) - t))) + t))) + + ;; When the structure is a true structure type, check that + ;; the various class relationships hold + ,@(unless type-option + `( + (deftest ,(make-struct-test-name name 13) + (notnot (typep (,make-fn) (find-class (quote ,name)))) + t) + (deftest ,(make-struct-test-name name 14) + (let ((class (find-class (quote ,name)))) + (notnot (typep class 'structure-class))) + t) + (deftest ,(make-struct-test-name name 15) + (notnot (typep (,make-fn) 'structure-object)) + t) + )) nil ))) diff --git a/ansi-tests/structures-02.lsp b/ansi-tests/structures-02.lsp index 3d743097f1d3806767c612e04cd2a0f757a6b216..903dc7a177e7c6cd52beb711aface769b695b360 100644 --- a/ansi-tests/structures-02.lsp +++ b/ansi-tests/structures-02.lsp @@ -199,7 +199,7 @@ (defstruct-with-tests (struct-test-36 (:conc-name "")) struct-test-package::st36-a36 struct-test-package::st26-b36) -;;; List structures +;;; List and vector structures (defstruct-with-tests (struct-test-37 (:type list)) a37 b37 c37) (defstruct-with-tests (struct-test-38 (:type list) :named) a38 b38 c38) @@ -207,13 +207,11 @@ (:type list) :named) a39 b39 c39) -;;; Vector structures - (defstruct-with-tests (struct-test-40 (:type vector)) a40 b40) (defstruct-with-tests (struct-test-41 (:type vector) :named) a41 b41) (defstruct-with-tests (struct-test-42 (:type (vector t))) a42 b42) (defstruct-with-tests (struct-test-43 (:type (vector t)) :named) a43 b43) - - - +(defstruct-with-tests (struct-test-44 (:type list)) + (a44 0 :type integer) + (b44 'a :type symbol))