diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index dfea200c5..f2b495389 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1520,15 +1520,17 @@
         (setf value new-value))))
   value)
 
-(defun %set-slot-value-checking-type (context slots slot value
+(defun %set-slot-value-checking-type (context object slots slot value
                                       safe old-class new-class)
-  (setf (clos-slots-ref slots (slot-definition-location slot))
-        (if (and safe (not (unbound-marker-p value)))
-            (let ((name (slot-definition-name slot))
-                  (type (slot-definition-type slot)))
-              (%ensure-slot-value-type context name type value
-                                       old-class new-class))
-            value)))
+  (let ((value (if (and safe (not (unbound-marker-p value)))
+                   (let ((name (slot-definition-name slot))
+                         (type (slot-definition-type slot)))
+                     (%ensure-slot-value-type context name type value
+                                              old-class new-class))
+                   value)))
+    (if (slot-accessor-std-p slot 'writer)
+        (setf (clos-slots-ref slots (slot-definition-location slot)) value)
+        (funcall (slot-info-writer (slot-definition-info slot)) value object))))
 
 (defvar *in-obsolete-instance-trap* nil)
 
@@ -1576,7 +1578,7 @@
        (flet ((set-value (value cell)
                 (%set-slot-value-checking-type
                  "updating obsolete instance"
-                 nslots (cdr cell) value safe class class)
+                 copy nslots (cdr cell) value safe class class)
                 ;; Prune from the list now that it's been dealt with.
                 (setf layout (remove cell layout))))
 
@@ -1645,7 +1647,7 @@
                    (return t)))))
            (set-value (value slotd)
              (%set-slot-value-checking-type
-              'change-class new-slots slotd value safe
+              'change-class copy new-slots slotd value safe
               old-class new-class)))
 
       ;; "The values of local slots specified by both the class CTO
christophe@shin:~/src/sbcl$ git diff > /tmp/foo.diff
christophe@shin:~/src/sbcl$ cat /tmp/foo.diff 
diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index dfea200c5..f2b495389 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1520,15 +1520,17 @@
         (setf value new-value))))
   value)
 
-(defun %set-slot-value-checking-type (context slots slot value
+(defun %set-slot-value-checking-type (context object slots slot value
                                       safe old-class new-class)
-  (setf (clos-slots-ref slots (slot-definition-location slot))
-        (if (and safe (not (unbound-marker-p value)))
-            (let ((name (slot-definition-name slot))
-                  (type (slot-definition-type slot)))
-              (%ensure-slot-value-type context name type value
-                                       old-class new-class))
-            value)))
+  (let ((value (if (and safe (not (unbound-marker-p value)))
+                   (let ((name (slot-definition-name slot))
+                         (type (slot-definition-type slot)))
+                     (%ensure-slot-value-type context name type value
+                                              old-class new-class))
+                   value)))
+    (if (slot-accessor-std-p slot 'writer)
+        (setf (clos-slots-ref slots (slot-definition-location slot)) value)
+        (funcall (slot-info-writer (slot-definition-info slot)) value object))))
 
 (defvar *in-obsolete-instance-trap* nil)
 
@@ -1576,7 +1578,7 @@
        (flet ((set-value (value cell)
                 (%set-slot-value-checking-type
                  "updating obsolete instance"
-                 nslots (cdr cell) value safe class class)
+                 copy nslots (cdr cell) value safe class class)
                 ;; Prune from the list now that it's been dealt with.
                 (setf layout (remove cell layout))))
 
@@ -1645,7 +1647,7 @@
                    (return t)))))
            (set-value (value slotd)
              (%set-slot-value-checking-type
-              'change-class new-slots slotd value safe
+              'change-class copy new-slots slotd value safe
               old-class new-class)))
 
       ;; "The values of local slots specified by both the class CTO