X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-introspect%2Fsb-introspect.lisp;h=488654d8e85f26f1b3348cc2e8a43ff278fa48c0;hb=37200d73dfca16507809778574092cfb998711d5;hp=5a36bf4b74d482b51f4b20974d9b538d73378ff4;hpb=ad640ad16fb2ed5c8f080fbe6c66a45fa6bdbbe1;p=sbcl.git

diff --git a/contrib/sb-introspect/sb-introspect.lisp b/contrib/sb-introspect/sb-introspect.lisp
index 5a36bf4..488654d 100644
--- a/contrib/sb-introspect/sb-introspect.lisp
+++ b/contrib/sb-introspect/sb-introspect.lisp
@@ -224,11 +224,12 @@ If an unsupported TYPE is requested, the function will return NIL.
               (find-definition-source class)))))
        ((:method-combination)
         (let ((combination-fun
-               (ignore-errors (find-method #'sb-mop:find-method-combination
-                                           nil
-                                           (list (find-class 'generic-function)
-                                                 (list 'eql name)
-                                                 t)))))
+               (find-method #'sb-mop:find-method-combination
+                            nil
+                            (list (find-class 'generic-function)
+                                  (list 'eql name)
+                                  t)
+                            nil)))
           (when combination-fun
             (find-definition-source combination-fun))))
        ((:package)
@@ -353,8 +354,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))