From 60053af56e69de2fd251cde8fcdb2ea7f01d0b01 Mon Sep 17 00:00:00 2001
From: Alexey Dejneka <adejneka@comail.ru>
Date: Sun, 13 Apr 2008 03:48:18 +0000
Subject: [PATCH] 1.0.16.1: fix heap-allocated alien variable reference

---
 NEWS                        |    4 ++++
 doc/manual/ffi.texinfo      |    2 +-
 src/compiler/aliencomp.lisp |    3 ++-
 tests/foreign.test.sh       |   23 +++++++++++++++++++++++
 version.lisp-expr           |    2 +-
 5 files changed, 31 insertions(+), 3 deletions(-)

diff --git a/NEWS b/NEWS
index 28b6c4f..dd9f3e8 100644
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,8 @@
 ;;;; -*- coding: utf-8; -*-
+changes in sbcl-1.0.17 relative to 1.0.16:
+  * bug fix: invalid optimization of heap-allocated alien variable
+    reference.
+
 changes in sbcl-1.0.16 relative to 1.0.15:
   * minor incompatible change: revert the changes to sb-posix's error
     signaling added in 1.0.14.
diff --git a/doc/manual/ffi.texinfo b/doc/manual/ffi.texinfo
index b4fc8ca..0c97c3c 100644
--- a/doc/manual/ffi.texinfo
+++ b/doc/manual/ffi.texinfo
@@ -467,7 +467,7 @@ area pointer) to a foreign value with the specified
 The @var{type} must be some foreign pointer, array, or record type.
 @end defun
 
-@defun sb-alien:alien-sap @var{foreign-value} @var{type}
+@defun sb-alien:alien-sap @var{foreign-value}
 @findex alien-sap
 
 The @code{sb-alien:alien-sap} function returns the @acronym{SAP} which
diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp
index efdf628..bc5b11a 100644
--- a/src/compiler/aliencomp.lisp
+++ b/src/compiler/aliencomp.lisp
@@ -332,7 +332,8 @@
 (deftransform %heap-alien-addr ((info) * * :important t)
   (multiple-value-bind (sap type) (heap-alien-sap-and-type info)
     (/noshow "in DEFTRANSFORM %HEAP-ALIEN-ADDR, creating %SAP-ALIEN")
-    `(%sap-alien ,sap ',type)))
+    `(%sap-alien ,sap ',(make-alien-pointer-type :to type))))
+
 
 ;;;; support for local (stack or register) aliens
 
diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh
index 034deef..6e76133 100644
--- a/tests/foreign.test.sh
+++ b/tests/foreign.test.sh
@@ -311,5 +311,28 @@ run_sbcl_with_core $TEST_FILESTEM.fast.core --no-sysinit --no-userinit <<EOF
 EOF
 check_status_maybe_lose "missing-so" $?
 
+# ADDR of a heap-allocated object
+cat > $TEST_FILESTEM.addr.heap.c <<EOF
+  struct foo
+  {
+    int x, y;
+  } a, *b;
+EOF
+
+build_so $TEST_FILESTEM.addr.heap
+
+run_sbcl <<EOF
+  (load-shared-object "$TEST_FILESTEM.addr.heap.so")
+  (define-alien-type foo (struct foo (x int) (y int)))
+
+  (define-alien-variable a foo)
+  (define-alien-variable b (* foo))
+  (funcall (compile nil '(lambda () (setq b (addr a)))))
+  (assert (sb-sys:sap= (alien-sap a) (alien-sap (deref b))))
+  (quit :unix-status $EXIT_LISP_WIN)
+EOF
+check_status_maybe_lose "ADDR of a heap-allocated object" $?
+
+
 # success convention for script
 exit $EXIT_TEST_WIN
diff --git a/version.lisp-expr b/version.lisp-expr
index 07f6f0c..4779f81 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.16"
+"1.0.16.1"
-- 
1.7.10.4