[Openmcl-cvs-notifications] r11408 - /trunk/source/lib/source-files.lisp

[gz at clozure.com]

Author: gz
Date: Tue Nov 18 18:26:34 2008
New Revision: 11408

Log:
accept method-function in source location lookup

Modified:
    trunk/source/lib/source-files.lisp

Modified: trunk/source/lib/source-files.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/source-files.lisp (original)
+++ trunk/source/lib/source-files.lisp Tue Nov 18 18:26:34 2008
@@ -226,6 +226,9 @@
 ;; defmethod passes the actual method into record-source-file
 (defmethod definition-base-name ((dt method-definition-type) (method metho=
d))
   (definition-base-name dt (method-name method)))
+
+(defmethod definition-base-name ((dt method-definition-type) (fn method-fu=
nction))
+  (definition-base-name dt (function-name fn)))
 =

 (defmethod definition-same-p ((dt method-definition-type) m1 m2)
   (multiple-value-bind (n1 q1 s1) (method-def-parameters m1)
@@ -606,6 +609,8 @@
 =

 ;; Returns nil if not a method/method name
 (defun method-def-parameters (m)
+  (when (typep m 'method-function)
+    (setq m (%method-function-method m)))
   (if (typep m 'method)
     (values (method-name m)
             (method-qualifiers m)