From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 11 Jan 2009 16:34:00 +0000 (+0000)
Subject: 1.0.24.33: fix bug 316075
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=06a3d298cb7b8220ef04a50805c01ac1be34d845;p=sbcl.git

1.0.24.33: fix bug 316075

 https://bugs.launchpad.net/sbcl/+bug/316075

 * In DEFINE-ALIEN-ROUTINE, if the return-type is VOID, don't return
   the result of ALIEN-FUNCALL but a literal NIL instead.
---

diff --git a/NEWS b/NEWS
index a9379b9..286d928 100644
--- a/NEWS
+++ b/NEWS
@@ -17,6 +17,8 @@ changes in sbcl-1.0.25 relative to 1.0.24:
     by Tobias Rittweiler, patch by Paul Khuong)
   * bug fix: setting alien structure fields of type struct by value now
     computes the right offset for the memory copy.
+  * bug fix: compilation problem involving inlined calls to aliens with
+    result type VOID. (reported by Ken Olum)
 
 changes in sbcl-1.0.24 relative to 1.0.23:
   * new feature: ARRAY-STORAGE-VECTOR provides access to the underlying data
diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index fec2359..1478207 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -723,25 +723,11 @@ allocated using ``malloc'', so it can be passed to foreign functions which use
             ((,lisp-name (function ,result-type ,@(arg-types))
                          :extern ,alien-name)
              ,@(alien-vars))
-             #-nil
-             (values (alien-funcall ,lisp-name ,@(alien-args))
-                     ,@(results))
-             #+nil
-             (if (alien-values-type-p result-type)
-                 ;; FIXME: RESULT-TYPE is a type specifier, so it
-                 ;; cannot be of type ALIEN-VALUES-TYPE. Also note,
-                 ;; that if RESULT-TYPE is VOID, then this code
-                 ;; disagrees with the computation of the return type
-                 ;; and with all usages of this macro. -- APD,
-                 ;; 2002-03-02
-                 (let ((temps (make-gensym-list
-                               (length
-                                (alien-values-type-values result-type)))))
-                   `(multiple-value-bind ,temps
-                        (alien-funcall ,lisp-name ,@(alien-args))
-                      (values ,@temps ,@(results))))
-                 (values (alien-funcall ,lisp-name ,@(alien-args))
-                         ,@(results)))))))))
+             ,@(if (eq 'void result-type)
+                   `((alien-funcall ,lisp-name ,@(alien-args))
+                     (values nil ,@(results)))
+                   `((values (alien-funcall ,lisp-name ,@(alien-args))
+                             ,@(results))))))))))
 
 (defun alien-typep (object type)
   #!+sb-doc
diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index 5029774..aa14cf2 100644
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -245,4 +245,11 @@
           (with-alien ((myin int (slot myst 'myint)))
             (assert (integerp myin))))))
 
+;;; void conflicted with derived type
+(declaim (inline bug-316075))
+(sb-alien:define-alien-routine bug-316075 void (result char :out))
+(with-test (:name bug-316075)
+  (handler-bind ((warning #'error))
+    (compile nil '(lambda () (multiple-value-list (bug-316075))))))
+
 ;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 5c7d1bf..63330b3 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.24.32"
+"1.0.24.33"