0.8.2.45:

	Fix READ-SEQUENCE bug (DB sbcl-devel 2003-08-19, Gerd Moellman
	cmucl-imp)
	... and add a test;
	Fix CEILING bug (PFD sbcl-devel 2003-08-19)
	... add a test, and uncomment a bunch of now-working tests
	One more format string badness fix.

diff --git a/NEWS b/NEWS
index 3c50624..a413eaf 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1968,6 +1968,9 @@ changes in sbcl-0.8.3 relative to sbcl-0.8.2:
   * x86 bug fix in control stack exhaustion checking: now shows backtrace
   * bug fix in WITH-TIMEOUT: now the body can have more than one form.
     (thanks to Stig Sandoe)
+  * bug fix in READ-SEQUENCE: READ-SEQUENCE following PEEK-CHAR or
+    UNREAD-CHAR now correctly includes the unread character in the
+    target sequence.  (thanks to Gerd Moellmann)
   * new optimization: inside a named function any reference to a
     function with the same name is considered to be a self-reference;
     this behaviour is controlled with SB-C::RECOGNIZE-SELF-CALLS
@@ -1981,6 +1984,8 @@ changes in sbcl-0.8.3 relative to sbcl-0.8.2:
        types form a lattice under type intersection.
     ** FFLOOR, FTRUNCATE, FCEILING and FROUND work with integers.
     ** ASSOC now ignores NIL elements in an alist.
+    ** CEILING now gives the right answer with MOST-NEGATIVE-FIXNUM
+       and (1+ MOST-POSITIVE-FIXNUM) answers.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 95b7ce2..cc71851 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -591,12 +591,28 @@
 ;;; Note that this blocks in UNIX-READ. It is generally used where
 ;;; there is a definite amount of reading to be done, so blocking
 ;;; isn't too problematical.
-(defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p)
+(defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p
+                              &aux (total-copied 0))
   (declare (type file-stream stream))
-  (declare (type index start requested))
-  (do ((total-copied 0))
+  (declare (type index start requested total-copied))
+  (let ((unread (fd-stream-unread stream)))
+    (when unread
+      ;; AVERs designed to fail when we have more complicated
+      ;; character representations.
+      (aver (typep unread 'base-char))
+      (aver (= (fd-stream-element-size stream) 1))
+      ;; KLUDGE: this is a slightly-unrolled-and-inlined version of
+      ;; %BYTE-BLT
+      (etypecase buffer
+       (system-area-pointer
+        (setf (sap-ref-8 buffer start) (char-code unread)))
+       ((simple-unboxed-array (*))
+        (setf (aref buffer start) unread)))
+      (setf (fd-stream-unread stream) nil)
+      (setf (fd-stream-listen stream) nil)
+      (incf total-copied)))
+  (do ()
       (nil)
-    (declare (type index total-copied))
     (let* ((remaining-request (- requested total-copied))
           (head (fd-stream-ibuf-head stream))
           (tail (fd-stream-ibuf-tail stream))

diff --git a/src/code/inspect.lisp b/src/code/inspect.lisp
index 5625d64..f975aed 100644 (file)
--- a/src/code/inspect.lisp
+++ b/src/code/inspect.lisp
@@ -155,7 +155,7 @@ evaluated expressions.
 (defgeneric inspected-parts (object))
 
 (defmethod inspected-parts ((object symbol))
-  (values (format nil "The object is a SYMBOL.~%" object)
+  (values (format nil "The object is a SYMBOL.~%")
          t
          (list (cons "Name" (symbol-name object))
                (cons "Package" (symbol-package object))

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index ff3e6d5..a62eb9d 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -578,7 +578,7 @@
                          (numerator divisor))))
         (values q (- number (* q divisor)))))
       ((fixnum bignum)
-       (values 0 number))
+       (bignum-truncate (make-small-bignum number) divisor))
       ((ratio (or float rational))
        (let ((q (truncate (numerator number)
                          (* (denominator number) divisor))))

diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index db7cbe5..c2f0ac0 100644 (file)
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -54,12 +54,6 @@
 ;;; 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)
-#||
-
-FIXME: These tests would be good to have. But although, in
-sbcl-0.7.7.2x, (NULL (IGNORE-ERRORS (MIN 1 #(1 2 3)))) returns T, the
-ASSERTion fails, probably in something related to bug #194.
-
 (assert (null (ignore-errors (min '(1 2 3)))))
 (assert (= (min -1) -1))
 (assert (null (ignore-errors (min 1 #(1 2 3)))))
@@ -72,7 +66,6 @@ ASSERTion fails, probably in something related to bug #194.
 (assert (= (max -1 10.0) 10.0))
 (assert (null (ignore-errors (max 3 #'max))))
 (assert (= (max -3 0) 0))
-||#
 
 ;;; (CEILING x 2^k) was optimized incorrectly
 (loop for divisor in '(-4 4)
@@ -87,3 +80,6 @@ ASSERTion fails, probably in something related to bug #194.
               (assert (= (+ (* q divisor) r) i))
               (assert (<= exact-q q))
               (assert (< q (1+ exact-q))))))
+
+;; CEILING had a corner case, spotted by Paul Dietz
+(assert (= (ceiling most-negative-fixnum (1+ most-positive-fixnum)) -1))

diff --git a/tests/stream.impure-cload.lisp b/tests/stream.impure-cload.lisp
index a4443ed..374f466 100644 (file)
--- a/tests/stream.impure-cload.lisp
+++ b/tests/stream.impure-cload.lisp
@@ -60,3 +60,15 @@
            (expect #\z))
          (expect nil))))) ; i.e. end of file
   (delete-file *scratch-file-name*))
+
+(with-open-file (s *scratch-file-name* :direction :output)
+  (format s "1234~%"))
+(assert
+ (string=
+  (with-open-file (s *scratch-file-name* :direction :input)
+    (let* ((b (make-string 10)))
+      (peek-char nil s)
+      (read-sequence b s)
+      b))
+  (format nil "1234")
+  :end1 4))

diff --git a/version.lisp-expr b/version.lisp-expr
index 929fcb5..a650b6b 100644 (file)
--- 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.8.2.44"
+"0.8.2.45"