Commit 38b4e66d authored by pfdietz's avatar pfdietz

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.)
parent 0bb76b95
......@@ -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
)))
......@@ -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))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment