Don't AVER when merging top-level lambdas which do not return.

In MERGE-TOPLEVEL-LAMBDAS, check that the result receiver is not
deleted before merging. And stop doing anything if it's passed only one lambda.

Fixes lp#1308328.

NEWS

@@ -12,6 +12,7 @@ changes relative to sbcl-1.2.7:
     are safe regardless of lexical policy.
   * bug fix: CLOS methods compiled with (OPTIMIZE (DEBUG 0))
     no longer cause debugger failure when printing a backtrace
+  * bug fix: more resilience to deleted code. (lp#1308328, lp#1390544)
 
 changes in sbcl-1.2.7 relative to sbcl-1.2.6:
   * optimization: returning constant values refers to preboxed constants

src/compiler/dfo.lisp

@@ -503,20 +503,27 @@
   (let* ((result-lambda (first lambdas))
          (result-return (lambda-return result-lambda)))
     (cond
-     (result-return
+      ((null (rest lambdas)))
+      ((and result-return
+            ;; KLUDGE: why is the node deleted but clambda still has a return?
+            ;; see a test-case for this in tests/merge-lambdas.lisp
+            ;; But now it can only be exercised with block
+            ;; compilation, which doesn't seem to work anyway.
+            (not (node-to-be-deleted-p
+                  (ctran-use (node-prev
+                              (lvar-uses (return-result result-return)))))))
+       ;; Make sure the result's return node starts a block so that we
+       ;; can splice code in before it.
+       (let ((prev (node-prev
+                    (lvar-uses (return-result result-return)))))
+         (when (ctran-use prev)
+           (node-ends-block (ctran-use prev))))
 
-      ;; Make sure the result's return node starts a block so that we
-      ;; can splice code in before it.
-      (let ((prev (node-prev
-                   (lvar-uses (return-result result-return)))))
-        (when (ctran-use prev)
-          (node-ends-block (ctran-use prev))))
-
-      (dolist (lambda (rest lambdas))
-        (merge-1-toplevel-lambda result-lambda lambda)))
-     (t
-      (dolist (lambda (rest lambdas))
-        (setf (functional-entry-fun lambda) nil)
-        (delete-component (lambda-component lambda)))))
+       (dolist (lambda (rest lambdas))
+         (merge-1-toplevel-lambda result-lambda lambda)))
+      (t
+       (dolist (lambda (rest lambdas))
+         (setf (functional-entry-fun lambda) nil)
+         (delete-component (lambda-component lambda)))))
 
     (values (lambda-component result-lambda) result-lambda)))

tests/compiler.impure.lisp

@@ -2580,4 +2580,11 @@
       ;; macro-policy is rebound inside compile-file
       (assert (= baseline-again baseline)))))
 
+(in-package :cl-user)
+
+(with-test (:name :merge-lambdas-dead-return)
+  (let ((fasl (compile-file "merge-lambdas.lisp"
+                            :print nil :verbose nil)))
+    (ignore-errors (delete-file fasl))))
+
 ;;; success

tests/merge-lambdas.lisp

@@ -0,0 +1,3 @@
+(labels ((a (x)))
+  (error 'program-error)
+  (a (catch 'c)))