emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: Stefan Monnier
Subject: master 75de09b: * lisp/emacs-lisp/cl-generic.el: Try and fix bug#49866
Date: Mon, 9 Aug 2021 19:04:10 -0400 (EDT)

branch: master
commit 75de09b9de2c800d074e2b65a03483d0d44ce3de
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * 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.
---
 lisp/emacs-lisp/cl-generic.el            | 29 +++++++++++++++++------------
 test/lisp/emacs-lisp/cl-generic-tests.el |  5 ++++-
 2 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index db5a5a0..4a69df1 100644
--- 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 b48a48f..dd7511e 100644
--- 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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]