From 6535fd1fa9ac21238a168916249ac59677a6118e Mon Sep 17 00:00:00 2001 From: akater Date: Tue, 20 Jul 2021 01:25:01 +0000 Subject: Evaluate eql specializers * lisp/emacs-lisp/cl-generic.el (cl-generic-generalizers): Evaluate forms that are eql specializers. Provide backward compatibility with a warning. * test/lisp/emacs-lisp/cl-generic-tests.el: Add a test. * lisp/emacs-lisp/bindat.el (bindat--type): Adhere to the new rule. * lisp/emacs-lisp/edebug.el (edebug--match-&-spec-op): Adhere to the new rule. * lisp/emacs-lisp/map.el (map-into): Adhere to the new rule. * lisp/emacs-lisp/radix-tree.el (map-into): Adhere to the new rule. * lisp/frame.el (cl-generic-define-context-rewriter): Adhere to the new rule. * lisp/gnus/gnus-search.el (gnus-search-transform-expression): Adhere to the new rule. * lisp/image/image-converter.el (image-converter--probe image-converter--convert): Adhere to the new rule. * lisp/mail/smtpmail.el (smtpmail-try-auth-method): Adhere to the new rule. * lisp/progmodes/elisp-mode.el (xref-backend-definitions) (xref-backend-apropos): Adhere to the new rule. * lisp/progmodes/etags.el (xref-backend-identifier-at-point) (xref-backend-identifier-completion-table) (xref-backend-identifier-completion-ignore-case) (xref-backend-definitions)(xref-backend-apropos): Adhere to the new rule. * test/lisp/emacs-lisp/checkdoc-tests.el (checkdoc-cl-defmethod-with-types-ok) (checkdoc-cl-defmethod-qualified-ok) (checkdoc-cl-defmethod-with-extra-qualifier-ok): Adhere to the new rule. * etc/NEWS: Describe the change. --- test/lisp/emacs-lisp/cl-generic-tests.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'test/lisp/emacs-lisp/cl-generic-tests.el') diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 9312fb44a1e..0093b04d1d8 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -56,7 +56,11 @@ (should (equal (cl--generic-1 'a nil) '(a))) (should (equal (cl--generic-1 4 nil) '("quatre" 4))) (should (equal (cl--generic-1 5 nil) '("cinq" 5))) - (should (equal (cl--generic-1 6 nil) '("six" a)))) + (should (equal (cl--generic-1 6 nil) '("six" a))) + (defvar cl--generic-fooval 41) + (cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y) + "forty-two") + (should (equal (cl--generic 42 nil) "forty-two"))) (cl-defstruct cl-generic-struct-parent a b) (cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c) -- cgit v1.2.3 From 516affe1b3c1525d49fd7fd050a42d234470b4c6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 4 Aug 2021 06:38:34 +0200 Subject: Fix apparent typo in new cl-generic-tests.el test case --- test/lisp/emacs-lisp/cl-generic-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'test/lisp/emacs-lisp/cl-generic-tests.el') diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 0093b04d1d8..b48a48fb944 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -60,7 +60,7 @@ (defvar cl--generic-fooval 41) (cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y) "forty-two") - (should (equal (cl--generic 42 nil) "forty-two"))) + (should (equal (cl--generic-1 42 nil) "forty-two"))) (cl-defstruct cl-generic-struct-parent a b) (cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c) -- cgit v1.2.3 From 75de09b9de2c800d074e2b65a03483d0d44ce3de Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 9 Aug 2021 19:03:01 -0400 Subject: * 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(-) (limited to 'test/lisp/emacs-lisp/cl-generic-tests.el') 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) -- cgit v1.2.3