From 38b4e66d2b18ea830ddba7bfbb7c8f524be39c22 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Fri, 13 Dec 2002 13:26:49 +0000 Subject: [PATCH] Added test generators for: (1) structure objects are in a class with the name of the structure, (2) structure classes are instances of structure-class, (3) structure objects are instances of class structure-object. Also, test that TYPEP works when the type specifier is a class (this breaks currently in gcl.) --- ansi-tests/structure-00.lsp | 23 +++++++++++++++++++---- ansi-tests/structures-02.lsp | 10 ++++------ 2 files changed, 23 insertions(+), 10 deletions(-) diff --git a/ansi-tests/structure-00.lsp b/ansi-tests/structure-00.lsp index 7d20c76f..968c6ae6 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 3d743097..903dc7a1 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)) -- GitLab