(eieio-backward-compatibility): Set to `warn` (bug#77612)

* lisp/emacs-lisp/eieio-base.el (make-instance) <eieio-named>:
Really skip backward compatibility when `eieio-backward-compatibility`
is nil and emit message if it's `warn`.
(eieio-persistent-make-instance): Warn when an obsolete name is used.

* lisp/emacs-lisp/eieio-core.el (eieio-backward-compatibility):
Change default to `warn`.
(eieio-defclass-internal): Warn when the *-list-p function is called
(eieio--slot-name-index): Warn when a initarg is used to access a slot.

* lisp/emacs-lisp/eieio.el (defclass): Warn when a class-slot is
accessed via the obsolete method.
(make-instance, clone) <eieio-default-superclass>: Really skip backward
compatibility when `eieio-backward-compatibility` is nil and emit
message if it's `warn`.

(cherry picked from commit ae1d01328f260f1a9891280c96139494629a83e8)

diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 7975cdf280d87feb82d7311f4172060c7a4a8295..e2065b650956c6bcf392ade9e804aeff1032b27a 100644 (file)
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -207,11 +207,12 @@ All slots are unbound, except those initialized with PARAMS."
     nobj))
 
 (cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
-  (if (not (stringp (car args)))
+  (if (not (and eieio-backward-compatibility args
+            (let ((x (car args))) (or (stringp x) (null x)))))
       (cl-call-next-method)
-    (funcall (if eieio-backward-compatibility #'ignore #'message)
-             "Obsolete: name passed without :object-name to %S constructor"
-             class)
+    (when (eq eieio-backward-compatibility 'warn)
+      (message "Obsolete: name passed without :object-name to %S constructor"
+               class))
     (apply #'cl-call-next-method class :object-name args)))
 
 ;;; eieio-persistent
@@ -345,6 +346,8 @@ objects found there."
                   (object-of-class-p newobj 'eieio-named)
                   (not (oref newobj object-name))
                   name)
+         (when (eq eieio-backward-compatibility 'warn)
+           (message "Obsolete name slot initialized for %S" newobj))
          (oset newobj object-name name))
 
        newobj))))

diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 99f8feb96441742dbb446c308d5f4c05ab866483..a06c36e5b72335f96486cb34fb9c102d8d88b2ed 100644 (file)
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -63,12 +63,14 @@ default setting for optimization purposes.")
 (defvar eieio-optimize-primary-methods-flag t
   "Non-nil means to optimize the method dispatch on primary methods.")
 
-(defvar eieio-backward-compatibility t
+(defvar eieio-backward-compatibility 'warn
   "If nil, drop support for some behaviors of older versions of EIEIO.
 Currently under control of this var:
 - Define every class as a var whose value is the class symbol.
 - Define <class>-child-p and <class>-list-p predicates.
-- Allow object names in constructors.")
+- Allow object names in constructors.
+When `warn', also emit warnings at run-time when code uses those
+deprecated features.")
 
 (define-obsolete-variable-alias 'eieio-unbound 'eieio--unbound "28.1")
 (defvar eieio--unbound (make-symbol "eieio--unbound")
@@ -359,6 +361,8 @@ See `defclass' for more information."
              (internal--format-docstring-line
               "Test OBJ to see if it a list of objects which are a child of type `%s'."
               cname))
+            (when (eq eieio-backward-compatibility 'warn)
+              (message "Use of obsolete function %S" csym))
             (when (listp obj)
               (let ((ans t)) ;; nil is valid
                 ;; Loop over all the elements of the input list, test
@@ -909,12 +913,15 @@ reverse-lookup that name, and recurse with the associated slot value."
   (let* ((fsi (gethash slot (cl--class-index-table class))))
     (if (integerp fsi)
         fsi
-      (let ((fn (eieio--initarg-to-attribute class slot)))
-       (if fn
+      (when eieio-backward-compatibility
+       (let ((fn (eieio--initarg-to-attribute class slot)))
+         (when fn
+            (when (eq eieio-backward-compatibility 'warn)
+              (message "Accessing slot `%S' via obsolete initarg name `%S'"
+                       fn slot))
             ;; Accessing a slot via its :initarg is accepted by EIEIO
             ;; (but not CLOS) but is a bad idea (for one: it's slower).
-            (eieio--slot-name-index class fn)
-          nil)))))
+            (eieio--slot-name-index class fn)))))))
 
 (defun eieio--class-slot-name-index (class slot)
   "In CLASS find the index of the named SLOT.

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 10a25004b4d9b6275cdfacff62fed21a68ea90fd..cbe8164f6b56ab0278e0198cec41e310baa25c06 100644 (file)
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -216,6 +216,9 @@ and reference them using the function `class-option'."
                         "Retrieve the class slot `%S' from a class `%S'."
                         sname name)
                        "\nThis method is obsolete.")
+                     (when (eq eieio-backward-compatibility 'warn)
+                       (message "Use of obsolete method %S on %S"
+                                ',acces '(subclass ,name)))
                      (if (slot-boundp this ',sname)
                          (eieio-oref-default this ',sname)))
                   accessors)))
@@ -732,12 +735,13 @@ It allocates the vector used to represent an EIEIO object, and then
 calls `initialize-instance' on that object."
   (let* ((new-object (copy-sequence (eieio--class-default-object-cache
                                      (eieio--class-object class)))))
-    (if (and slots
-             (let ((x (car slots)))
-               (or (stringp x) (null x))))
-        (funcall (if eieio-backward-compatibility #'ignore #'message)
-                 "Obsolete name argument %S passed to %S constructor"
-                 (pop slots) class))
+    (when (and eieio-backward-compatibility slots
+               (let ((x (car slots)))
+                 (or (stringp x) (null x))))
+      (let ((name (pop slots)))
+        (when (eq eieio-backward-compatibility 'warn)
+          (message "Obsolete name argument %S passed to %S constructor"
+                   name class))))
     ;; Call the initialize method on the new object with the slots
     ;; that were passed down to us.
     (initialize-instance new-object slots)
@@ -841,9 +845,12 @@ first and modify the returned object.")
 (cl-defmethod clone ((obj eieio-default-superclass) &rest params)
   "Make a copy of OBJ, and then apply PARAMS."
   (let ((nobj (copy-sequence obj)))
-    (if (stringp (car params))
-        (funcall (if eieio-backward-compatibility #'ignore #'message)
-                 "Obsolete name argument %S passed to clone" (pop params)))
+    (when (and eieio-backward-compatibility params
+               (let ((x (car params)))
+                 (or (stringp x) (null x))))
+     (let ((name (pop params)))
+       (when (eq eieio-backward-compatibility 'warn)
+         (message "Obsolete name argument %S passed to clone" name))))
     (if params (shared-initialize nobj params))
     nobj))