From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Wed, 18 Dec 2002 16:41:45 +0000 (+0000)
Subject: 0.7.10.22:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8833e4478c33f09e642c8886fc3505348a744299;p=sbcl.git

0.7.10.22:
	Fix obscure DEFSTRUCT :CONC-NAME handling bug, revealed by Paul
		Dietz' ansi-tests
	... :CONC-NAME NIL means something different from :CONC-NAME ""
	Also some belated tests for extra COERCE logic
---

diff --git a/NEWS b/NEWS
index 88626ff..581f452 100644
--- a/NEWS
+++ b/NEWS
@@ -1464,6 +1464,10 @@ changes in sbcl-0.7.11 relative to sbcl-0.7.10:
     ** FILE-STREAM now names the class previously known as FD-STREAM;
     ** in DEFSTRUCT, a bare :CONC-NAME (or a :CONC-NAME with no
        argument) no longer signals an error;
+    ** likewise in DEFSTRUCT, :CONC-NAME NIL now respects the package
+       of the slot symbol, rather than using the current package
+       ((:CONC-NAME "") continues to intern the slot's name in the
+       current package);
   * incremented fasl file version number, because of the incompatible
     change to the DEFSTRUCT-DESCRIPTION structure, and again because
     of the new implementation of DEFINE-COMPILER-MACRO.
diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 8a0eb70..e532791 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -626,7 +626,9 @@
     (setf (dsd-%name slot) (string name))
     (setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list slot)))
 
-    (let ((accessor-name (symbolicate (or (dd-conc-name defstruct) "") name))
+    (let ((accessor-name (if (dd-conc-name defstruct)
+			     (symbolicate (dd-conc-name defstruct) name)
+			     name))
 	  (predicate-name (dd-predicate-name defstruct)))
       (setf (dsd-accessor-name slot) accessor-name)
       (when (eql accessor-name predicate-name)
diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index e2b5e4c..bef097c 100644
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -34,12 +34,8 @@
 ;;; In a bug reported by Wolfhard Buss on cmucl-imp 2002-06-18 (BUG
 ;;; 184), sbcl didn't catch all divisions by zero, notably divisions
 ;;; of bignums and ratios by 0.  Fixed in sbcl-0.7.6.13.
-(macrolet ((test (form) `(multiple-value-bind (val cond)
-			     (ignore-errors ,form)
-			   (assert (null val))
-			   (assert (typep cond 'division-by-zero)))))
-  (test (/ 2/3 0))
-  (test (/ (1+ most-positive-fixnum) 0)))
+(assert (raises-error? (/ 2/3 0) division-by-zero))
+(assert (raises-error? (/ (1+ most-positive-fixnum) 0) division-by-zero))
 
 ;;; In a bug reported by Raymond Toy on cmucl-imp 2002-07-18, (COERCE
 ;;; <RATIONAL> '(COMPLEX FLOAT)) was failing to return a complex
@@ -48,6 +44,13 @@
 (assert (= (coerce 1/2 '(complex float)) #c(0.5 0.0)))
 (assert (= (coerce 1.0d0 '(complex float)) #c(1.0d0 0.0d0)))
 
+;;; COERCE also sometimes failed to verify that a particular coercion
+;;; was possible (in particular coercing rationals to bounded float
+;;; types.
+(assert (raises-error? (coerce 1 '(float 2.0 3.0)) type-error))
+(assert (raises-error? (coerce 1 '(single-float -1.0 0.0)) type-error))
+(assert (eql (coerce 1 '(single-float -1.0 2.0)) 1.0))
+
 ;;; ANSI says MIN and MAX should signal TYPE-ERROR if any argument
 ;;; isn't REAL. SBCL 0.7.7 didn't in the 1-arg case. (reported as a
 ;;; bug in CMU CL on #lisp IRC by lrasinen 2002-09-01)
diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp
index b895b22..0582be5 100644
--- a/tests/defstruct.impure.lisp
+++ b/tests/defstruct.impure.lisp
@@ -420,7 +420,15 @@
 (defstruct (conc-name-syntax :conc-name) a-conc-name-slot)
 (assert (eq (a-conc-name-slot (make-conc-name-syntax :a-conc-name-slot 'y))
 	    'y))
-
+;;; and further :CONC-NAME NIL was being wrongly treated:
+(defpackage "DEFSTRUCT-TEST-SCRATCH")
+(defstruct (conc-name-nil :conc-name)
+  defstruct-test-scratch::conc-name-nil-slot)
+(assert (= (defstruct-test-scratch::conc-name-nil-slot
+	    (make-conc-name-nil :conc-name-nil-slot 1)) 1))
+(assert (raises-error? (conc-name-nil-slot (make-conc-name-nil))
+		       undefined-function))
+
 ;;; success
 (format t "~&/returning success~%")
 (quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index 75ff9c0..05efc29 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.10.21"
+"0.7.10.22"