* bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated
2021-07-16 21:00 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-07-19 21:22 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-07-20 2:28 ` akater
2021-08-03 16:00 ` akater
2 siblings, 0 replies; 15+ messages in thread
From: Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-07-19 21:22 UTC (permalink / raw)
To: akater; +Cc: 47327
Stefan Monnier [2021-07-16 17:00:17] wrote:
> Oh, indeed, I completely missed that.
> That would be a nice improvement.
BTW, if we make this change for `eql` it would make a lot of sense to
make the same change for the `head` specializer.
Stefan
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated
2021-07-16 21:00 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-07-19 21:22 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-07-20 2:28 ` akater
2021-08-03 16:00 ` akater
2 siblings, 0 replies; 15+ messages in thread
From: akater @ 2021-07-20 2:28 UTC (permalink / raw)
To: Stefan Monnier; +Cc: 47327
[-- Attachment #1.1: Type: text/plain, Size: 1422 bytes --]
Stefan Monnier <monnier@iro.umontreal.ca> writes:
> Could you check to see which code would break if we made this change?
I looked for “(eql” and then for “cl-defmethod”, searching for generated
code specifically.
Unless there's less obvious code that generates cl-defmethod forms, it
should all be in the attached patch.
> (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))
Which implies, those who want to specialize on a value of symbol x
should write (eql (symbol-value 'x)), right?
This irregularity better be pointed out somewhere; I rarely read Elisp
manual so I'm not sure if it would be appropriate there. Otherwise,
looks good, provided that it works. (JFYI, I don't think I will be able
to properly test this patch soon enough.)
Please note that there are two spots in the patch where I'm not sure
what (if anything) should be done; marked with WARNING.
[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]
[-- Attachment #2: Necessary changes in eql specializer use --]
[-- Type: text/x-diff, Size: 21391 bytes --]
From 3d1463c9238ac9d0c246e9bbb769331a2d16ab8f Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Tue, 20 Jul 2021 01:25:01 +0000
Subject: [PATCH] Upcoming changes to eql specializer use
---
lisp/emacs-lisp/bindat.el | 24 ++++++++++++------------
lisp/emacs-lisp/cl-generic.el | 5 +++++
lisp/emacs-lisp/edebug.el | 18 +++++++++---------
lisp/emacs-lisp/map.el | 8 ++++----
lisp/emacs-lisp/radix-tree.el | 2 +-
lisp/frame.el | 6 +++++-
lisp/gnus/gnus-search.el | 2 +-
lisp/image/image-converter.el | 12 ++++++------
lisp/mail/smtpmail.el | 6 +++---
lisp/progmodes/elisp-mode.el | 7 ++++---
lisp/progmodes/etags.el | 12 +++++++-----
test/lisp/emacs-lisp/checkdoc-tests.el | 8 ++++----
12 files changed, 61 insertions(+), 49 deletions(-)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 247fb91379..76c2e80fda 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -657,33 +657,33 @@ defmacro bindat--pcase (&rest args)
OP can be one of: unpack', (pack VAL), or (length VAL) where VAL
is the name of a variable that will hold the value we need to pack.")
-(cl-defmethod bindat--type (op (_ (eql byte)))
+(cl-defmethod bindat--type (op (_ (eql 'byte)))
(bindat--pcase op
('unpack `(bindat--unpack-u8))
(`(length . ,_) `(cl-incf bindat-idx 1))
(`(pack . ,args) `(bindat--pack-u8 . ,args))))
-(cl-defmethod bindat--type (op (_ (eql uint)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uint)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uint ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql uintr)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uintr ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql str)) len)
+(cl-defmethod bindat--type (op (_ (eql 'str)) len)
(bindat--pcase op
('unpack `(bindat--unpack-str ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
-(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
+(cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len)
(bindat--pcase op
('unpack `(bindat--unpack-strz ,len))
(`(length ,val)
@@ -701,25 +701,25 @@ defmacro bindat--pcase (&rest args)
(bindat--pack-str ,len . ,args)
(bindat--pack-strz . ,args))))))
-(cl-defmethod bindat--type (op (_ (eql bits)) len)
+(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
(bindat--pcase op
('unpack `(bindat--unpack-bits ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
-(cl-defmethod bindat--type (_op (_ (eql fill)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'fill)) len)
`(progn (cl-incf bindat-idx ,len) nil))
-(cl-defmethod bindat--type (_op (_ (eql align)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
`(progn (cl-callf bindat--align bindat-idx ,len) nil))
-(cl-defmethod bindat--type (op (_ (eql type)) exp)
+(cl-defmethod bindat--type (op (_ (eql 'type)) exp)
(bindat--pcase op
('unpack `(funcall (bindat--type-ue ,exp)))
(`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args))
(`(pack . ,args) `(funcall (bindat--type-pe ,exp) . ,args))))
-(cl-defmethod bindat--type (op (_ (eql vec)) count &rest type)
+(cl-defmethod bindat--type (op (_ (eql 'vec)) count &rest type)
(unless type (setq type '(byte)))
(let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment)))
(bindat--pcase op
@@ -743,10 +743,10 @@ defmacro bindat--pcase (&rest args)
`(dotimes (bindat--i ,count)
(funcall ,fun (elt ,val bindat--i)))))))
-(cl-defmethod bindat--type (op (_ (eql unit)) val)
+(cl-defmethod bindat--type (op (_ (eql 'unit)) val)
(pcase op ('unpack val) (_ nil)))
-(cl-defmethod bindat--type (op (_ (eql struct)) &rest args)
+(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args)
(apply #'bindat--type op args))
(cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 544704be38..8250d62bbe 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1269,6 +1269,11 @@ defun cl--generic-derived-specializers (mode &rest _)
(cl-generic-define-context-rewriter major-mode (mode &rest modes)
`(major-mode ,(if (consp mode)
;;E.g. could be (eql ...)
+ ;; WARNING: unsure whether this
+ ;; “could be (eql ...)” commentary (or code)
+ ;; should be adjusted
+ ;; following the (planned) changes to eql specializer.
+ ;; Bug #47327
(progn (cl-assert (null modes)) mode)
`(derived-mode ,mode . ,modes))))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 2aec8197dc..7def9ff96a 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1731,7 +1731,7 @@ defun edebug-match-form (cursor)
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&optional)) cursor specs)
;; Keep matching until one spec fails.
(edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
@@ -1755,7 +1755,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
"Handle &foo spec operators.
&foo spec operators operate on all the subsequent SPECS.")
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&rest)) cursor specs)
;; Repeatedly use specs until failure.
(let (edebug-best-error
edebug-error-point)
@@ -1768,7 +1768,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
(edebug-&optional-wrapper c (or s specs) rh)))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&or)) cursor specs)
;; Keep matching until one spec succeeds, and return its results.
;; If none match, fail.
;; This needs to be optimized since most specs spend time here.
@@ -1792,7 +1792,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs)
"Compute the specs for `&interpose SPEC FUN ARGS...'.
Extracts the head of the data by matching it against SPEC,
and then matches the rest by calling (FUN HEAD PF ARGS...)
@@ -1817,7 +1817,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
(append instrumented-head (edebug-match cursor newspecs)))
,@args))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '¬)) cursor specs)
;; If any specs match, then fail
(if (null (catch 'no-match
(let ((edebug-gate nil))
@@ -1829,7 +1829,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&key)) cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
@@ -1842,7 +1842,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
(car (cdr pair))))
specs))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&error)) cursor specs)
;; Signal an error, using the following string in the spec as argument.
(let ((error-string (car specs))
(edebug-error-point (edebug-before-offset cursor)))
@@ -1942,7 +1942,7 @@ defun edebug-match-nil (cursor)
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&define)) cursor specs)
;; Match a defining form.
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
@@ -1958,7 +1958,7 @@ defun edebug-match-function (_cursor)
;; Stop backtracking here (Bug#41988).
(setq edebug-gate t)))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
The full syntax of that operator is:
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 5c76fb9eb9..c59342875d 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -407,15 +407,15 @@ defun map-merge-with (type function &rest maps)
"Convert MAP into a map of TYPE.")
;; FIXME: I wish there was a way to avoid this η-redex!
-(cl-defmethod map-into (map (_type (eql list)))
+(cl-defmethod map-into (map (_type (eql 'list)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql alist)))
+(cl-defmethod map-into (map (_type (eql 'alist)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql plist)))
+(cl-defmethod map-into (map (_type (eql 'plist)))
"Convert MAP into a plist."
(let (plist)
(map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
@@ -510,7 +510,7 @@ defun map--into-hash (map keyword-args)
map)
ht))
-(cl-defmethod map-into (map (_type (eql hash-table)))
+(cl-defmethod map-into (map (_type (eql 'hash-table)))
"Convert MAP into a hash-table with keys compared with `equal'."
(map--into-hash map (list :size (map-length map) :test #'equal)))
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index fb65975350..a529ed025d 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -240,7 +240,7 @@ defun radix-tree-count (tree)
(declare-function map-apply "map" (function map))
(defun radix-tree-from-map (map)
- ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
+ ;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...)
(require 'map)
(let ((rt nil))
(map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
diff --git a/lisp/frame.el b/lisp/frame.el
index 378d7c8e5b..0c79ce4c6f 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -36,7 +36,11 @@
(cl-generic-define-context-rewriter window-system (value)
;; If `value' is a `consp', it's probably an old-style specializer,
;; so just use it, and anyway `eql' isn't very useful on cons cells.
- `(window-system ,(if (consp value) value `(eql ,value))))
+ `(window-system ,(if (consp value) value
+ ;; WARNING: unsure whether this eql expression
+ ;; is actually an eql specializer.
+ ;; Bug #47327
+ `(eql ',value))))
(cl-defmethod frame-creation-function (params &context (window-system nil))
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 39bde837b3..53af2f6fe6 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -980,7 +980,7 @@ defsubst gnus-search-single-p (query)
;; Most search engines use implicit ANDs.
(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
- (_expr (eql and)))
+ (_expr (eql 'and)))
nil)
;; Most search engines use explicit infixed ORs.
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index e47f1f76e4..97bf1ac058 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -133,7 +133,7 @@ defun image-converter--value (type elem)
(list value)
value)))
-(cl-defmethod image-converter--probe ((type (eql graphicsmagick)))
+(cl-defmethod image-converter--probe ((type (eql 'graphicsmagick)))
"Check whether the system has GraphicsMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -151,7 +151,7 @@ defun image-converter--value (type elem)
(push (downcase (match-string 1)) formats)))
(nreverse formats)))))
-(cl-defmethod image-converter--probe ((type (eql imagemagick)))
+(cl-defmethod image-converter--probe ((type (eql 'imagemagick)))
"Check whether the system has ImageMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -171,7 +171,7 @@ defun image-converter--value (type elem)
(push (downcase (match-string 1)) formats)))
(nreverse formats))))
-(cl-defmethod image-converter--probe ((type (eql ffmpeg)))
+(cl-defmethod image-converter--probe ((type (eql 'ffmpeg)))
"Check whether the system has ffmpeg installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -212,12 +212,12 @@ defun image-converter--filter-formats (suffixes)
'image-mode)
collect suffix))
-(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
(image-converter--convert-magick type source image-format))
-(cl-defmethod image-converter--convert ((type (eql imagemagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'imagemagick)) source
image-format)
"Convert using ImageMagick."
(image-converter--convert-magick type source image-format))
@@ -249,7 +249,7 @@ defun image-converter--convert-magick (type source image-format)
;; error message.
(buffer-string))))
-(cl-defmethod image-converter--convert ((type (eql ffmpeg)) source
+(cl-defmethod image-converter--convert ((type (eql 'ffmpeg)) source
image-format)
"Convert using ffmpeg."
(let ((command (image-converter--value type :command)))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index c1e2280033..a642ff4045 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -574,7 +574,7 @@ defun smtpmail-try-auth-methods (process supported-extensions host port
(error "Mechanism %S not implemented" mech))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql cram-md5)) user password)
+ (process (_mech (eql 'cram-md5)) user password)
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
@@ -596,13 +596,13 @@ defun smtpmail-try-auth-methods (process supported-extensions host port
(smtpmail-command-or-throw process encoded)))))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql login)) user password)
+ (process (_mech (eql 'login)) user password)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql plain)) user password)
+ (process (_mech (eql 'plain)) user password)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index a56c7093e7..f7bc8bcd82 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -696,7 +696,7 @@ defvar elisp-xref-find-def-functions nil
non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
-(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
(require 'find-func)
;; FIXME: use information in source near point to filter results:
;; (dvc-log-edit ...) - exclude 'feature
@@ -875,7 +875,7 @@ defun elisp--xref-find-definitions (symbol)
(declare-function xref-apropos-regexp "xref" (pattern))
-(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
+(cl-defmethod xref-backend-apropos ((_backend (eql 'elisp)) pattern)
(apply #'nconc
(let ((regexp (xref-apropos-regexp pattern))
lst)
@@ -893,7 +893,8 @@ defvar elisp--xref-identifier-completion-table
(facep sym)))
'strict))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'elisp)))
elisp--xref-identifier-completion-table)
(cl-defstruct (xref-elisp-location
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index f0180ceeec..ce1d8e5e62 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2062,19 +2062,21 @@ defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p
;;;###autoload
(defun etags--xref-backend () 'etags)
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'etags)))
(find-tag--default))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'etags)))
(tags-lazy-completion-table))
-(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend
+ (eql 'etags)))
(find-tag--completion-ignore-case))
-(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol)
(etags--xref-find-definitions symbol))
-(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern)
+(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
(etags--xref-find-definitions (xref-apropos-regexp pattern) t))
(defun etags--xref-find-definitions (pattern &optional regexp?)
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el
index 7a7aa9fb3c..2a1d8b2763 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -49,27 +49,27 @@
(with-temp-buffer
(emacs-lisp-mode)
;; this method matches if A is the symbol `smthg' and if b is a list:
- (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
+ (insert "(cl-defmethod foo ((a (eql 'smthg)) (b list)) \"Return A+B.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-qualified-ok ()
"Checkdoc should be happy with a `cl-defmethod' using qualifiers."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod test :around ((a (eql smthg))) \"Return A.\")")
+ (insert "(cl-defmethod test :around ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok ()
"Checkdoc should be happy with a :extra qualified `cl-defmethod'."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod foo :extra \"foo\" ((a (eql smthg))) \"Return A.\")")
+ (insert "(cl-defmethod foo :extra \"foo\" ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun))
(with-temp-buffer
(emacs-lisp-mode)
(insert
- "(cl-defmethod foo :extra \"foo\" :after ((a (eql smthg))) \"Return A.\")")
+ "(cl-defmethod foo :extra \"foo\" :after ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok ()
--
2.31.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated
2021-07-16 21:00 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-07-19 21:22 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-07-20 2:28 ` akater
@ 2021-08-03 16:00 ` akater
2021-08-03 23:02 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2 siblings, 1 reply; 15+ messages in thread
From: akater @ 2021-08-03 16:00 UTC (permalink / raw)
To: Stefan Monnier; +Cc: 47327
[-- Attachment #1.1: Type: text/plain, Size: 244 bytes --]
In the new patch, I combined your solution and my fixes to current
cl-defmethod forms. I also tried to write an appropriate description in
the patch header and in etc/NEWS.
Please note that questionable spots remain, marked with `WARNING:'.
[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 865 bytes --]
[-- Attachment #2: Evaluate eql specializers --]
[-- Type: text/x-diff, Size: 25083 bytes --]
From bee57a5cab2762f50425c775757672a2c487573e Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Tue, 20 Jul 2021 01:25:01 +0000
Subject: [PATCH] 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.
---
etc/NEWS | 5 +++++
lisp/emacs-lisp/bindat.el | 24 ++++++++++++------------
lisp/emacs-lisp/cl-generic.el | 12 +++++++++++-
lisp/emacs-lisp/edebug.el | 18 +++++++++---------
lisp/emacs-lisp/map.el | 8 ++++----
lisp/emacs-lisp/radix-tree.el | 2 +-
lisp/frame.el | 6 +++++-
lisp/gnus/gnus-search.el | 2 +-
lisp/image/image-converter.el | 12 ++++++------
lisp/mail/smtpmail.el | 6 +++---
lisp/progmodes/elisp-mode.el | 7 ++++---
lisp/progmodes/etags.el | 12 +++++++-----
test/lisp/emacs-lisp/checkdoc-tests.el | 8 ++++----
test/lisp/emacs-lisp/cl-generic-tests.el | 6 +++++-
14 files changed, 77 insertions(+), 51 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 48dec0a2b3..fb6eddc754 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -810,6 +810,11 @@ work as before.
It is now defined as a generalized variable that can be used with
'setf' to modify the value stored in a given class slot.
+---
+*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated.
+This corresponds to the behaviour of defmethod in Common Lisp Object System.
+A warning is issued when old style is used.
+
** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
The mode provides refined highlighting of built-in functions, types,
and variables.
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 247fb91379..76c2e80fda 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -657,33 +657,33 @@ defmacro bindat--pcase (&rest args)
OP can be one of: unpack', (pack VAL), or (length VAL) where VAL
is the name of a variable that will hold the value we need to pack.")
-(cl-defmethod bindat--type (op (_ (eql byte)))
+(cl-defmethod bindat--type (op (_ (eql 'byte)))
(bindat--pcase op
('unpack `(bindat--unpack-u8))
(`(length . ,_) `(cl-incf bindat-idx 1))
(`(pack . ,args) `(bindat--pack-u8 . ,args))))
-(cl-defmethod bindat--type (op (_ (eql uint)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uint)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uint ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql uintr)) n)
+(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
(if (eq n 8) (bindat--type op 'byte)
(bindat--pcase op
('unpack `(bindat--unpack-uintr ,n))
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
(`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
-(cl-defmethod bindat--type (op (_ (eql str)) len)
+(cl-defmethod bindat--type (op (_ (eql 'str)) len)
(bindat--pcase op
('unpack `(bindat--unpack-str ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
-(cl-defmethod bindat--type (op (_ (eql strz)) &optional len)
+(cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len)
(bindat--pcase op
('unpack `(bindat--unpack-strz ,len))
(`(length ,val)
@@ -701,25 +701,25 @@ defmacro bindat--pcase (&rest args)
(bindat--pack-str ,len . ,args)
(bindat--pack-strz . ,args))))))
-(cl-defmethod bindat--type (op (_ (eql bits)) len)
+(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
(bindat--pcase op
('unpack `(bindat--unpack-bits ,len))
(`(length . ,_) `(cl-incf bindat-idx ,len))
(`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
-(cl-defmethod bindat--type (_op (_ (eql fill)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'fill)) len)
`(progn (cl-incf bindat-idx ,len) nil))
-(cl-defmethod bindat--type (_op (_ (eql align)) len)
+(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
`(progn (cl-callf bindat--align bindat-idx ,len) nil))
-(cl-defmethod bindat--type (op (_ (eql type)) exp)
+(cl-defmethod bindat--type (op (_ (eql 'type)) exp)
(bindat--pcase op
('unpack `(funcall (bindat--type-ue ,exp)))
(`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args))
(`(pack . ,args) `(funcall (bindat--type-pe ,exp) . ,args))))
-(cl-defmethod bindat--type (op (_ (eql vec)) count &rest type)
+(cl-defmethod bindat--type (op (_ (eql 'vec)) count &rest type)
(unless type (setq type '(byte)))
(let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment)))
(bindat--pcase op
@@ -743,10 +743,10 @@ defmacro bindat--pcase (&rest args)
`(dotimes (bindat--i ,count)
(funcall ,fun (elt ,val bindat--i)))))))
-(cl-defmethod bindat--type (op (_ (eql unit)) val)
+(cl-defmethod bindat--type (op (_ (eql 'unit)) val)
(pcase op ('unpack val) (_ nil)))
-(cl-defmethod bindat--type (op (_ (eql struct)) &rest args)
+(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args)
(apply #'bindat--type op args))
(cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 544704be38..941e436ff7 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1158,7 +1158,12 @@ defvar cl--generic-eql-used (make-hash-table :test #'eql))
(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))
@@ -1269,6 +1274,11 @@ defun cl--generic-derived-specializers (mode &rest _)
(cl-generic-define-context-rewriter major-mode (mode &rest modes)
`(major-mode ,(if (consp mode)
;;E.g. could be (eql ...)
+ ;; WARNING: unsure whether this
+ ;; “could be (eql ...)” commentary (or code)
+ ;; should be adjusted
+ ;; following the (planned) changes to eql specializer.
+ ;; Bug #47327
(progn (cl-assert (null modes)) mode)
`(derived-mode ,mode . ,modes))))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 2aec8197dc..7def9ff96a 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1731,7 +1731,7 @@ defun edebug-match-form (cursor)
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&optional)) cursor specs)
;; Keep matching until one spec fails.
(edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
@@ -1755,7 +1755,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
"Handle &foo spec operators.
&foo spec operators operate on all the subsequent SPECS.")
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&rest)) cursor specs)
;; Repeatedly use specs until failure.
(let (edebug-best-error
edebug-error-point)
@@ -1768,7 +1768,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
(edebug-&optional-wrapper c (or s specs) rh)))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&or)) cursor specs)
;; Keep matching until one spec succeeds, and return its results.
;; If none match, fail.
;; This needs to be optimized since most specs spend time here.
@@ -1792,7 +1792,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &interpose)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs)
"Compute the specs for `&interpose SPEC FUN ARGS...'.
Extracts the head of the data by matching it against SPEC,
and then matches the rest by calling (FUN HEAD PF ARGS...)
@@ -1817,7 +1817,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
(append instrumented-head (edebug-match cursor newspecs)))
,@args))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql ¬)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '¬)) cursor specs)
;; If any specs match, then fail
(if (null (catch 'no-match
(let ((edebug-gate nil))
@@ -1829,7 +1829,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&key)) cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
@@ -1842,7 +1842,7 @@ defun edebug-&optional-wrapper (cursor specs remainder-handler)
(car (cdr pair))))
specs))))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&error)) cursor specs)
;; Signal an error, using the following string in the spec as argument.
(let ((error-string (car specs))
(edebug-error-point (edebug-before-offset cursor)))
@@ -1942,7 +1942,7 @@ defun edebug-match-nil (cursor)
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&define)) cursor specs)
;; Match a defining form.
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
@@ -1958,7 +1958,7 @@ defun edebug-match-function (_cursor)
;; Stop backtracking here (Bug#41988).
(setq edebug-gate t)))
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&name)) cursor specs)
"Compute the name for `&name SPEC FUN` spec operator.
The full syntax of that operator is:
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 5c76fb9eb9..c59342875d 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -407,15 +407,15 @@ defun map-merge-with (type function &rest maps)
"Convert MAP into a map of TYPE.")
;; FIXME: I wish there was a way to avoid this η-redex!
-(cl-defmethod map-into (map (_type (eql list)))
+(cl-defmethod map-into (map (_type (eql 'list)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql alist)))
+(cl-defmethod map-into (map (_type (eql 'alist)))
"Convert MAP into an alist."
(map-pairs map))
-(cl-defmethod map-into (map (_type (eql plist)))
+(cl-defmethod map-into (map (_type (eql 'plist)))
"Convert MAP into a plist."
(let (plist)
(map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
@@ -510,7 +510,7 @@ defun map--into-hash (map keyword-args)
map)
ht))
-(cl-defmethod map-into (map (_type (eql hash-table)))
+(cl-defmethod map-into (map (_type (eql 'hash-table)))
"Convert MAP into a hash-table with keys compared with `equal'."
(map--into-hash map (list :size (map-length map) :test #'equal)))
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index fb65975350..a529ed025d 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -240,7 +240,7 @@ defun radix-tree-count (tree)
(declare-function map-apply "map" (function map))
(defun radix-tree-from-map (map)
- ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
+ ;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...)
(require 'map)
(let ((rt nil))
(map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
diff --git a/lisp/frame.el b/lisp/frame.el
index 9b3d120598..8c05ad2fe5 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -36,7 +36,11 @@
(cl-generic-define-context-rewriter window-system (value)
;; If `value' is a `consp', it's probably an old-style specializer,
;; so just use it, and anyway `eql' isn't very useful on cons cells.
- `(window-system ,(if (consp value) value `(eql ,value))))
+ `(window-system ,(if (consp value) value
+ ;; WARNING: unsure whether this eql expression
+ ;; is actually an eql specializer.
+ ;; Bug #47327
+ `(eql ',value))))
(cl-defmethod frame-creation-function (params &context (window-system nil))
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 39bde837b3..53af2f6fe6 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -980,7 +980,7 @@ defsubst gnus-search-single-p (query)
;; Most search engines use implicit ANDs.
(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
- (_expr (eql and)))
+ (_expr (eql 'and)))
nil)
;; Most search engines use explicit infixed ORs.
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index e47f1f76e4..97bf1ac058 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -133,7 +133,7 @@ defun image-converter--value (type elem)
(list value)
value)))
-(cl-defmethod image-converter--probe ((type (eql graphicsmagick)))
+(cl-defmethod image-converter--probe ((type (eql 'graphicsmagick)))
"Check whether the system has GraphicsMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -151,7 +151,7 @@ defun image-converter--value (type elem)
(push (downcase (match-string 1)) formats)))
(nreverse formats)))))
-(cl-defmethod image-converter--probe ((type (eql imagemagick)))
+(cl-defmethod image-converter--probe ((type (eql 'imagemagick)))
"Check whether the system has ImageMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -171,7 +171,7 @@ defun image-converter--value (type elem)
(push (downcase (match-string 1)) formats)))
(nreverse formats))))
-(cl-defmethod image-converter--probe ((type (eql ffmpeg)))
+(cl-defmethod image-converter--probe ((type (eql 'ffmpeg)))
"Check whether the system has ffmpeg installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -212,12 +212,12 @@ defun image-converter--filter-formats (suffixes)
'image-mode)
collect suffix))
-(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
(image-converter--convert-magick type source image-format))
-(cl-defmethod image-converter--convert ((type (eql imagemagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'imagemagick)) source
image-format)
"Convert using ImageMagick."
(image-converter--convert-magick type source image-format))
@@ -249,7 +249,7 @@ defun image-converter--convert-magick (type source image-format)
;; error message.
(buffer-string))))
-(cl-defmethod image-converter--convert ((type (eql ffmpeg)) source
+(cl-defmethod image-converter--convert ((type (eql 'ffmpeg)) source
image-format)
"Convert using ffmpeg."
(let ((command (image-converter--value type :command)))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 133a2e1828..33bdd050bd 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -596,7 +596,7 @@ defun smtpmail-try-auth-methods (process supported-extensions host port
(error "Mechanism %S not implemented" mech))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql cram-md5)) user password)
+ (process (_mech (eql 'cram-md5)) user password)
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
@@ -618,13 +618,13 @@ defun smtpmail-try-auth-methods (process supported-extensions host port
(smtpmail-command-or-throw process encoded)))))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql login)) user password)
+ (process (_mech (eql 'login)) user password)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql plain)) user password)
+ (process (_mech (eql 'plain)) user password)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 7ed2d3d08c..542f8ad0b1 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -696,7 +696,7 @@ defvar elisp-xref-find-def-functions nil
non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
-(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
(require 'find-func)
;; FIXME: use information in source near point to filter results:
;; (dvc-log-edit ...) - exclude 'feature
@@ -875,7 +875,7 @@ defun elisp--xref-find-definitions (symbol)
(declare-function xref-apropos-regexp "xref" (pattern))
-(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
+(cl-defmethod xref-backend-apropos ((_backend (eql 'elisp)) pattern)
(apply #'nconc
(let ((regexp (xref-apropos-regexp pattern))
lst)
@@ -893,7 +893,8 @@ defvar elisp--xref-identifier-completion-table
(facep sym)))
'strict))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'elisp)))
elisp--xref-identifier-completion-table)
(cl-defstruct (xref-elisp-location
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index f0180ceeec..ce1d8e5e62 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2062,19 +2062,21 @@ defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p
;;;###autoload
(defun etags--xref-backend () 'etags)
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'etags)))
(find-tag--default))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'etags)))
(tags-lazy-completion-table))
-(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend
+ (eql 'etags)))
(find-tag--completion-ignore-case))
-(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol)
(etags--xref-find-definitions symbol))
-(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern)
+(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
(etags--xref-find-definitions (xref-apropos-regexp pattern) t))
(defun etags--xref-find-definitions (pattern &optional regexp?)
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el
index 7a7aa9fb3c..2a1d8b2763 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -49,27 +49,27 @@
(with-temp-buffer
(emacs-lisp-mode)
;; this method matches if A is the symbol `smthg' and if b is a list:
- (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
+ (insert "(cl-defmethod foo ((a (eql 'smthg)) (b list)) \"Return A+B.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-qualified-ok ()
"Checkdoc should be happy with a `cl-defmethod' using qualifiers."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod test :around ((a (eql smthg))) \"Return A.\")")
+ (insert "(cl-defmethod test :around ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok ()
"Checkdoc should be happy with a :extra qualified `cl-defmethod'."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defmethod foo :extra \"foo\" ((a (eql smthg))) \"Return A.\")")
+ (insert "(cl-defmethod foo :extra \"foo\" ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun))
(with-temp-buffer
(emacs-lisp-mode)
(insert
- "(cl-defmethod foo :extra \"foo\" :after ((a (eql smthg))) \"Return A.\")")
+ "(cl-defmethod foo :extra \"foo\" :after ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok ()
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 9312fb44a1..0093b04d1d 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)
--
2.31.1
^ permalink raw reply related [flat|nested] 15+ messages in thread
* bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated
2021-08-03 16:00 ` akater
@ 2021-08-03 23:02 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-08-10 12:39 ` Madhu
0 siblings, 1 reply; 15+ messages in thread
From: Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-08-03 23:02 UTC (permalink / raw)
To: akater; +Cc: 47327
> In the new patch, I combined your solution and my fixes to current
> cl-defmethod forms. I also tried to write an appropriate description in
> the patch header and in etc/NEWS.
Thanks.
> Please note that questionable spots remain, marked with `WARNING:'.
Your intuition was right (i.e. the code you wrote was the right choice).
I pushed it after removing those warnings as well as commenting out the
compile-time warnings from cl-defmethod (which is useful to move to the
new style but for now would be too annoying for third party packages
which have to maintain compatibility with Emacs<28).
Stefan
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated
2021-08-03 23:02 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-08-10 12:39 ` Madhu
2021-08-10 12:56 ` Christian Albrecht via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 15+ messages in thread
From: Madhu @ 2021-08-10 12:39 UTC (permalink / raw)
To: 47327
[-- Attachment #1: Type: text/plain, Size: 601 bytes --]
`emacs --daemon'
`emacsclient -t' fails to start with a no matching method error
*ERROR*: No applicable method: frame-creation-function,
((vertical-scroll-bars) (height . 32) (width . 80) (client . #<process
server <3>>) [...] (window-system) (tty . "/dev/pts/3") (tty-type
. "xterm-256color"))
The following patch might fix it, but it behaves strangely. After the
fix (without recompiling the emacs binary) if I stick in a (load-library
"frame") in my .emacs, the method does not appear to be patched. - I
have to use a graphical `emacsclient -n -c' and then compile/load
frame.el again.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: lisp-frame.el-frame-creation-function-fix-window-system.patch --]
[-- Type: text/x-diff, Size: 638 bytes --]
diff --git a/lisp/frame.el b/lisp/frame.el
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -38,7 +38,7 @@ window-system
;; so just use it, and anyway `eql' isn't very useful on cons cells.
`(window-system ,(if (consp value) value `(eql ',value))))
-(cl-defmethod frame-creation-function (params &context (window-system nil))
+(cl-defmethod frame-creation-function (params &context (window-system (eql 'nil)))
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
;; this method (i.e. move this method to faces.el), but faces.el is loaded
;; much earlier from loadup.el (before cl-generic and even before
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated
2021-08-10 12:39 ` Madhu
@ 2021-08-10 12:56 ` Christian Albrecht via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-08-19 11:41 ` Madhu
0 siblings, 1 reply; 15+ messages in thread
From: Christian Albrecht via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-08-10 12:56 UTC (permalink / raw)
To: 47327
> `emacs --daemon'
> `emacsclient -t' fails to start with a no matching method error
>
> *ERROR*: No applicable method: frame-creation-function,
> ((vertical-scroll-bars) (height . 32) (width . 80) (client . #<process
> server <3>>) [...] (window-system) (tty . "/dev/pts/3") (tty-type
> . "xterm-256color"))
is this, by any chance, related to and fixed by
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=49877#28
Cheers,
Christian
^ permalink raw reply [flat|nested] 15+ messages in thread
* bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated
2021-08-10 12:56 ` Christian Albrecht via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-08-19 11:41 ` Madhu
2021-08-19 13:10 ` Lars Ingebrigtsen
0 siblings, 1 reply; 15+ messages in thread
From: Madhu @ 2021-08-19 11:41 UTC (permalink / raw)
To: 47327
* Christian Albrecht via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <87r1f1jvxz.fsf@mayflower.de> :
Wrote on Tue, 10 Aug 2021 14:56:31 +0200:
>> `emacs --daemon'
>> `emacsclient -t' fails to start with a no matching method error
>>
>> *ERROR*: No applicable method: frame-creation-function,
>> ((vertical-scroll-bars) (height . 32) (width . 80) (client . #<process
>> server <3>>) [...] (window-system) (tty . "/dev/pts/3") (tty-type
>> . "xterm-256color"))
>
> is this, by any chance, related to and fixed by
> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=49877#28
I built master and I am not seeing the problem now, so this bug must
have been fixed.
[Both my analysis above and suggested fix seem to be wrong. I think
the problem was that my init file was requiring etags at some
point, which activated the error.
i.e. emacs --fg-daemon -Q -l etags
and emacsclient -t
would have reproduced it and not the recipe i gave, sorry]
^ permalink raw reply [flat|nested] 15+ messages in thread