Skip to content

Commit

Permalink
0.8.2.45:
Browse files Browse the repository at this point in the history
	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.
  • Loading branch information
csrhodes committed Aug 19, 2003
1 parent 1f7401c commit c177b77
Show file tree
Hide file tree
Showing 7 changed files with 43 additions and 14 deletions.
5 changes: 5 additions & 0 deletions NEWS
Expand Up @@ -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
Expand All @@ -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
Expand Down
24 changes: 20 additions & 4 deletions src/code/fd-stream.lisp
Expand Up @@ -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))
Expand Down
2 changes: 1 addition & 1 deletion src/code/inspect.lisp
Expand Up @@ -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))
Expand Down
2 changes: 1 addition & 1 deletion src/code/numbers.lisp
Expand Up @@ -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))))
Expand Down
10 changes: 3 additions & 7 deletions tests/arith.pure.lisp
Expand Up @@ -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)))))
Expand All @@ -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)
Expand All @@ -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))
12 changes: 12 additions & 0 deletions tests/stream.impure-cload.lisp
Expand Up @@ -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))
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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"

0 comments on commit c177b77

Please sign in to comment.