From: Stefan Monnier Date: Mon, 9 Aug 2021 23:03:01 +0000 (-0400) Subject: * lisp/emacs-lisp/cl-generic.el: Try and fix bug#49866 X-Git-Tag: emacs-28.0.90~1571 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=75de09b9de2c800d074e2b65a03483d0d44ce3de;p=emacs.git * 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 db5a5a0c89a..4a69df15bc8 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 b48a48fb944..dd7511e9afe 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)