Commit ad6c20d0 authored by pfdietz's avatar pfdietz

Modified structure tests to use interned temporary names. Added beginning of...

Modified structure tests to use interned temporary names.  Added beginning of :include option handling.
parent c6fa246e
......@@ -106,6 +106,9 @@
return opt
finally (return default)))
(defvar *defstruct-with-tests-names* nil
"Names of structure types defined with DEFSRUCT-WITH-TESTS.")
;;
;; There are a number of standardized tests for
;; structures. The following macro generates the
......@@ -174,6 +177,7 @@ do the defstruct."
(struct-type (second type-option))
(named-option (find-option options :named))
(include-option (find-option options :include))
;; The :predicate option entry from OPTIONS, or NIL if none
(predicate-option (find-option options :predicate))
......@@ -228,15 +232,20 @@ do the defstruct."
for slot-desc in slot-descriptions
for slot-name in slot-names
for type in slot-types
for i from 1
collect (if (not (eq type :none))
(cons slot-name (create-instance-of-type type))
(cons slot-name (gensym)))))
(cons slot-name (defstruct-maketemp name "SLOTTEMP" i)))))
)
;; Build the tests in an eval-when form
`(eval-when (compile load eval)
(ignore-errors
(eval '(defstruct ,name-and-options
,@slot-descriptions-and-documentation)))
,@slot-descriptions-and-documentation))
,(unless (or type-option include-option)
`(pushnew ',name *defstruct-with-tests-names*))
nil)
;; Test that structure is of the correct type
(deftest ,(make-struct-test-name name 1)
......@@ -273,7 +282,7 @@ do the defstruct."
(deftest ,(make-struct-test-name name 5)
,(let ((inits nil)
(tests nil)
(var (gensym "X")))
(var (defstruct-maketemp name "TEMP-5")))
(loop
for (slot-name . initval) in initial-value-alist
for field-fn in field-fns
......@@ -296,8 +305,8 @@ do the defstruct."
;; Check that we can setf the fields
(deftest ,(make-struct-test-name name 7)
,(let* ((var (gensym "X"))
(var2 (gensym "T"))
,(let* ((var (defstruct-maketemp name "TEMP-7-1"))
(var2 (defstruct-maketemp name "TEMP-7-2"))
(tests
(loop
for (slot-name . initval) in initial-value-alist
......@@ -325,8 +334,8 @@ do the defstruct."
;; Check that the copy function properly copies fields
,@(when copy-fn
`((deftest ,(make-struct-test-name name 9)
,(let* ((var (gensym "X"))
(var2 (gensym "Y")))
,(let* ((var 'XTEMP-9)
(var2 'YTEMP-9))
`(let ((,var (,make-fn
,@(loop
for (slot-name . initval)
......@@ -414,6 +423,11 @@ do the defstruct."
collect type))
nil)
))
nil
)))
(defun defstruct-maketemp (stem suffix1 &optional suffix2)
"Make a temporary variable for DEFSTRUCT-WITH-TESTS."
(intern (if suffix2 (format nil "~A-~A-~A" stem suffix1 suffix2)
(format nil "~A-~A" stem suffix1))))
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