diff lisp/emacs-lisp/bytecomp.el @ 108085:34eca4ecfbe6

Provide byte-compiler warnings when set-default a read-only var. * emacs-lisp/bytecomp.el (byte-compile-set-default): New function. (byte-compile-setq-default): Optimize for the single-var case and don't call byte-compile-form in this case to avoid inf-loop with byte-compile-set-default.

--- a/lisp/emacs-lisp/bytecomp.el	Fri Apr 23 12:15:51 2010 -0400
+++ b/lisp/emacs-lisp/bytecomp.el	Fri Apr 23 12:26:11 2010 -0400
@@ -3333,21 +3333,31 @@
     (setq for-effect nil)))
 
 (defun byte-compile-setq-default (form)
-  (let ((bytecomp-args (cdr form))
-	setters)
-    (while bytecomp-args
-      (let ((var (car bytecomp-args)))
-	(and (or (not (symbolp var))
-		 (byte-compile-const-symbol-p var t))
-	     (byte-compile-warning-enabled-p 'constants)
-	     (byte-compile-warn
-	      "variable assignment to %s `%s'"
-	      (if (symbolp var) "constant" "nonvariable")
-	      (prin1-to-string var)))
-	(push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
-	      setters))
-      (setq bytecomp-args (cdr (cdr bytecomp-args))))
-    (byte-compile-form (cons 'progn (nreverse setters)))))
+  (setq form (cdr form))
+  (if (> (length form) 2)
+      (let ((setters ()))
+        (while (consp form)
+          (push `(setq-default ,(pop form) ,(pop form)) setters))
+        (byte-compile-form (cons 'progn (nreverse setters))))
+    (let ((var (car form)))
+      (and (or (not (symbolp var))
+               (byte-compile-const-symbol-p var t))
+           (byte-compile-warning-enabled-p 'constants)
+           (byte-compile-warn
+            "variable assignment to %s `%s'"
+            (if (symbolp var) "constant" "nonvariable")
+            (prin1-to-string var)))
+      (byte-compile-normal-call `(set-default ',var ,@(cdr form))))))
+
+(byte-defop-compiler-1 set-default)
+(defun byte-compile-set-default (form)
+  (let ((varexp (car-safe (cdr-safe form))))
+    (if (eq (car-safe varexp) 'quote)
+        ;; If the varexp is constant, compile it as a setq-default
+        ;; so we get more warnings.
+        (byte-compile-setq-default `(setq-default ,(car-safe (cdr varexp))
+                                                  ,@(cddr form)))
+      (byte-compile-normal-call form))))
 
 (defun byte-compile-quote (form)
   (byte-compile-constant (car (cdr form))))