From 30b24d582dd8620b91c798e38a8aa9a6b999b4be Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 1 Dec 2008 15:25:36 +0000
Subject: [PATCH] 1.0.23.1: declaring the type of a bound variable gives
 :DECLARED as LEAF-WHERE-FROM

 * Makes SB-CLTL2 do the right thing with local declarations. Reported
   by Larry D'Anna.
---
 NEWS                        |  3 +++
 contrib/sb-cltl2/tests.lisp | 20 ++++++++++++++++++++
 src/compiler/ir1tran.lisp   |  4 +++-
 version.lisp-expr           |  2 +-
 4 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/NEWS b/NEWS
index 8d2819874..598227b55 100644
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,7 @@
 ;;;; -*- coding: utf-8; -*-
+  * bug fix: lexical type declarations are now correctly reported by
+    SB-CLTL2. (reported by Larry D'Anna)
+
 changes in sbcl-1.0.23 relative to 1.0.22:
   * enhancement: when disassembling method functions, disassembly
     for the associated fast function is also produced.
diff --git a/contrib/sb-cltl2/tests.lisp b/contrib/sb-cltl2/tests.lisp
index 137b05599..07882601b 100644
--- a/contrib/sb-cltl2/tests.lisp
+++ b/contrib/sb-cltl2/tests.lisp
@@ -168,6 +168,26 @@
       (var-info x))
   (:lexical t nil))
 
+(deftest variable-info.lexical.type
+    (let ((x 42))
+      (declare (fixnum x))
+      (var-info x))
+  (:lexical t ((type . fixnum))))
+
+(deftest variable-info.lexical.type.2
+    (let ((x 42))
+      (prog1
+          (var-info x)
+        (locally (declare (fixnum x))
+          (assert (plusp x)))))
+  (:lexical t nil))
+
+(deftest variable-info.lexical.type.2
+    (let ((x 42))
+      (locally (declare (fixnum x))
+        (var-info x)))
+  (:lexical t ((type . fixnum))))
+
 (deftest variable-info.ignore
     (let ((x 8))
       (declare (ignore x))
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index d09ddcef5..e674c9d61 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -1146,7 +1146,9 @@
                                  (type-specifier old-type)
                                  (type-specifier type)
                                  var-name))))
-                            (bound-var (setf (leaf-type bound-var) int))
+                            (bound-var
+                             (setf (leaf-type bound-var) int
+                                   (leaf-where-from bound-var) :declared))
                             (t
                              (restr (cons var int)))))))
                (process-var var bound-var)
diff --git a/version.lisp-expr b/version.lisp-expr
index 0e4870c35..08cc696bf 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.23"
+"1.0.23.1"
-- 
2.11.4.GIT