From: Christophe Rhodes Date: Tue, 19 Aug 2003 15:42:39 +0000 (+0000) Subject: 0.8.2.45: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c177b7710a9a8668f3bf8567726370b7dbb41726;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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"