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.

diff --git a/NEWS b/NEWS
index 884f06e..688915f 100644 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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