From: Juho Snellman <jsnell@iki.fi>
Date: Thu, 9 Nov 2006 21:30:20 +0000 (+0000)
Subject: 0.9.18.43:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3a65d1cfc0e4799b9b9bf1467054788870a5f6a5;p=sbcl.git

0.9.18.43:
        Signal an error for attempts to displace an array to an array with
        a different element type (patch by Mario Mommer).

        Also mark a couple of float tests as passing on FreeBSD (patch
        by NIIMI Satoshi).
---

diff --git a/NEWS b/NEWS
index 8d491e7..eaf7403 100644
--- a/NEWS
+++ b/NEWS
@@ -26,6 +26,8 @@ changes in sbcl-0.9.19 (1.0.0?) relative to sbcl-0.9.18:
     for sequences" or "The value 1 is not of type FIXNUM")
   * bug fix: version components are handled correctly in TRANSLATE-PATHNAME
     (reported by Josip Gracin)
+  * bug fix: an error is signaled for attempts to displace arrays with
+    incompatible element types (thanks to Mario Mommer)
   * Improvements to the Windows port:
     ** floating point exceptions are now reported correctly.
     ** stack exhaustion detection works partially.
diff --git a/src/code/array.lisp b/src/code/array.lisp
index 308b762..6d6ae8c 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -149,6 +149,11 @@
     (declare (fixnum array-rank))
     (when (and displaced-index-offset (null displaced-to))
       (error "can't specify :DISPLACED-INDEX-OFFSET without :DISPLACED-TO"))
+    (when (and displaced-to
+               (arrayp displaced-to)
+               (not (equal (array-element-type displaced-to)
+                           (upgraded-array-element-type element-type))))
+      (error "Array element type of :DISPLACED-TO array does not match specified element type"))
     (if (and simple (= array-rank 1))
         ;; it's a (SIMPLE-ARRAY * (*))
         (multiple-value-bind (type n-bits)
diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp
index d06352c..275cb72 100644
--- a/tests/float.pure.lisp
+++ b/tests/float.pure.lisp
@@ -93,7 +93,7 @@
 (assert (= 0.0d0 (scale-float 1.0d0 (1- most-negative-fixnum))))
 
 (with-test (:name (:scale-float-overflow :bug-372)
-            :fails-on '(or :ppc :darwin :freebsd)) ;; bug 372
+            :fails-on '(or :ppc :darwin)) ;; bug 372
   (progn
     (assert (raises-error? (scale-float 1.0 most-positive-fixnum)
                            floating-point-overflow))
@@ -125,7 +125,7 @@
 (funcall (compile nil '(lambda () (tan (tan (round 0))))))
 
 (with-test (:name (:addition-overflow :bug-372)
-            :fails-on '(or :ppc :darwin :mips :freebsd))
+            :fails-on '(or :ppc :darwin :mips))
   (assert (typep (nth-value
                   1
                   (ignore-errors
diff --git a/version.lisp-expr b/version.lisp-expr
index 3550adb..225ea6c 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".)
-"0.9.18.42"
+"0.9.18.43"