From 33aca4a57b2e40e71c9c40da41f2ebb2108736cc Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Sat, 24 Jun 2023 19:07:10 +0200
Subject: [PATCH] cmp: don't output invalid C code if dead code elimination
 fails

---
 src/cmp/cmpbackend-cxx/cmppass2-loc.lsp | 13 ++++++++++---
 src/tests/normal-tests/compiler.lsp     | 23 +++++++++++++++++++++++
 2 files changed, 33 insertions(+), 3 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
index f1d371eec..101ec031c 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
@@ -249,13 +249,20 @@
   (let* ((dest-type (rep-type->lisp-type dest-rep-type))
          (loc-type (loc-type loc))
          (loc-rep-type (loc-representation-type loc)))
-    (labels ((coercion-error ()
+    (labels ((coercion-error (&optional (write-zero t))
                (cmpwarn "Unable to coerce lisp object from type (~S,~S)~%~
                         to C/C++ type (~S,~S)"
-                        loc-type loc-rep-type dest-type dest-rep-type))
+                        loc-type loc-rep-type dest-type dest-rep-type)
+               (when write-zero
+                 ;; It is possible to reach this point due to a bug
+                 ;; but also due to a failure of the dead code
+                 ;; elimination. Write a zero to ensure that the
+                 ;; output is syntactically valid C code and hope for
+                 ;; the latter case.
+                 (wt "0")))
              (ensure-valid-object-type (a-lisp-type)
                (when (subtypep `(AND ,loc-type ,a-lisp-type) NIL)
-                 (coercion-error))))
+                 (coercion-error nil))))
       (when (eq dest-rep-type loc-rep-type)
         (wt loc)
         (return-from wt-coerce-loc))
diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp
index c35b7eaf0..e8b9f4248 100644
--- a/src/tests/normal-tests/compiler.lsp
+++ b/src/tests/normal-tests/compiler.lsp
@@ -2272,3 +2272,26 @@
                           #'(lambda (x) (+ x 2))))
   (signals error (funcall (compile nil (lambda (x) (typep x '(fun-type.0094b integer))))
                           #'(lambda (x) (+ x 2)))))
+
+;;; Date 2023-06-24
+;;; Description
+;;;
+;;;     The compiler produced invalid C code when unable to coerce
+;;;     between incompatible C types. This situation typically
+;;;     indicates a bug but it can also happen because of a failure of
+;;;     the dead code elimination step. In this case we were
+;;;     outputting invalid C code for the dead part and thus the
+;;;     compilation could fail for valid Lisp code.
+;;;
+(test cmp.0095.unreachable-code-unboxed-value
+  (is (eql
+       (funcall (compile nil
+                         (lambda (y)
+                           (declare (optimize (safety 0) (speed 3))
+                                    (fixnum y))
+                           (funcall (lambda (x)
+                                      (cond ((typep x 'fixnum) (1+ x))
+                                            ((characterp x) (char-code x))))
+                                    (the fixnum (1+ y)))))
+                2)
+       4)))