diff --git a/code/array.lisp b/code/array.lisp index 65a7d4b2af7c178dd9a0b47f1e4ac367c3901669..d325ce356f2cb2b6dc374ed1d8cc3a898d406572 100644 --- a/code/array.lisp +++ b/code/array.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.42 2007/01/13 01:16:30 fgilham Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.43 2007/06/20 17:33:08 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -240,8 +240,14 @@ (when (or initial-element-p initial-contents-p) (error "Neither :initial-element nor :initial-contents ~ can be specified along with :displaced-to")) - (unless (subtypep element-type - (array-element-type displaced-to)) + ;; The CLHS entry for MAKE-ARRAY says that if the + ;; actual array element types are not type equivalent + ;; (subtypes of each other), the consequences are + ;; undefined. Let's signal an error here. + (unless (and (subtypep (upgraded-array-element-type element-type) + (array-element-type displaced-to)) + (subtypep (array-element-type displaced-to) + (upgraded-array-element-type element-type))) (error "One can't displace an array of type ~S into ~ another of type ~S." element-type (array-element-type displaced-to)))