X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fmop.pure.lisp;h=4b4bb1550e73a4e6b8bdfdc089c6ac1c08ce3724;hb=cf49f2d086069a9c1b57f501df9a6a0bd3a34c3c;hp=b35f47da2e967f79e2cff31bc54aba0c97f5e61f;hpb=1f9c4bb952a1f8b19ee9da0f54e95b2b3aa9111a;p=sbcl.git

diff --git a/tests/mop.pure.lisp b/tests/mop.pure.lisp
index b35f47d..4b4bb15 100644
--- a/tests/mop.pure.lisp
+++ b/tests/mop.pure.lisp
@@ -93,3 +93,47 @@
     (ensure-generic-function 'make-instance :method-combination mc))
   ;; Let's make sure the list works too...
   (ensure-generic-function 'make-instance :method-combination '(standard)))
+
+(with-test (:name :bug-309072)
+  ;; original reported test cases
+  (raises-error? (make-instance 'sb-mop:slot-definition))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'pi))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 3))
+  ;; extra cases from the MOP dictionary
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'x
+                                :initform nil))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'x
+                                :initfunction (lambda () nil)))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'x
+                                :initfunction (lambda () nil)))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'x
+                                :allocation ""))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'x
+                                :initargs ""))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'x
+                                :initargs '(foo . bar)))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'x
+                                :initargs '(foo bar 3)))
+  (raises-error? (make-instance 'sb-mop:slot-definition :name 'x
+                                :documentation '(())))
+  ;; distinction between DIRECT- and EFFECTIVE- slot definitions
+  (raises-error? (make-instance 'sb-mop:effective-slot-definition
+                                :name 'x :readers '(foo)))
+  (raises-error? (make-instance 'sb-mop:effective-slot-definition
+                                :name 'x :writers '(foo)))
+  (make-instance 'sb-mop:direct-slot-definition
+                 :name 'x :readers '(foo))
+  (make-instance 'sb-mop:direct-slot-definition
+                 :name 'x :writers '(foo))
+  (raises-error? (make-instance 'sb-mop:direct-slot-definition
+                                :name 'x :readers ""))
+  (raises-error? (make-instance 'sb-mop:direct-slot-definition
+                                :name 'x :readers '(3)))
+  (raises-error? (make-instance 'sb-mop:direct-slot-definition
+                                :name 'x :readers '(foo . bar)))
+  (raises-error? (make-instance 'sb-mop:direct-slot-definition
+                                :name 'x :writers ""))
+  (raises-error? (make-instance 'sb-mop:direct-slot-definition
+                                :name 'x :writers '(3)))
+  (raises-error? (make-instance 'sb-mop:direct-slot-definition
+                                :name 'x :writers '(foo . bar))))