0.7.13.24:

        * [N]REVERSE and NRECONC check properness of list arguments;
        * [P]SXHASH always consider NIL to be a symbol.

diff --git a/BUGS b/BUGS
index e1a60e3..4e6b5db 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1169,17 +1169,6 @@ WORKAROUND:
 229:
   (subtypep 'function '(function)) => nil, t.
 
 229:
   (subtypep 'function '(function)) => nil, t.
 

-231: "SETQ does not correctly check the type of a variable being set"
-  b.
-    (defun foo (x z)
-      (declare (type integer x))
-      (locally (declare (type (real 1) x))
-        (setq x z))
-      (list x z))
-    (foo 0 0) => (0 0).
-
-  (fixed in 0.7.12.8)
-

 233: bugs in constraint propagation
   a.
   (defun foo (x)
 233: bugs in constraint propagation
   a.
   (defun foo (x)

diff --git a/NEWS b/NEWS
index 64d2257..fc6bd66 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1593,11 +1593,14 @@ changes in sbcl-0.7.14 relative to sbcl-0.7.13:
        types got intertwined, has been fixed;
     ** the type system is now able to reason about the interaction
        between INTEGER and RATIO types more completely;
        types got intertwined, has been fixed;
     ** the type system is now able to reason about the interaction
        between INTEGER and RATIO types more completely;

-    ** APPEND checks its arguments for being proper lists;
+    ** APPEND, [N]REVERSE and NRECONC check that those their
+       arguments, which must be proper lists, are really so;

     ** An array specialized to be unable to hold elements has been
        implemented (as required -- yes, really) by ANSI;
     ** GETF and GET-PROPERTIES throw a TYPE-ERROR, not a SIMPLE-ERROR,
        on malformed property lists;
     ** An array specialized to be unable to hold elements has been
        implemented (as required -- yes, really) by ANSI;
     ** GETF and GET-PROPERTIES throw a TYPE-ERROR, not a SIMPLE-ERROR,
        on malformed property lists;

+  * fixed SXHASH, giving different results for NIL depending on type
+    declarations (SYMBOL or LIST). (thanks to Gerd Moellmann)

 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp
index 8736dc9..06c77da 100644 (file)
--- a/src/code/early-fasl.lisp
+++ b/src/code/early-fasl.lisp
@@ -42,7 +42,7 @@
 ;;; versions which break binary compatibility. But it certainly should
 ;;; be incremented for release versions which break binary
 ;;; compatibility.
 ;;; versions which break binary compatibility. But it certainly should
 ;;; be incremented for release versions which break binary
 ;;; compatibility.

-(def!constant +fasl-file-version+ 39)
+(def!constant +fasl-file-version+ 40)

 ;;; (record of versions before 0.7.0 deleted in 0.7.1.41)
 ;;; 23 = sbcl-0.7.0.1 deleted no-longer-used EVAL-STACK stuff,
 ;;;      causing changes in *STATIC-SYMBOLS*.
 ;;; (record of versions before 0.7.0 deleted in 0.7.1.41)
 ;;; 23 = sbcl-0.7.0.1 deleted no-longer-used EVAL-STACK stuff,
 ;;;      causing changes in *STATIC-SYMBOLS*.

@@ -78,6 +78,7 @@
 ;;; 38: (2003-01-05) changed names of internal SORT machinery
 ;;; 39: (2003-02-20) in 0.7.12.1 a slot was added to
 ;;;     DEFSTRUCT-SLOT-DESCRIPTION
 ;;; 38: (2003-01-05) changed names of internal SORT machinery
 ;;; 39: (2003-02-20) in 0.7.12.1 a slot was added to
 ;;;     DEFSTRUCT-SLOT-DESCRIPTION

+;;; 40: (2003-03-11) changed value of (SXHASH NIL)

 
 ;;; the conventional file extension for our fasl files
 (declaim (type simple-string *fasl-file-type*))
 
 ;;; the conventional file extension for our fasl files
 (declaim (type simple-string *fasl-file-type*))

diff --git a/src/code/list.lisp b/src/code/list.lisp
index 8bc2a88..762561c 100644 (file)
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -394,7 +394,7 @@
 (defun nreconc (x y)
   #!+sb-doc
   "Return (NCONC (NREVERSE X) Y)."
 (defun nreconc (x y)
   #!+sb-doc
   "Return (NCONC (NREVERSE X) Y)."

-  (do ((1st (cdr x) (if (atom 1st) 1st (cdr 1st)))
+  (do ((1st (cdr x) (if (endp 1st) 1st (cdr 1st)))

        (2nd x 1st)              ;2nd follows first down the list.
        (3rd y 2nd))             ;3rd follows 2nd down the list.
       ((atom 2nd) 3rd)
        (2nd x 1st)              ;2nd follows first down the list.
        (3rd y 2nd))             ;3rd follows 2nd down the list.
       ((atom 2nd) 3rd)

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index a2c9d66..429d674 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -579,7 +579,7 @@
 
 (sb!xc:defmacro list-reverse-macro (sequence)
   `(do ((new-list ()))
 
 (sb!xc:defmacro list-reverse-macro (sequence)
   `(do ((new-list ()))

-       ((atom ,sequence) new-list)
+       ((endp ,sequence) new-list)

      (push (pop ,sequence) new-list)))
 
 ) ; EVAL-WHEN
      (push (pop ,sequence) new-list)))
 
 ) ; EVAL-WHEN

@@ -615,7 +615,7 @@
                (aref ,sequence right-index)))))
 
 (sb!xc:defmacro list-nreverse-macro (list)
                (aref ,sequence right-index)))))
 
 (sb!xc:defmacro list-nreverse-macro (list)

-  `(do ((1st (cdr ,list) (if (atom 1st) 1st (cdr 1st)))
+  `(do ((1st (cdr ,list) (if (endp 1st) 1st (cdr 1st)))

        (2nd ,list 1st)
        (3rd '() 2nd))
        ((atom 2nd) 3rd)
        (2nd ,list 1st)
        (3rd '() 2nd))
        ((atom 2nd) 3rd)

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 5e7b3d9..890dfed 100644 (file)
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -135,7 +135,7 @@
           (sxhash-recurse (x &optional (depthoid +max-hash-depthoid+))
             (declare (type index depthoid))
             (typecase x
           (sxhash-recurse (x &optional (depthoid +max-hash-depthoid+))
             (declare (type index depthoid))
             (typecase x

-              (list
+              (cons

                (if (plusp depthoid)
                    (mix (sxhash-recurse (car x) (1- depthoid))
                         (sxhash-recurse (cdr x) (1- depthoid)))
                (if (plusp depthoid)
                    (mix (sxhash-recurse (car x) (1- depthoid))
                         (sxhash-recurse (cdr x) (1- depthoid)))

@@ -187,7 +187,7 @@
     (array (array-psxhash key depthoid))
     (hash-table (hash-table-psxhash key))
     (structure-object (structure-object-psxhash key depthoid))
     (array (array-psxhash key depthoid))
     (hash-table (hash-table-psxhash key))
     (structure-object (structure-object-psxhash key depthoid))

-    (list (list-psxhash key depthoid))
+    (cons (list-psxhash key depthoid))

     (number (number-psxhash key))
     (character (sxhash (char-upcase key)))
     (t (sxhash key))))
     (number (number-psxhash key))
     (character (sxhash (char-upcase key)))
     (t (sxhash key))))

diff --git a/tests/hash.impure.lisp b/tests/hash.impure.lisp
index 5a461ab..8b3636c 100644 (file)
--- a/tests/hash.impure.lisp
+++ b/tests/hash.impure.lisp
@@ -223,5 +223,17 @@
       (assert (eql (gethash key read-ht)
                   (gethash key original-ht))))))
 
       (assert (eql (gethash key read-ht)
                   (gethash key original-ht))))))
 

+;;; NIL is both SYMBOL and LIST
+(dolist (fun '(sxhash sb-impl::psxhash))
+  (assert (= (funcall fun nil)
+             (funcall (compile nil `(lambda (x)
+                                      (declare (symbol x))
+                                      (,fun x)))
+                      nil)
+             (funcall (compile nil `(lambda (x)
+                                      (declare (list x))
+                                      (,fun x)))
+                      nil))))
+

 ;;; success
 (quit :unix-status 104)
 ;;; success
 (quit :unix-status 104)

diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp
index cb93d28..c450c9f 100644 (file)
--- a/tests/list.pure.lisp
+++ b/tests/list.pure.lisp
@@ -101,10 +101,10 @@
                                         args))))
             (check-error (funcall (compile nil `(lambda () ,exp))) fail)))))
 
                                         args))))
             (check-error (funcall (compile nil `(lambda () ,exp))) fail)))))
 

-(dolist (test '((1 2)
-                ((1 2) nil (3 . 4) nil)
-                (nil (1 2) nil (3 . 4) nil)))
-  (multiple-value-bind (result error)
-      (ignore-errors (apply 'append test))
-    (assert (null result))
-    (assert (typep error 'type-error))))
+(dolist (test '((append 1 2)
+                (append (1 2) nil (3 . 4) nil)
+                (append nil (1 2) nil (3 . 4) nil)
+                (reverse (1 2 . 3))
+                (nreverse (1 2 . 3))
+                (nreconc (1 2 . 3) (4 5))))
+  (assert (raises-error? (apply (first test) (copy-tree (rest test))) type-error)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 584b86f..667dfce 100644 (file)
--- 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".)
 
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 

-"0.7.13.23"
+"0.7.13.24"