Commit 4eddbd96 authored by pfdietz's avatar pfdietz

Fixed some broken structure tests (the values of uninitialized fields

are not specified by the standard; they need not be nil.)

Added additional tests to the defstruct-with-tests macros (check that
FUNCALLing various defstruct-defined functions works.)

Started on structures-03.lsp, which will test BOA constructor functions.
parent 64e09bb8
......@@ -263,6 +263,7 @@ do the defstruct."
(and (fboundp (quote ,p-fn))
(functionp (function ,p-fn))
(symbol-function (quote ,p-fn))
(notnot (funcall #',p-fn (,make-fn)))
(notnot (,p-fn (,make-fn))))
t)))
......@@ -291,8 +292,10 @@ do the defstruct."
(list* (intern (string slot-name) "KEYWORD")
(list 'quote initval)
inits))
(push `(eqlt (quote ,initval)
(,field-fn ,var))
(push `(and (eqlt (quote ,initval)
(,field-fn ,var))
(eqlt (quote ,initval)
(funcall #',field-fn ,var)))
tests))
`(let ((,var (,make-fn . ,inits)))
(and ,@tests t)))
......@@ -335,7 +338,8 @@ do the defstruct."
,@(when copy-fn
`((deftest ,(make-struct-test-name name 9)
,(let* ((var 'XTEMP-9)
(var2 'YTEMP-9))
(var2 'YTEMP-9)
(var3 'ZTEMP-9))
`(let ((,var (,make-fn
,@(loop
for (slot-name . initval)
......@@ -343,14 +347,18 @@ do the defstruct."
nconc (list (intern (string slot-name)
"KEYWORD")
`(quote ,initval))))))
(let ((,var2 (,copy-fn ,var)))
(let ((,var2 (,copy-fn ,var))
(,var3 (funcall #',copy-fn ,var)))
(and
(not (eqlt ,var ,var2))
(not (eqlt ,var ,var3))
(not (eqlt ,var2 ,var3))
,@(loop
for (slot-name . nil) in initial-value-alist
for fn in field-fns
collect
`(eqlt (,fn ,var) (,fn ,var2)))
`(and (eqlt (,fn ,var) (,fn ,var2))
(eqlt (,fn ,var) (,fn ,var3))))
t))))
t)))
......
......@@ -204,25 +204,22 @@
(defstruct-with-tests (struct-test-37 (:type list)) a37 b37 c37)
(deftest structure-37-1
(equalt (make-struct-test-37 :a37 1 :b37 2 :c37 4)
'(1 2 4))
t)
(make-struct-test-37 :a37 1 :b37 2 :c37 4)
(1 2 4))
(defstruct-with-tests (struct-test-38 (:type list) :named) a38 b38 c38)
(deftest structure-38-1
(equalt (make-struct-test-38 :a38 11 :b38 12 :c38 4)
'(struct-test-38 11 12 4))
t)
(make-struct-test-38 :a38 11 :b38 12 :c38 4)
(struct-test-38 11 12 4))
(defstruct-with-tests (struct-test-39 (:predicate nil)
(:type list) :named)
a39 b39 c39)
(deftest structure-39-1
(equalt (make-struct-test-39 :a39 11 :b39 12 :c39 4)
'(struct-test-39 11 12 4))
t)
(make-struct-test-39 :a39 11 :b39 12 :c39 4)
(struct-test-39 11 12 4))
(defstruct-with-tests (struct-test-40 (:type vector)) a40 b40)
(defstruct-with-tests (struct-test-41 (:type vector) :named) a41 b41)
......@@ -247,16 +244,16 @@
a45 b45)
(deftest structure-45-1
(make-struct-test-45 :a45 1 :b45 2)
(nil nil 1 2))
(cddr (make-struct-test-45 :a45 1 :b45 2))
(1 2))
(defstruct-with-tests (struct-test-46 (:type list)
(:include struct-test-45))
c46 d46)
(deftest structure-46-1
(make-struct-test-46 :a45 1 :b45 2 :c46 3 :d46 4)
(nil nil 1 2 3 4))
(cddr (make-struct-test-46 :a45 1 :b45 2 :c46 3 :d46 4))
(1 2 3 4))
(defstruct-with-tests (struct-test-47 (:type list)
(:initial-offset 3)
......@@ -264,8 +261,9 @@
c47 d47)
(deftest structure-47-1
(make-struct-test-47 :a45 1 :b45 2 :c47 3 :d47 4)
(nil nil 1 2 nil nil nil 3 4))
(let ((s (make-struct-test-47 :a45 1 :b45 2 :c47 3 :d47 4)))
(values (third s) (fourth s) (eighth s) (ninth s)))
1 2 3 4)
(defstruct-with-tests (struct-test-48 (:type list)
(:initial-offset 0)
......@@ -273,8 +271,8 @@
c48 d48)
(deftest structure-48-1
(make-struct-test-48 :a45 1 :b45 2 :c48 3 :d48 4)
(nil nil 1 2 3 4))
(cddr (make-struct-test-48 :a45 1 :b45 2 :c48 3 :d48 4))
(1 2 3 4))
(defstruct-with-tests (struct-test-49 (:type (vector bit)))
(a49 0 :type bit)
......@@ -297,9 +295,9 @@
a53 b53)
(deftest structure-53-1
(equal-array (make-struct-test-53 :a53 10 :b53 'a)
#(nil nil nil nil nil 10 a))
t)
(let ((s (make-struct-test-53 :a53 10 :b53 'a)))
(values (aref s 5) (aref s 6)))
10 a)
(defstruct-with-tests (struct-test-54 (:type vector)
(:initial-offset 2)
......@@ -307,9 +305,9 @@
a54 b54)
(deftest structure-54-1
(equal-array (make-struct-test-54 :a53 8 :b53 'g :a54 10 :b54 'a)
#(nil nil nil nil nil 8 g nil nil 10 a))
t)
(let ((s (make-struct-test-54 :a53 8 :b53 'g :a54 10 :b54 'a)))
(values (aref s 5) (aref s 6) (aref s 9) (aref s 10)))
8 g 10 a)
(defstruct-with-tests (struct-test-55 (:type list)
(:initial-offset 2)
......@@ -317,10 +315,26 @@
a55 b55 c55)
(deftest structure-55-1
(make-struct-test-55 :a55 'p :c55 'q)
(nil nil struct-test-55 p nil q))
(let ((s (make-struct-test-55 :a55 'p :c55 'q)))
(values (third s) (fourth s) (sixth s)))
struct-test-55 p q)
(defstruct-with-tests (struct-test-56 (:type list)
(:initial-offset 3)
(:include struct-test-55)
:named)
d56 e56)
(deftest structure-56-1
(let ((s (make-struct-test-56 :a55 3 :b55 7 :d56 'x :e56 'y)))
(mapcar #'(lambda (i) (nth i s)) '(2 3 4 9 10 11)))
(struct-test-55 3 7 struct-test-56 x y))
(defstruct-with-tests (struct-test-57 (:include struct-test-22))
c57 d57)
;;;; Tests of error cases
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Dec 20 05:58:06 2002
;;;; Contains: BOA Constructor Tests
(in-package :cl-test)
\ No newline at end of file
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