From 32b583294171354d1157531e9f7a00f2bf87a831 Mon Sep 17 00:00:00 2001
From: Douglas Katzman <dougk@google.com>
Date: Sat, 2 Apr 2016 10:47:35 -0400
Subject: [PATCH] Enforce absence of warnings in self-hosted make-host-1

---
 make-host-1.lisp                 | 20 ++++++++++++++++----
 src/compiler/info-functions.lisp |  1 +
 2 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/make-host-1.lisp b/make-host-1.lisp
index 5e35f0b74..bbcb4f5f2 100644
--- a/make-host-1.lisp
+++ b/make-host-1.lisp
@@ -27,7 +27,7 @@
     ;; UNDEFINED-VARIABLE does not cause COMPILE-FILE to return warnings-p
     ;; unless outside a compilation unit. You find out about it only upon
     ;; exit of SUMMARIZE-COMPILATION-UNIT. So we set up a handler for that.
-    `(let (fail)
+    `(let (in-summary fail)
        (handler-bind (((and simple-warning (not style-warning))
                        (lambda (c)
                          ;; hack for PPC. See 'build-order.lisp-expr'
@@ -36,10 +36,22 @@
                                              (simple-condition-format-control c))
                                      (search "ignoring FAILURE-P return"
                                              (simple-condition-format-control c)))
-                           (setq fail t)))))
-         (with-compilation-unit () ,@forms))
+                           (setq fail 'warning))))
+                      ;; Prevent regressions on a couple platforms
+                      ;; that are known to build cleanly.
+                      #!+(or x86 x86-64)
+                      (sb-int:simple-style-warning
+                       (lambda (c)
+                         (when (and in-summary
+                                    (search "undefined"
+                                            (simple-condition-format-control c)))
+                           (unless (eq fail 'warning)
+                             (setq fail 'style-warning))))))
+         (with-compilation-unit ()
+           (multiple-value-prog1 (progn ,@forms) (setq in-summary t))))
        (when fail
-         (error "make-host-1 stopped due to unexpected WARNING.")))
+         (cerror "Proceed anyway"
+                 "make-host-1 stopped due to unexpected ~A." fail)))
 
     #-(or clisp sbcl) `(with-compilation-unit () ,@forms))
 
diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp
index 9e09c400f..b51286286 100644
--- a/src/compiler/info-functions.lisp
+++ b/src/compiler/info-functions.lisp
@@ -300,6 +300,7 @@ return NIL. Can be set with SETF when ENV is NIL."
            (setf (random-documentation name doc-type) string))))
   string)
 
+#-sb-xc-host
 (defun real-function-name (name)
   ;; Resolve the actual name of the function named by NAME
   ;; e.g. (setf (name-function 'x) #'car)
-- 
2.11.4.GIT