bug#12604: 24.2.50; No error when setting read-only defstruct slot

[Stefan Monnier <monnier@iro.umontreal.ca>]

> The following Elisp does not raise an error, but it should (and did
> e.g. in 24.1).
[...]
>   (predicate nil :read-only t)
[...]
> (setf (emacs-achievement-predicate bob) t)

Very good point, indeed.
I installed the patch below which should fix this,


        Stefan


=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- lisp/emacs-lisp/cl-macs.el	2012-10-06 17:34:57 +0000
+++ lisp/emacs-lisp/cl-macs.el	2012-10-08 20:44:22 +0000
@@ -2324,26 +2324,29 @@
                           (if (= pos 0) '(car cl-x)
                             `(nth ,pos cl-x)))) forms)
 	      (push (cons accessor t) side-eff)
-              ;; Don't bother defining a setf-expander, since gv-get can use
-              ;; the compiler macro to get the same result.
-              ;;(push `(gv-define-setter ,accessor (cl-val cl-x)
-              ;;         ,(if (cadr (memq :read-only (cddr desc)))
-              ;;              `(progn (ignore cl-x cl-val)
-              ;;                      (error "%s is a read-only slot"
-              ;;                             ',accessor))
+              (if (cadr (memq :read-only (cddr desc)))
+                  (push `(gv-define-expander ,accessor
+                           (lambda (_cl-do _cl-x)
+                             (error "%s is a read-only slot" ',accessor)))
+                        forms)
+                ;; For normal slots, we don't need to define a setf-expander,
+                ;; since gv-get can use the compiler macro to get the
+                ;; same result.
+                ;; (push `(gv-define-setter ,accessor (cl-val cl-x)
               ;;            ;; If cl is loaded only for compilation,
               ;;            ;; the call to cl--struct-setf-expander would
               ;;            ;; cause a warning because it may not be
               ;;            ;; defined at run time.  Suppress that warning.
-              ;;            `(progn
+                ;;          (progn
               ;;               (declare-function
               ;;                cl--struct-setf-expander "cl-macs"
               ;;                (x name accessor pred-form pos))
               ;;               (cl--struct-setf-expander
               ;;                cl-val cl-x ',name ',accessor
               ;;                ,(and pred-check `',pred-check)
-              ;;                ,pos))))
+                ;;             ,pos)))
               ;;      forms)
+                )
 	      (if print-auto
 		  (nconc print-func
 			 (list `(princ ,(format " %s" slot) cl-s)