From 3d6751d99d2bf224ccbc18e133f23aff72fb708f Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 19 Jul 2007 13:44:58 +0000
Subject: [PATCH] 1.0.7.31: paper over bug inlining known functions in
 high-debug code

 NOT A PROPER FIX!

 * Don't inline known functions unless let-conversion is enabled, which papers
   over the real bug -- apparently due to BIND/UNBIND-SENTINEL vop insertion.
---
 src/compiler/ir1opt.lisp |    6 ++++++
 tests/compiler.pure.lisp |   12 ++++++++++++
 version.lisp-expr        |    2 +-
 3 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index f77ffec..6da6828 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -843,6 +843,12 @@
              (:inline t)
              (:no-chance nil)
              ((nil :maybe-inline) (policy call (zerop space))))
+           ;; FIXME & KLUDGE: This LET-CONVERSION check was added as a
+           ;; half-assed workaround for the bug for which the test
+           ;; case :HIGH-DEBUG-KNOWN-FUNCTION-INLINING checks in
+           ;; compiler.pure.lisp. The _real_ culprit seems to be
+           ;; the insertion of BIND/UNBIND-SENTINEL vops.
+           (policy call (plusp let-conversion))
            (defined-fun-p leaf)
            (defined-fun-inline-expansion leaf)
            (let ((fun (defined-fun-functional leaf)))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index c5997a4..cd96971 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2264,3 +2264,15 @@
           do (let ((arg (random (truncate most-positive-double-float))))
                (assert (eql (funcall fun arg)
                             (funcall op 0.0d0 arg)))))))
+
+(with-test (:name :high-debug-known-function-inlining)
+  (let ((fun (compile nil
+                      '(lambda ()
+                        (declare (optimize (debug 3)) (inline append))
+                        (let ((fun (lambda (body)
+                                     (append
+                                      (first body)
+                                      nil))))
+                          (funcall fun
+                                   '((foo (bar)))))))))
+    (funcall fun)))
diff --git a/version.lisp-expr b/version.lisp-expr
index b6abbe3..142100c 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.7.30"
+"1.0.7.31"
-- 
1.7.10.4