Changeset 242

Timestamp:

Jan 9, 2004, 1:25:20 PM (21 years ago)

Author:

Gary Byers

Message:

BAD-SLOT-TYPE errors.

Location:

trunk/ccl/level-1

Files:

• l1-clos-boot.lisp (modified) (1 diff)
• l1-clos.lisp (modified) (2 diffs)

trunk/ccl/level-1/l1-clos-boot.lisp

@@ -2235 +2235 @@
     (unless (or (eq new (%slot-unbound-marker))
                 (funcall type-predicate new))
-      (setq new (require-type new type)))
+      (error 'bad-slot-type
+             :instance (slot-vector.instance slot-vector)
+             :datum new :expected-type type
+             :slot-definition slotd))
     (typecase loc
       (fixnum

trunk/ccl/level-1/l1-clos.lisp

@@ -74 +74 @@
             (progn
               (unless (funcall (standard-effective-slot-definition.type-predicate slotd) new-value)
-                (report-bad-arg new-value (%slot-definition-type slotd)))
+                (error 'bad-slot-type-from-initarg
+                       :slot-definition slotd
+                       :instance instance
+                       :datum new-value
+                       :expected-type  (%slot-definition-type slotd)
+                       :initarg-name (car foundp)))
               (if (consp loc)
                 (rplacd loc new-value)
@@ -92 +97 @@
                       (let* ((newval (funcall initfunction)))
                         (unless (funcall (standard-effective-slot-definition.type-predicate slotd) newval)
-                          (report-bad-arg newval (%slot-definition-type slotd)))
+                          (error 'bad-slot-type-from-initform
+                                 :slot-definition slotd
+                                 :expected-type (%slot-definition-type slotd)
+                                 :datum newval
+                                 :instance instance))
                         (if (consp loc)
                           (rplacd loc newval)