[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated
From: |
Stefan Monnier |
Subject: |
bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated |
Date: |
Fri, 16 Jul 2021 17:00:17 -0400 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) |
> #+begin_quote
> The parameter specializer name ~(eql eql-specializer-form)~
> indicates that the corresponding argument must be eql to the object
> that is the value of ~eql-specializer-form~ for the method to be applicable.
> The ~eql-specializer-form~ is evaluated
> at the time that the expansion of the defmethod macro is evaluated.
> #+end_quote
Oh, indeed, I completely missed that.
That would be a nice improvement.
Could you check to see which code would break if we made this change?
The patch below seems to provide enough backward compatibility, but it
would be nice to improve it so the warning is emitted at compile time
via something like `macroexp-warn-and-return` so we get some kind of
file&line number.
Stefan
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 544704be38..6d23537ebd 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1158,7 +1158,12 @@ cl--generic-eql-generalizer
(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
"Support for (eql VAL) specializers.
These match if the argument is `eql' to VAL."
- (puthash (cadr specializer) specializer cl--generic-eql-used)
+ (let ((form (cadr specializer)))
+ (puthash (if (or (not (symbolp form)) (macroexp-const-p form))
+ (eval form t)
+ (message "Quoting obsolete `eql' form: %S" specializer)
+ form)
+ specializer 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 9312fb44a1..b48a48fb94 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -56,7 +56,11 @@ cl-generic-test-01-eql
(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-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)