;;; An &AUX variable in a boa-constructor without a default value
;;; means "do not initialize slot" and does not cause type error
(defstruct (boa-saux (:constructor make-boa-saux (&aux a (b 3) (c))))
- (a #\! :type (integer 1 2))
- (b #\? :type (integer 3 4))
- (c #\# :type (integer 5 6)))
+ (a #\! :type (integer 1 2))
+ (b #\? :type (integer 3 4))
+ (c #\# :type (integer 5 6)))
(let ((s (make-boa-saux)))
+ (declare (notinline identity))
+ #+nil ; bug 235a
+ (locally (declare (optimize (safety 3))
+ (inline boa-saux-a))
+ (assert (raises-error? (identity (boa-saux-a s)) type-error)))
+ (setf (boa-saux-a s) 1)
+ (setf (boa-saux-c s) 5)
+ (assert (eql (boa-saux-a s) 1))
+ (assert (eql (boa-saux-b s) 3))
+ (assert (eql (boa-saux-c s) 5)))
+ ; these two checks should be
+ ; kept separated
+(let ((s (make-boa-saux)))
+ (declare (notinline identity))
+ (locally (declare (optimize (safety 0))
+ (inline boa-saux-a))
+ (assert (eql (identity (boa-saux-a s)) 0)))
(setf (boa-saux-a s) 1)
(setf (boa-saux-c s) 5)
(assert (eql (boa-saux-a s) 1))
(assert (raises-error? (conc-name-nil-slot (make-conc-name-nil))
undefined-function))
\f
+;;; The named/typed predicates were a little fragile, in that they
+;;; could throw errors on innocuous input:
+(defstruct (list-struct (:type list) :named) a-slot)
+(assert (list-struct-p (make-list-struct)))
+(assert (not (list-struct-p nil)))
+(assert (not (list-struct-p 1)))
+(defstruct (offset-list-struct (:type list) :named (:initial-offset 1)) a-slot)
+(assert (offset-list-struct-p (make-offset-list-struct)))
+(assert (not (offset-list-struct-p nil)))
+(assert (not (offset-list-struct-p 1)))
+(assert (not (offset-list-struct-p '(offset-list-struct))))
+(assert (not (offset-list-struct-p '(offset-list-struct . 3))))
+(defstruct (vector-struct (:type vector) :named) a-slot)
+(assert (vector-struct-p (make-vector-struct)))
+(assert (not (vector-struct-p nil)))
+(assert (not (vector-struct-p #())))
+
;;; success
(format t "~&/returning success~%")
(quit :unix-status 104)