eieio: Emit compilation warnings a bit more thoroughly

We used to warn about unknown slots only in `oref`: add the same check
for `oset` and `slot-boundp`.
Similarly, we warned about obsolete name args only when calling the
constructors: add the same check to `make-instance`.

* lisp/emacs-lisp/eieio-core.el (eieio--check-slot-name): New function
extracted from the compiler-macro of `eieio-oref`.
(eieio-oref, eieio-oset): Use it.
* lisp/emacs-lisp/eieio.el (slot-boundp): Use it.
 (eieio--constructor-macro): Add category to warning.
(make-instance): Add compiler-macro to warn about obsolete name.

(cherry picked from commit 71afa12941ebbd6fa2c010064de01db681985279)

diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index f95fd65fa5c980d733fd38071aaa678e956b3c4d..b3a8698e31d93deddaeca453ac140f7ad20d3df7 100644 (file)
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -740,18 +740,19 @@ Argument FN is the function calling this verifier."
 \f
 ;;; Get/Set slots in an object.
 
+(eval-and-compile
+  (defun eieio--check-slot-name (exp _obj slot &rest _)
+    (pcase slot
+      ((and (or `',name (and name (pred keywordp)))
+            (guard (not (eieio--known-slot-name-p name))))
+       (macroexp-warn-and-return
+        (format-message "Unknown slot `%S'" name)
+        exp nil 'compile-only name))
+      (_ exp))))
+
 (defun eieio-oref (obj slot)
   "Return the value in OBJ at SLOT in the object vector."
-  (declare (compiler-macro
-            (lambda (exp)
-              (ignore obj)
-              (pcase slot
-                ((and (or `',name (and name (pred keywordp)))
-                      (guard (not (eieio--known-slot-name-p name))))
-                 (macroexp-warn-and-return
-                  (format-message "Unknown slot `%S'" name)
-                  exp nil 'compile-only name))
-                (_ exp))))
+  (declare (compiler-macro eieio--check-slot-name)
            ;; FIXME: Make it a gv-expander such that the hash-table lookup is
            ;; only performed once when used in `push' and friends?
            (gv-setter eieio-oset))
@@ -822,6 +823,7 @@ Fills in CLASS's SLOT with its default value."
 (defun eieio-oset (obj slot value)
   "Do the work for the macro `oset'.
 Fills in OBJ's SLOT with VALUE."
+  (declare (compiler-macro eieio--check-slot-name))
   (cl-check-type slot symbol)
   (cond
    ((cl-typep obj '(or eieio-object cl-structure-object))

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index e84ad6f670efbbfa7fa5e2dac23d73c4a4be5e09..e8f31eec975658b3d8b9421d5a33fa66f5ac53d2 100644 (file)
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -304,7 +304,7 @@ and reference them using the function `class-option'."
      ;; but hide it so we don't trigger indefinitely.
      `(,(car whole) (identity ,(car slots))
        ,@(cdr slots))
-     nil nil (car slots))))
+     '(obsolete eieio-constructor-name-arg) nil (car slots))))
 
 ;;; Get/Set slots in an object.
 ;;
@@ -554,6 +554,7 @@ after they are created."
 Setting a slot's value makes it bound.  Calling `slot-makeunbound' will
 make a slot unbound.
 OBJECT can be an instance or a class."
+  (declare (compiler-macro eieio--check-slot-name))
   ;; Skip typechecking while retrieving this value.
   (let ((eieio-skip-typecheck t))
     ;; Return nil if the magic symbol is in there.
@@ -700,6 +701,20 @@ for each slot.  For example:
 
   (make-instance \\='foo :slot1 value1 :slotN valueN)")
 
+(put 'make-instance 'compiler-macro
+     (lambda (whole class &rest slots)
+       (if (or (null slots) (keywordp (car slots))
+               ;; Detect the second pass!
+               (eq 'identity (car-safe (car slots))))
+           whole
+         (macroexp-warn-and-return
+          (format "Obsolete name arg %S to `make-instance'" (car slots))
+          ;; Keep the name arg, for backward compatibility,
+          ;; but hide it so we don't trigger indefinitely.
+          `(,(car whole) ,class (identity ,(car slots))
+            ,@(cdr slots))
+          '(obsolete eieio-constructor-name-arg) nil (car slots)))))
+
 (define-obsolete-function-alias 'constructor #'make-instance "25.1")
 
 (cl-defmethod make-instance