* lisp/emacs-lisp/cl-generic.el: Try and fix bug#49866

(cl-generic-generalizers): Remember the specializers that match
a given value.
(cl--generic-eql-generalizer): Adjust accordingly.

* test/lisp/emacs-lisp/cl-generic-tests.el (cl-generic-test-01-eql):
Add corresponding test.

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index db5a5a0c89ad725815a78106dc95a39aabdf88ff..4a69df15bc8eb7205d7f5fe3d5b009598130f807 100644 (file)
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1153,22 +1153,27 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
 
 (cl-generic-define-generalizer cl--generic-eql-generalizer
   100 (lambda (name &rest _) `(gethash ,name cl--generic-eql-used))
-  (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (list tag))))
+  (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (cdr tag))))
 
 (cl-defmethod cl-generic-generalizers ((specializer (head eql)))
   "Support for (eql VAL) specializers.
 These match if the argument is `eql' to VAL."
-  (let ((form (cadr specializer)))
-    (puthash (if (or (not (symbolp form)) (macroexp-const-p form))
-                 (eval form t)
-               ;; FIXME: Compatibility with Emacs<28.  For now emitting
-               ;; a warning would be annoying for third party packages
-               ;; which can't use the new form without breaking compatibility
-               ;; with older Emacsen, but in the future we should emit
-               ;; a warning.
-               ;; (message "Quoting obsolete `eql' form: %S" specializer)
-               form)
-             specializer cl--generic-eql-used))
+  (let* ((form (cadr specializer))
+         (val (if (or (not (symbolp form)) (macroexp-const-p form))
+                  (eval form t)
+                ;; FIXME: Compatibility with Emacs<28.  For now emitting
+                ;; a warning would be annoying for third party packages
+                ;; which can't use the new form without breaking compatibility
+                ;; with older Emacsen, but in the future we should emit
+                ;; a warning.
+                ;; (message "Quoting obsolete `eql' form: %S" specializer)
+                form))
+         (specializers (cdr (gethash val cl--generic-eql-used))))
+    ;; The `specializers-function' needs to return all the (eql EXP) that
+    ;; were used for the same VALue (bug#49866).
+    ;; So we keep this info in `cl--generic-eql-used'.
+    (cl-pushnew specializer specializers :test #'equal)
+    (puthash val `(eql . ,specializers) cl--generic-eql-used))
   (list cl--generic-eql-generalizer))
 
 (cl--generic-prefill-dispatchers 0 (eql nil))

diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index b48a48fb9446979a8d824a07ac4e15a4c34b1b8d..dd7511e9afe5ddbdb0a88774a80f4a160291ad38 100644 (file)
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -60,7 +60,10 @@
   (defvar cl--generic-fooval 41)
   (cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y)
     "forty-two")
-  (should (equal (cl--generic-1 42 nil) "forty-two")))
+  (cl-defmethod cl--generic-1 (_x (_y (eql 42)))
+    "FORTY-TWO")
+  (should (equal (cl--generic-1 42 nil) "forty-two"))
+  (should (equal (cl--generic-1 nil 42) "FORTY-TWO")))
 
 (cl-defstruct cl-generic-struct-parent a b)
 (cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c)