From: William Harold Newman <william.newman@airmail.net>
Date: Wed, 7 Feb 2001 22:11:47 +0000 (+0000)
Subject: 0.6.10.12:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=39e38e4c91fdfc368c60220a1b38ffefb86ff403;p=sbcl.git

0.6.10.12:
	defined OBJECT-NOT-COMPLEX-VECTOR-ERROR
	merged MNA patch for #'APPLY error-reporting
	added MNA regression test for bug #39
---

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 94610cb..64fcebc 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1019,6 +1019,11 @@ is a good idea, but see SB-SYS for blurring of boundaries."
              "OBJECT-NOT-COMPLEX-LONG-FLOAT-ERROR"
              "OBJECT-NOT-COMPLEX-DOUBLE-FLOAT-ERROR"
              "OBJECT-NOT-COMPLEX-RATIONAL-ERROR"
+             ;; FIXME: It's confusing using "complex" to mean
+             ;; both "not on the real number line" and "not of
+             ;; a SIMPLE-ARRAY nature". Perhaps we could rename
+             ;; all the uses in the second sense as "hairy" instead?
+             "OBJECT-NOT-COMPLEX-VECTOR-ERROR"
              "OBJECT-NOT-CONS-ERROR"
              "OBJECT-NOT-DOUBLE-FLOAT-ERROR" "OBJECT-NOT-FIXNUM-ERROR"
              "OBJECT-NOT-FLOAT-ERROR" "OBJECT-NOT-FUNCTION-ERROR"
diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 16a07f3..5b9c9a4 100644
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -225,9 +225,12 @@
 	 :format-arguments (list nargs)))
 
 (deferr bogus-argument-to-values-list-error (list)
-  (error 'type-error
+  (error 'simple-type-error
 	 :function-name name
-	 :format-control "attempt to use VALUES-LIST on a dotted-list:~%  ~S"
+	 :datum list
+	 :expected-type 'list
+	 :format-control
+	 "~@<attempt to use VALUES-LIST on a dotted list: ~2I~_~S~:>"
 	 :format-arguments (list list)))
 
 (deferr unbound-symbol-error (symbol)
@@ -448,6 +451,12 @@
 	 :function-name name
 	 :datum object
 	 :expected-type 'instance))
+
+(deferr object-not-complex-vector-error (object)
+  (error 'type-error
+	 :function-name name
+	 :datum object
+	 :expected-type '(and vector (not simple-array))))
 
 ;;;; fetching errorful function name
 
diff --git a/src/compiler/generic/interr.lisp b/src/compiler/generic/interr.lisp
index 0ce2339..be98183 100644
--- a/src/compiler/generic/interr.lisp
+++ b/src/compiler/generic/interr.lisp
@@ -179,4 +179,6 @@
   (nil-function-returned
    "A function with declared result type NIL returned.")
   (layout-invalid
-   "invalid layout (indicates obsolete instance)"))
+   "invalid layout (indicates obsolete instance)")
+  (object-not-complex-vector
+   "Object is not a complex (non-SIMPLE-ARRAY) vector."))
diff --git a/tests/float.impure.lisp b/tests/float.impure.lisp
new file mode 100644
index 0000000..36fdd6f
--- /dev/null
+++ b/tests/float.impure.lisp
@@ -0,0 +1,58 @@
+;;;; This file is for floating-point-related tests which have side
+;;;; effects (e.g. executing DEFUN).
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;; 
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(cl:in-package :cl-user)
+
+;;; Hannu Rummukainen reported a CMU CL bug on cmucl-imp@cons.org 26
+;;; Jun 2000. This is the test case for it.
+;;;
+;;; The bug was listed as "39: .. Probably the same bug exists in
+;;; SBCL" for a while until Martin Atzmueller showed that it's not
+;;; present after all, presumably because the bug was introduced into
+;;; CMU CL after the fork. But we'll test for it anyway, in case
+;;; e.g. someone inadvertently ports the bad code.
+(defun point39 (x y)
+  (make-array 2
+	      :element-type 'double-float
+              :initial-contents (list x y)))
+
+(declaim (inline point39-x point39-y))
+(defun point39-x (p)
+  (declare (type (simple-array double-float (2)) p))
+  (aref p 0))
+(defun point39-y (p)
+  (declare (type (simple-array double-float (2)) p))
+  (aref p 1))
+(defun order39 (points)
+  (sort points  #'(lambda (p1 p2)
+                    (let* ((y1 (point39-y p1))
+                           (y2 (point39-y p2)))
+                      (if (= y1 y2)
+                          (< (point39-x p1)
+                             (point39-x p2))
+                          (< y1 y2))))))
+(defun test39 ()
+  (order39 (make-array 4
+		       :initial-contents (list (point39 0.0d0 0.0d0)
+					       (point39 1.0d0 1.0d0)
+					       (point39 2.0d0 2.0d0)
+					       (point39 3.0d0 3.0d0)))))
+(assert (equalp (test39)
+		#(#(0.0d0 0.0d0)
+		  #(1.0d0 1.0d0)
+		  #(2.0d0 2.0d0)
+		  #(3.0d0 3.0d0))))
+
+;;; success
+(quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index 102d205..105efcb 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -15,4 +15,4 @@
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
-"0.6.10.11"
+"0.6.10.12"