From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: akater Newsgroups: gmane.emacs.bugs Subject: bug#47327: 28.0.50; (cl-generic) eql specializer not evaluated Date: Tue, 03 Aug 2021 16:00:44 +0000 Message-ID: <87h7g634cz.fsf@gmail.com> References: <87k0pz5d6u.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="21156"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 47327@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Aug 03 18:13:12 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mAx2V-0005Ls-Jb for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 03 Aug 2021 18:13:11 +0200 Original-Received: from localhost ([::1]:54830 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mAx2T-0008Qs-70 for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 03 Aug 2021 12:13:09 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:53970) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mAx2M-0008Qj-8i for bug-gnu-emacs@gnu.org; Tue, 03 Aug 2021 12:13:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:57931) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mAx2M-0001Ra-2H for bug-gnu-emacs@gnu.org; Tue, 03 Aug 2021 12:13:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mAx2L-0007TC-UQ for bug-gnu-emacs@gnu.org; Tue, 03 Aug 2021 12:13:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: akater Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 03 Aug 2021 16:13:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 47327 X-GNU-PR-Package: emacs Original-Received: via spool by 47327-submit@debbugs.gnu.org id=B47327.162800712528649 (code B ref 47327); Tue, 03 Aug 2021 16:13:01 +0000 Original-Received: (at 47327) by debbugs.gnu.org; 3 Aug 2021 16:12:05 +0000 Original-Received: from localhost ([127.0.0.1]:41244 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mAx1Q-0007S0-Dz for submit@debbugs.gnu.org; Tue, 03 Aug 2021 12:12:05 -0400 Original-Received: from mail-ed1-f46.google.com ([209.85.208.46]:44820) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mAx1N-0007RU-5L for 47327@debbugs.gnu.org; Tue, 03 Aug 2021 12:12:02 -0400 Original-Received: by mail-ed1-f46.google.com with SMTP id z11so7239573edb.11 for <47327@debbugs.gnu.org>; Tue, 03 Aug 2021 09:12:01 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:in-reply-to:references:date:message-id :mime-version; bh=/bfTxI3qKaVUpmbDL2nBX/5zjskTp1RuRxyajRvwzwI=; b=UdkGvRlKDDG2vZQGiskaF67DDhHM6V6zfnU1YRw93LkPKO8Bqwu1zO9Wr0bMT1M1yR L0t/vHO218QgIFPZff8PKQ4D3jBFNM5qN2tk76i/C1AH/KJSM+jZ6/MzXDKcIoWR09ho Hqc4QXtZO0xu9kMLcUvl0s94OtM+QmtRzT4uuLaACKAxZ7cwPXJEToL2quyxaLrLfyr4 RNS1Tg0pnCrAO8aiyp1luf6K3FeBQLpNNRrndEFEgCrWCHacdLGZD0NfCugaW6Qt/FSy F1GQwVkU9LCIBaSh+5g/IJOXsmTE7cZoNLnE/DnNZtGtDemRZQBav9SxI9AqHMq3vkUD sf6g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references:date :message-id:mime-version; bh=/bfTxI3qKaVUpmbDL2nBX/5zjskTp1RuRxyajRvwzwI=; b=DzxQahle0e/FDBrZYziuOWTuGNv2fijzYBe6i4ydlZJH49f9D6PLxzTmnGPJQ2CleA E6HvgigwbexTOWmAADSM1nQ0C8e2wfFvraoNuFWhPWRrJmXSv10glIDQXEb834NuqGo2 ehqMuAIn1aIwsEAHMP5eCJnMWCauj5lvU7DRAF127/NJVcLAWUp0JZu8EP58RS4+7PXm Hp1qLrBtTHq7IPa25KlnhxfkMxt7ST3PWXEoeN5j/36Ix0x6y5QyUNGPTjALqmtSkIof 03kSd2G/uYxC+aGDXNgtjuj4LAkiajmKHmLZnUa4sio2fpKmERFMlEW7RuC32Kgc2Ttw rODQ== X-Gm-Message-State: AOAM530BEWgJZlTpzQPseMz9uL4YNgUpUlHQyCtgeRuErbRkNtJoEzbJ Q7L52vCMU1bymEZO8YL2waw= X-Google-Smtp-Source: ABdhPJyhN7gDiLvXXrwNpKGDnhUjvNjfwFS1FEB165CZGfdT1/ZamMebmiGvf2evF58TrIddPi+q0w== X-Received: by 2002:aa7:c357:: with SMTP id j23mr11882416edr.370.1628007115352; Tue, 03 Aug 2021 09:11:55 -0700 (PDT) Original-Received: from localhost ([5.183.209.217]) by smtp.googlemail.com with ESMTPSA id e7sm6450900ejt.80.2021.08.03.09.11.53 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 03 Aug 2021 09:11:54 -0700 (PDT) In-Reply-To: X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:211097 Archived-At: --=-=-= Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" --==-=-= Content-Type: text/plain 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:'. --==-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJLBAEBCgA1FiEEgu5SJRdnQOF34djNsr6xYbHsf0QFAmEJaC8XHG51Y2xlYXJz cGFjZUBnbWFpbC5jb20ACgkQsr6xYbHsf0QilRAA1W24MNpc6Q9NgeWFy2fWVGb9 64g/c5sGyvES8MSfxSy+PX88pt9BpUyVZ6NgKGWVWZXxTkxsh32SgEpjn0guwkki f9YUetaDZ9dtfwJUS5sBYo2xaMkgXNoPPOppdQRmmaoeBl0E5lLaZxIrbJEEpiiI y7MJ+eqIH7eSHoL6xGE+7g6R0UqPDiLsCdW783FGx+ci84JX1+bSzFoUvSl6Cbz3 foM4bxXOPQCJHnuNIWFpDQyDVeBnkdvu+v/LoHs94B/5Iyvk3CHM6Y/KZuiNh8zU xQxegxw4EZLjfY0zLP6vIQo6b4cIE/XsJxfvFsXxnzLc5QADwabznEJTd3/ZC18x k+GpyR5hLd5NxLlYgyzzsuyVSxUl8VGz7/7be4ZG5Y13pmEwgZ36PgahaAWxqUQF hODcjy0ksdff+BmJrm0me1aWuss0WQ/3uUEjTpF2QLd6/RdEEvYwf/Pp1Uk/fPka L8Evs7pKpuw5MGyP2VO6P1a5jc1W1u5vpoCaccqhjN+/TX2GmH9ZBYG0qA0+Vq6h S6byhWRN7a32J/LUmwOOywi0OovhU72IsXujHCjCWWtneiZaBbLFremb2tsXqqFS Ci1wXdyiGwcjtqSWEagdkt/+TkkR2cF+qUm2BofBQYpkpflRZG9DYacK51FI3PDf UbAi9o/JFAcbki6/SLM= =0/ng -----END PGP SIGNATURE----- --==-=-=-- --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0001-Evaluate-eql-specializers.patch Content-Transfer-Encoding: quoted-printable Content-Description: Evaluate eql specializers >From bee57a5cab2762f50425c775757672a2c487573e Mon Sep 17 00:00:00 2001 From: akater 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 ru= le. * 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 rul= e. * 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. =20 +--- +*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated. +This corresponds to the behaviour of defmethod in Common Lisp Object Syste= m. +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.") =20 -(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)))) =20 -(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))))) =20 -(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))))) =20 -(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)))) =20 -(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)))))) =20 -(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)))) =20 -(cl-defmethod bindat--type (_op (_ (eql fill)) len) +(cl-defmethod bindat--type (_op (_ (eql 'fill)) len) `(progn (cl-incf bindat-idx ,len) nil)) =20 -(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)) =20 -(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)))) =20 -(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-environme= nt))) (bindat--pcase op @@ -743,10 +743,10 @@ defmacro bindat--pcase (&rest args) `(dotimes (bindat--i ,count) (funcall ,fun (elt ,val bindat--i))))))) =20 -(cl-defmethod bindat--type (op (_ (eql unit)) val) +(cl-defmethod bindat--type (op (_ (eql 'unit)) val) (pcase op ('unpack val) (_ nil))) =20 -(cl-defmethod bindat--type (op (_ (eql struct)) &rest args) +(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args) (apply #'bindat--type op args)) =20 (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)) =20 (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 + ;; =E2=80=9Ccould be (eql ...)=E2=80=9D 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)))) =20 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) =20 (defsubst edebug-match-body (cursor) (edebug-forms cursor)) =20 -(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)) =20 @@ -1755,7 +1755,7 @@ defun edebug-&optional-wrapper (cursor specs remainde= r-handler) "Handle &foo spec operators. &foo spec operators operate on all the subsequent SPECS.") =20 -(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 remainde= r-handler) (edebug-&optional-wrapper c (or s specs) rh))))) =20 =20 -(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 remainde= r-handler) (apply #'edebug-no-match cursor "Expected one of" original-specs)) )) =20 -(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 remainde= r-handler) (append instrumented-head (edebug-match cursor newspec= s))) ,@args)))) =20 -(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 remainde= r-handler) ;; This means nothing matched, so it is OK. nil) ;; So, return nothing =20 -(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 ( ) ... ;; where 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 remainde= r-handler) (car (cdr pair)))) specs)))) =20 -(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")) =20 -(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 remaind= er @@ -1958,7 +1958,7 @@ defun edebug-match-function (_cursor) ;; Stop backtracking here (Bug#41988). (setq edebug-gate t))) =20 -(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. =20 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.") =20 ;; FIXME: I wish there was a way to avoid this =CE=B7-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)) =20 -(cl-defmethod map-into (map (_type (eql alist))) +(cl-defmethod map-into (map (_type (eql 'alist))) "Convert MAP into an alist." (map-pairs map)) =20 -(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)) =20 -(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))) =20 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)) =20 (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)))) =20 (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 i= nto 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) =20 ;; Most search engines use implicit ANDs. (cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine) - (_expr (eql and))) + (_expr (eql 'and))) nil) =20 ;; 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))) =20 -(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))))) =20 -(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)))) =20 -(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)) =20 -(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)) =20 -(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 imag= e-format) ;; error message. (buffer-string)))) =20 -(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-exte= nsions host port (error "Mechanism %S not implemented" mech)) =20 (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-ex= tensions host port (smtpmail-command-or-throw process encoded))))) =20 (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))) =20 (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'.") =20 -(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) =20 (declare-function xref-apropos-regexp "xref" (pattern)) =20 -(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)) =20 -(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eli= sp))) +(cl-defmethod xref-backend-identifier-completion-table ((_backend + (eql 'elisp))) elisp--xref-identifier-completion-table) =20 (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) =20 -(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags))) +(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'etags))) (find-tag--default)) =20 -(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eta= gs))) +(cl-defmethod xref-backend-identifier-completion-table ((_backend + (eql 'etags))) (tags-lazy-completion-table)) =20 -(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (e= ql etags))) +(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend + (eql 'etags= ))) (find-tag--completion-ignore-case)) =20 -(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol) +(cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol) (etags--xref-find-definitions symbol)) =20 -(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)) =20 (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))) =20 (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))) =20 (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)) =20 (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))) =20 (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-lis= p/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"))) =20 (cl-defstruct cl-generic-struct-parent a b) (cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent= )) c) --=20 2.31.1 --=-=-=--