* lisp/subr.el (method-files): Move function to cl-generic.el

* lisp/emacs-lisp/cl-generic.el (cl-generic-p): New function.
(cl--generic-method-files): New function, moved from subr.el.
* lisp/emacs-lisp/edebug.el (edebug-instrument-function): Use them.
* test/lisp/emacs-lisp/cl-generic-tests.el:
* test/lisp/subr-tests.el: Move and adjust method-files tests accordingly.

diff --git a/etc/NEWS b/etc/NEWS
index a7800feed1f14a5afdea570eef4775825df2d34b..2b7c93fda10f656d98f1cd0b8cf7c87212ae1b02 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -604,6 +604,8 @@ paragraphs, for the purposes of bidirectional display.
 \f
 * Changes in Specialized Modes and Packages in Emacs 26.1
 
+** New function `cl-generic-p'.
+
 ** Dired
 
 +++

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 114468239a58c9395caa71c2edd624aae46cfbb7..1a3f8e1f4d509326912da06542225b246f720b98 100644 (file)
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -166,6 +166,10 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
 (defmacro cl--generic (name)
   `(get ,name 'cl--generic))
 
+(defun cl-generic-p (f)
+  "Return non-nil if F is a generic function."
+  (and (symbolp f) (cl--generic f)))
+
 (defun cl-generic-ensure-function (name &optional noerror)
   (let (generic
         (origname name))
@@ -1023,6 +1027,20 @@ The value returned is a list of elements of the form
           (push (cl--generic-method-info method) docs))))
     docs))
 
+(defun cl--generic-method-files (method)
+  "Return a list of files where METHOD is defined by `cl-defmethod'.
+The list will have entries of the form (FILE . (METHOD ...))
+where (METHOD ...) contains the qualifiers and specializers of
+the method and is a suitable argument for
+`find-function-search-for-symbol'.  Filenames are absolute."
+  (let (result)
+    (pcase-dolist (`(,file . ,defs) load-history)
+      (dolist (def defs)
+        (when (and (eq (car-safe def) 'cl-defmethod)
+                   (eq (cadr def) method))
+          (push (cons file (cdr def)) result))))
+    result))
+
 ;;; Support for (head <val>) specializers.
 
 ;; For both the `eql' and the `head' specializers, the dispatch

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1494ed1d9c3c0d1cb68a1d6b167d617edf8204bc..c6ef8d7a99c9043a67f09a8a84bade24728f8b28 100644 (file)
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3213,8 +3213,8 @@ instrument cannot be found, signal an error."
      ((consp func-marker)
       (message "%s is already instrumented." func)
       (list func))
-     ((get func 'cl--generic)
-      (let ((method-defs (method-files func))
+     ((cl-generic-p func)
+      (let ((method-defs (cl--generic-method-files func))
             symbols)
         (unless method-defs
           (error "Could not find any method definitions for %s" func))

diff --git a/lisp/subr.el b/lisp/subr.el
index 79a28d301e77b5ab872177f29f57ba9cc297d46c..90a78cf68a08551b5ffac3b13399f77b283da3cc 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2031,25 +2031,6 @@ definition, variable definition, or face definition only."
        (setq files (cdr files)))
       file)))
 
-(defun method-files (method)
-  "Return a list of files where METHOD is defined by `cl-defmethod'.
-The list will have entries of the form (FILE . (METHOD ...))
-where (METHOD ...) contains the qualifiers and specializers of
-the method and is a suitable argument for
-`find-function-search-for-symbol'.  Filenames are absolute."
-  (let ((files load-history)
-        result)
-    (while files
-      (let ((defs (cdr (car files))))
-        (while defs
-          (let ((def (car defs)))
-            (if (and (eq (car-safe def) 'cl-defmethod)
-                     (eq (cadr def) method))
-                (push (cons (car (car files)) (cdr def)) result)))
-          (setq defs (cdr defs))))
-      (setq files (cdr files)))
-    result))
-
 (defun locate-library (library &optional nosuffix path interactive-call)
   "Show the precise file name of Emacs library LIBRARY.
 LIBRARY should be a relative file name of the library, a string.

diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 0768e31f7e631a31dc1e3fb46f4599b461d9977e..31f65413c880632874808cfb406d1c6ed42f94fa 100644 (file)
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -219,5 +219,29 @@
   (should (equal (cl--generic-1 '(5) nil) '("cinq" (5))))
   (should (equal (cl--generic-1 '(6) nil) '("six" a))))
 
+(cl-defgeneric cl-generic-tests--generic (x))
+(cl-defmethod cl-generic-tests--generic ((x string))
+  (message "%s is a string" x))
+(cl-defmethod cl-generic-tests--generic ((x integer))
+  (message "%s is a number" x))
+(cl-defgeneric cl-generic-tests--generic-without-methods (x y))
+(defvar cl-generic-tests--this-file
+  (file-truename (or load-file-name buffer-file-name)))
+
+(ert-deftest cl-generic-tests--method-files--finds-methods ()
+  "`method-files' returns a list of files and methods for a generic function."
+  (let ((retval (cl--generic-method-files 'cl-generic-tests--generic)))
+    (should (equal (length retval) 2))
+    (mapc (lambda (x)
+            (should (equal (car x) cl-generic-tests--this-file))
+            (should (equal (cadr x) 'cl-generic-tests--generic)))
+          retval)
+    (should-not (equal (nth 0 retval) (nth 1 retval)))))
+
+(ert-deftest cl-generic-tests--method-files--nonexistent-methods ()
+  "`method-files' returns nil if asked to find a method which doesn't exist."
+  (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic))
+  (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods)))
+
 (provide 'cl-generic-tests)
 ;;; cl-generic-tests.el ends here

diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 7e50429a5bf0e45d53d65238a160ec5063a279de..a59f0ca90e17ab75acacc0d2091bbf0f660c9d4f 100644 (file)
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -292,31 +292,6 @@ cf. Bug#25477."
   (should-error (eval '(dolist "foo") t)
                 :type 'wrong-type-argument))
 
-(require 'cl-generic)
-(cl-defgeneric subr-tests--generic (x))
-(cl-defmethod subr-tests--generic ((x string))
-  (message "%s is a string" x))
-(cl-defmethod subr-tests--generic ((x integer))
-  (message "%s is a number" x))
-(cl-defgeneric subr-tests--generic-without-methods (x y))
-(defvar subr-tests--this-file
-  (file-truename (or load-file-name buffer-file-name)))
-
-(ert-deftest subr-tests--method-files--finds-methods ()
-  "`method-files' returns a list of files and methods for a generic function."
-  (let ((retval (method-files 'subr-tests--generic)))
-    (should (equal (length retval) 2))
-    (mapc (lambda (x)
-            (should (equal (car x) subr-tests--this-file))
-            (should (equal (cadr x) 'subr-tests--generic)))
-          retval)
-    (should-not (equal (nth 0 retval) (nth 1 retval)))))
-
-(ert-deftest subr-tests--method-files--nonexistent-methods ()
-  "`method-files' returns nil if asked to find a method which doesn't exist."
-  (should-not (method-files 'subr-tests--undefined-generic))
-  (should-not (method-files 'subr-tests--generic-without-methods)))
-
 (ert-deftest subr-tests-bug22027 ()
   "Test for http://debbugs.gnu.org/22027 ."
   (let ((default "foo") res)