From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 28 Feb 2010 17:52:37 +0000 (+0000)
Subject: 1.0.36.3: FUNCTION-LAMBDA-EXPRESSION and declarations in interpreted functions
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=040fd0ef5d0c759bc8d30952dfad2942bacb20f0;p=sbcl.git

1.0.36.3: FUNCTION-LAMBDA-EXPRESSION and declarations in interpreted functions

 * Don't throw them away, that is.

 Fixes launchpad bug #524707
---

diff --git a/NEWS b/NEWS
index eda1078..4fb76f8 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ changes relative to sbcl-1.0.36:
     stack frame thrown from.
   * bug fix: Fix compiler error involving MAKE-ARRAY and IF forms
     in :INITIAL-CONTENTS. (lp#523612)
+  * bug fix: FUNCTION-LAMBDA-EXPRESSION lost declarations from interpreted
+    functions. (lp#524707)
 
 changes in sbcl-1.0.36 relative to sbcl-1.0.35:
   * new feature: SB-EXT:TYPEXPAND-1, SB-EXT:TYPEXPAND, and
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 156f364..371f5e3 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -2739,6 +2739,7 @@ structure representations"
                "INTERPRETED-FUNCTION-DEBUG-NAME"
                "INTERPRETED-FUNCTION-LAMBDA-LIST"
                "INTERPRETED-FUNCTION-DEBUG-LAMBDA-LIST"
+               "INTERPRETED-FUNCTION-DECLARATIONS"
                "INTERPRETED-FUNCTION-DOCUMENTATION"
                "INTERPRETED-FUNCTION-BODY"
                "INTERPRETED-FUNCTION-SOURCE-LOCATION"
diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp
index 1352638..365bfaa 100644
--- a/src/code/target-misc.lisp
+++ b/src/code/target-misc.lisp
@@ -36,8 +36,11 @@
     (sb!eval:interpreted-function
      (let ((name (sb!eval:interpreted-function-name fun))
            (lambda-list (sb!eval:interpreted-function-lambda-list fun))
+           (declarations (sb!eval:interpreted-function-declarations fun))
            (body (sb!eval:interpreted-function-body fun)))
-       (values `(lambda ,lambda-list ,@body)
+       (values `(lambda ,lambda-list
+                  ,@(when declarations `((declare ,@declarations)))
+                  ,@body)
                t name)))
     (function
      (let* ((fun (%simple-fun-self (%fun-fun fun)))
diff --git a/tests/eval.impure.lisp b/tests/eval.impure.lisp
index c79066a..bf9d484 100644
--- a/tests/eval.impure.lisp
+++ b/tests/eval.impure.lisp
@@ -249,4 +249,10 @@
               (simple-type-error () 'error)))
       t)))
 
+(with-test (:name :bug-524707)
+  (let ((*evaluator-mode* :interpret)
+        (lambda-form '(lambda (x) (declare (fixnum x)) (1+ x))))
+    (let ((fun (eval lambda-form)))
+      (assert (equal lambda-form (function-lambda-expression fun))))))
+
 ;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index e1b552b..5a331b3 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.36.2"
+"1.0.36.3"