1.0.18.10: Record filenames in DEBUG-SOURCEs during EVAL-WHEN, LOAD.

[sbcl.git] / contrib / sb-introspect / sb-introspect.lisp

diff --git a/contrib/sb-introspect/sb-introspect.lisp b/contrib/sb-introspect/sb-introspect.lisp
index e54f5c4..45b1784 100644 (file)
--- a/contrib/sb-introspect/sb-introspect.lisp
+++ b/contrib/sb-introspect/sb-introspect.lisp
@@ -320,8 +320,11 @@ If an unsupported TYPE is requested, the function will return NIL.
        (when source
          (setf (definition-source-description source)
                (append (method-qualifiers object)
-                       (sb-pcl::unparse-specializers
-                        (sb-mop:method-specializers object)))))
+                       (if (sb-mop:method-generic-function object)
+                           (sb-pcl::unparse-specializers
+                            (sb-mop:method-generic-function object)
+                            (sb-mop:method-specializers object))
+                           (sb-mop:method-specializers object)))))
        source))
     #+sb-eval
     (sb-eval:interpreted-function
@@ -337,8 +340,10 @@ If an unsupported TYPE is requested, the function will return NIL.
              (struct-predicate-structure-class object)))
            (t
             (find-function-definition-source object))))
+    ((or condition standard-object structure-object)
+     (find-definition-source (class-of object)))
     (t
-     (error "Don't know how to retrive source location for a ~S~%"
+     (error "Don't know how to retrieve source location for a ~S~%"
             (type-of object)))))
 
 (defun find-function-definition-source (function)
@@ -348,8 +353,14 @@ If an unsupported TYPE is requested, the function will return NIL.
          (tlf (if debug-fun (sb-c::compiled-debug-fun-tlf-number debug-fun))))
     (make-definition-source
      :pathname
-     (if (eql (sb-c::debug-source-from debug-source) :file)
-         (parse-namestring (sb-c::debug-source-name debug-source)))
+     ;; KLUDGE: at the moment, we don't record the correct toplevel
+     ;; form number for forms processed by EVAL (including EVAL-WHEN
+     ;; :COMPILE-TOPLEVEL).  Until that's fixed, don't return a
+     ;; DEFINITION-SOURCE with a pathname.  (When that's fixed, take
+     ;; out the (not (debug-source-form ...)) test.
+     (if (and (sb-c::debug-source-namestring debug-source)
+              (not (sb-c::debug-source-form debug-source)))
+         (parse-namestring (sb-c::debug-source-namestring debug-source)))
      :character-offset
      (if tlf
          (elt (sb-c::debug-source-start-positions debug-source) tlf))
@@ -494,7 +505,8 @@ list of the symbols :dynamic, :static, or :read-only."
      (lambda (obj header size)
        (when (= sb-vm:code-header-widetag header)
          (funcall fn obj size)))
-     space)))
+     space
+     t)))
 
 (declaim (inline map-caller-code-components))
 (defun map-caller-code-components (function spaces fn)