From a71c8bac4722c4bb28758f27c41362a8c961831c Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Fri, 17 May 2013 16:08:00 -0400 Subject: [PATCH] COMPILE-FILE shouldn't "attempt to dump invalid structure" anymore * When CAST nodes detect definite type mismatch, they are replaced with debugging instrumentation to provide source locations at compile and run -time. When code is generated internally, the source can include literal internal data structures. Skip those when recovering source locations. * Fixes lp#943953 and a bunch of equally baffling duplicates. --- NEWS | 2 ++ src/compiler/ir1util.lisp | 17 ++++++++++++++++- tests/bug-943953.lisp | 3 +++ tests/compiler.impure.lisp | 9 +++++++++ 4 files changed, 30 insertions(+), 1 deletion(-) create mode 100644 tests/bug-943953.lisp diff --git a/NEWS b/NEWS index 884f06e..688915f 100644 --- a/NEWS +++ b/NEWS @@ -37,6 +37,8 @@ changes relative to sbcl-1.1.7: * bug fix: sb-sequence:dosequence works on literal vectors. * bug fix: errors in generic arithmetic show the assembly routine's caller on x86 and x86-64. (lp#800343) + * bug fix: Compile-time type errors should never result in COMPILE-FILE + failure. (lp#943953) * optimization: faster ISQRT on fixnums and small bignums * optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64. * optimization: On x86-64, the number of multi-byte NOP instructions used diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 2067422..82bea22 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -758,11 +758,26 @@ (defun source-path-forms (path) (subseq path 0 (position 'original-source-start path))) +(defun tree-some (predicate tree) + (let ((seen (make-hash-table))) + (labels ((walk (tree) + (cond ((funcall predicate tree)) + ((and (consp tree) + (not (gethash tree seen))) + (setf (gethash tree seen) t) + (or (walk (car tree)) + (walk (cdr tree))))))) + (walk tree)))) + ;;; Return the innermost source form for NODE. (defun node-source-form (node) (declare (type node node)) (let* ((path (node-source-path node)) - (forms (source-path-forms path))) + (forms (remove-if (lambda (x) + (tree-some #'leaf-p x)) + (source-path-forms path)))) + ;; another option: if first form includes a leaf, return + ;; find-original-source instead. (if forms (first forms) (values (find-original-source path))))) diff --git a/tests/bug-943953.lisp b/tests/bug-943953.lisp new file mode 100644 index 0000000..933e842 --- /dev/null +++ b/tests/bug-943953.lisp @@ -0,0 +1,3 @@ +(defun foo (&optional count) + (declare (fixnum count)) + count) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 43e3bee..b434089 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -2382,4 +2382,13 @@ (with-output-to-string (*standard-output*) (many-code-constants))))) +(test-util:with-test (:name :bug-943953) + ;; we sometimes splice compiler structures like clambda in + ;; source, and our error reporting would happily use that + ;; as source forms. + (let* ((src "bug-943953.lisp") + (obj (compile-file-pathname src))) + (unwind-protect (compile-file src) + (ignore-errors (delete-file obj))))) + ;;; success -- 1.7.10.4