From 7da051bf31bc6097e0096fd75df194cb1f5c6762 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 27 Nov 2011 16:53:20 +0200 Subject: [PATCH] tweak NAME-CONTEXT On platforms without UNWIND-TO-FRAME-AND-CALL vops we introduce an extra block, which then shows up there in the function names for eg. lambdas defined at the toplevel in high debug code. Fix that. CATCH also introduces a block. Filter those out too. --- src/compiler/ir1-translators.lisp | 12 +++++++++++- tests/compiler.pure.lisp | 10 ++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index a5e4cfb..7d05f20 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -480,7 +480,17 @@ Return VALUE without evaluating it." ;; Name of the outermost non-NIL BLOCK, or the source namestring ;; of the source file. (let ((context - (or (car (find-if #'car (lexenv-blocks *lexenv*) :from-end t)) + (or (car (find-if (lambda (b) + (let ((name (pop b))) + (and name + ;; KLUDGE: High debug adds this block on + ;; some platforms. + #!-unwind-to-frame-and-call-vop + (neq 'return-value-tag name) + ;; KLUDGE: CATCH produces blocks whose + ;; cleanup is :CATCH. + (neq :catch (cleanup-kind (entry-cleanup (pop b))))))) + (lexenv-blocks *lexenv*) :from-end t)) *source-namestring* (let ((p (or *compile-file-truename* *load-truename*))) (when p (namestring p)))))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 3e48e39..083a79e 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -4069,3 +4069,13 @@ :initial-element 0) 1) #(0 1 0 0))))) + +(with-test (:name :catch-interferes-with-debug-names) + (let ((fun (funcall + (compile nil + `(lambda () + (catch 'out + (flet ((foo () + (throw 'out (lambda () t)))) + (foo)))))))) + (assert (equal '(lambda () :in foo) (sb-kernel:%fun-name fun))))) -- 1.7.10.4