1.0.43.29: fix OVERAGER-CHARACTER-BUFFERING test-case

[sbcl.git] / tests / defstruct.impure.lisp

diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp
index 04e3e1c..e84e4f3 100644 (file)
--- a/tests/defstruct.impure.lisp
+++ b/tests/defstruct.impure.lisp
@@ -1038,4 +1038,36 @@ redefinition."
     (assert-is pred1 instance)
     (assert-is pred2 instance)))
 
-
+(with-test (:name :raw-slot/circle-subst)
+  ;; CIRCLE-SUBSTS used %INSTANCE-REF on raw slots
+  (multiple-value-bind (list n)
+      (eval '(progn
+              (defstruct raw-slot/circle-subst
+                (x 0.0 :type single-float))
+              (read-from-string "((#1=#S(raw-slot/circle-subst :x 2.7158911)))")))
+    (destructuring-bind ((struct)) list
+      (assert (raw-slot/circle-subst-p struct))
+      (assert (eql 2.7158911 (raw-slot/circle-subst-x struct)))
+      (assert (eql 45 n)))))
+
+(defstruct (bug-3b (:constructor make-bug-3b (&aux slot)))
+  (slot nil :type string))
+
+(with-test (:name :bug-3b)
+  (handler-case
+      (progn
+        (bug-3b-slot (make-bug-3b))
+        (error "fail"))
+    (type-error (e)
+      (assert (eq 'string (type-error-expected-type e)))
+      (assert (zerop (type-error-datum e))))))
+
+(with-test (:name defstruct-copier-typechecks-argument)
+  (assert (not (raises-error? (copy-person (make-astronaut :name "Neil")))))
+  (assert (raises-error? (copy-astronaut (make-person :name "Fred")))))
+
+(with-test (:name :bug-528807)
+  (let ((*evaluator-mode* :compile))
+    (handler-bind ((style-warning #'error))
+      (eval `(defstruct (bug-528807 (:constructor make-528807 (&aux x)))
+               (x nil :type fixnum))))))