]> git.eshelyaron.com Git - emacs.git/commitdiff
Evaluate eql specializers
authorakater <nuclearspace@gmail.com>
Tue, 20 Jul 2021 01:25:01 +0000 (01:25 +0000)
committerStefan Monnier <monnier@iro.umontreal.ca>
Tue, 3 Aug 2021 22:26:15 +0000 (18:26 -0400)
* 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.

14 files changed:
etc/NEWS
lisp/emacs-lisp/bindat.el
lisp/emacs-lisp/cl-generic.el
lisp/emacs-lisp/edebug.el
lisp/emacs-lisp/map.el
lisp/emacs-lisp/radix-tree.el
lisp/frame.el
lisp/gnus/gnus-search.el
lisp/image/image-converter.el
lisp/mail/smtpmail.el
lisp/progmodes/elisp-mode.el
lisp/progmodes/etags.el
test/lisp/emacs-lisp/checkdoc-tests.el
test/lisp/emacs-lisp/cl-generic-tests.el

index 48dec0a2b3b158d26438cc2d2172dcf9f566b622..fb6eddc754fa75d4a3e850f1b452ac6bec67f34a 100644 (file)
--- 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.
index 247fb91379e56cd8b819a49ae8957f59c573400c..76c2e80fda808c1ae325a8aec9f3b14b72902719 100644 (file)
@@ -657,33 +657,33 @@ The port (if any) is omitted.  IP can be a string, as well."
 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 @@ is the name of a variable that will hold the value we need to pack.")
             (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 @@ is the name of a variable that will hold the value we need to pack.")
        `(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)
index 544704be387eb8a6ee701f77b240ee41f1871a60..941e436ff7892d5cc75e1a6fffcdd703ccbf885e 100644 (file)
@@ -1158,7 +1158,12 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
 (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 @@ Used internally for the (major-mode MODE) context specializers."
 (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))))
 
index 2aec8197dc9be3f1963faa9666cc5ba1158ca8e1..7def9ff96a709981af0cab86f43fbb0470c34d56 100644 (file)
@@ -1731,7 +1731,7 @@ contains a circular object."
 
 (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 @@ contains a circular object."
   "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 @@ contains a circular object."
        (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 @@ contains a circular object."
       (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 @@ a sequence of elements."
                     (append instrumented-head (edebug-match cursor newspecs)))
                  ,@args))))
 
-(cl-defmethod edebug--match-&-spec-op ((_ (eql &not)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&not)) cursor specs)
   ;; If any specs match, then fail
   (if (null (catch 'no-match
              (let ((edebug-gate nil))
@@ -1829,7 +1829,7 @@ a sequence of elements."
   ;; 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 @@ a sequence of elements."
                            (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 @@ a sequence of elements."
 (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 @@ a sequence of elements."
     ;; 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:
index 5c76fb9eb959b50f1ba97bc87f8618d05a6e7ea8..c59342875dbd5eaec191130ed17ee9847f768526 100644 (file)
@@ -407,15 +407,15 @@ See `map-into' for all supported values of TYPE."
   "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 @@ KEYWORD-ARGS are forwarded to `make-hash-table'."
             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)))
 
index fb6597535017cfc765b8c6e1a447815d160001a8..a529ed025d6e0d35a3989955ee7139b869ce464a 100644 (file)
@@ -240,7 +240,7 @@ PREFIX is only used internally."
 (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)
index 9b3d120598b90fbaac463a6affc92f893af4bb36..8c05ad2fe5c723774cbe70285278d0fed2ae1ca6 100644 (file)
@@ -36,7 +36,11 @@ as its argument.")
 (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
index 39bde837b3002e1cd77e8eb13eda6853a6e43990..53af2f6fe6aa2f760ee48e6cd8d98d2a5c64cb03 100644 (file)
@@ -980,7 +980,7 @@ Responsible for handling and, or, and parenthetical expressions.")
 
 ;; 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.
index e47f1f76e42dc02e4c73ce211518f20d9751b6e5..97bf1ac058c47116473e458edba740f5aac7bc8c 100644 (file)
@@ -133,7 +133,7 @@ data is returned as a string."
         (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 @@ data is returned as a string."
             (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 @@ data is returned as a string."
           (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 @@ Only suffixes that map to `image-mode' are returned."
                     '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 @@ Only suffixes that map to `image-mode' are returned."
       ;; 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)))
index 133a2e1828eaca5c741bede04e92461dfc4a892b..33bdd050bdcb5936e8e0251931331a86125d3d38 100644 (file)
@@ -596,7 +596,7 @@ USER and PASSWORD should be non-nil."
   (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 @@ USER and PASSWORD should be non-nil."
        (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
index 7ed2d3d08cc654cff7898b60447edfde3cff1d74..542f8ad0b1b6050bdd1c458410e0afa4d8d10ae4 100644 (file)
@@ -696,7 +696,7 @@ Each function should return a list of xrefs, or nil; the first
 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 @@ non-nil result supersedes the xrefs produced by
 
 (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 @@ non-nil result supersedes the xrefs produced by
                          (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
index f0180ceeecaf9cd509a69ad166d485cf5823d1c8..ce1d8e5e620d1869be2212ad4b1ca06d7298defd 100644 (file)
@@ -2062,19 +2062,21 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
 ;;;###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?)
index 7a7aa9fb3cdbbb8b5b87a7c99c508ec635350259..2a1d8b2763675b584098e4d2ac859780b518e897 100644 (file)
   (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 ()
index 9312fb44a1ece9579783ffaa59b852b65b21baac..0093b04d1d8ebdd17e74ee7b2b03649ded3716ad 100644 (file)
   (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)