From bff8455d98c50672cdc29abcf1809b8823f5f117 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 7 Aug 2002 12:27:50 +0000 Subject: [PATCH] 0.7.6.13: Various ANSI fixes via Raymond Toy and Wolfhard Buss, variously on cmucl-imp ... (COERCE 1 '(COMPLEX FLOAT)) now returns a complex float ... (PARSE-INTEGER " 12 a") now throws an error of type PARSE-ERROR ... (/ 2/3 0) now throws an error of type DIVISION-BY-ZERO ... LOGAND on the sparc now has more correct VOPs also log the PCL bugs from APD sbcl-devel 2002-08-04 --- BUGS | 37 ++++++++++------ CREDITS | 2 +- package-data-list.lisp-expr | 1 + src/code/coerce.lisp | 8 ++++ src/code/error.lisp | 1 + src/code/numbers.lisp | 10 +++-- src/code/reader.lisp | 94 +++++++++++++++++++++-------------------- src/compiler/sparc/arith.lisp | 6 +-- tests/arith.pure.lisp | 49 +++++++++++++++++++++ tests/compiler.impure.lisp | 16 +++++++ tests/float.pure.lisp | 4 +- tests/reader.pure.lisp | 15 +++++++ version.lisp-expr | 2 +- 13 files changed, 176 insertions(+), 69 deletions(-) create mode 100644 tests/arith.pure.lisp diff --git a/BUGS b/BUGS index 8334a70..be699cd 100644 --- a/BUGS +++ b/BUGS @@ -454,6 +454,8 @@ WORKAROUND: doesn't seem to exist for sequence types: (DEFTYPE BAR () 'SIMPLE-VECTOR) (CONCATENATE 'BAR #(1 2) '(3)) => #(1 2 3) + See also bug #46a./b., and discussion and patch sbcl-devel and + cmucl-imp 2002-07 67: As reported by Winton Davies on a CMU CL mailing list 2000-01-10, @@ -543,14 +545,6 @@ WORKAROUND: (I haven't tried to investigate this bug enough to guess whether there might be any user-level symptoms.) -90: - a latent cross-compilation/bootstrapping bug: The cross-compilation - host's CL:CHAR-CODE-LIMIT is used in target code in readtable.lisp - and possibly elsewhere. Instead, we should use the target system's - CHAR-CODE-LIMIT. This will probably cause problems if we try to - bootstrap on a system which uses a different value of CHAR-CODE-LIMIT - than SBCL does. - 94a: Inconsistencies between derived and declared VALUES return types for DEFUN aren't checked very well. E.g. the logic which successfully @@ -1337,12 +1331,6 @@ WORKAROUND: :ACCRUED-EXCEPTIONS (:INEXACT) :FAST-MODE NIL) -184: "division by zero becomes frozen into RATIO" - (reported by Wolfhard Buss on cmucl-imp 18 Jun 2002, fails on - sbcl-0.7.4.39 too) - * (/ 1 (/ 3 2) 0) - 1/0 - 185: "top-level forms at the REPL" * (locally (defstruct foo (a 0 :type fixnum))) gives an error: @@ -1451,6 +1439,27 @@ WORKAROUND: is a classic symptom of buffer filling and deadlock, but it seems only sporadically reproducible. +191: "Miscellaneous PCL deficiencies" + (reported by Alexey Dejenka sbcl-devel 2002-08-04) + a. DEFCLASS does not inform the compiler about generated + functions. Compiling a file with + (DEFCLASS A-CLASS () + ((A-CLASS-X))) + (DEFUN A-CLASS-X (A) + (WITH-SLOTS (A-CLASS-X) A + A-CLASS-X)) + results in a STYLE-WARNING: + undefined-function + SB-SLOT-ACCESSOR-NAME::|COMMON-LISP-USER A-CLASS-X slot READER| + b. DEFGENERIC does not check lambda list syntax; from the REPL: + * (defgeneric gf ("a" #p"b")) + + # + * + c. the examples in CLHS 7.6.5.1 (regarding generic function lambda + lists and &KEY arguments) do not signal errors when they should. + + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/CREDITS b/CREDITS index d7de58c..fe5c18c 100644 --- a/CREDITS +++ b/CREDITS @@ -627,4 +627,4 @@ RAM Robert MacLachlan WHN William ("Bill") Newman CSR Christophe Rhodes PVE Peter Van Eynde -PW Paul Werkowski \ No newline at end of file +PW Paul Werkowski diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 419f0ef..ad31628 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -686,6 +686,7 @@ retained, possibly temporariliy, because it might be used internally." ;; error-reporting facilities "SIMPLE-CONTROL-ERROR" "SIMPLE-FILE-ERROR" + "SIMPLE-PARSE-ERROR" "SIMPLE-PROGRAM-ERROR" "SIMPLE-STREAM-ERROR" "SIMPLE-STYLE-WARNING" "STYLE-WARN" diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp index 98d0a29..5d0ffa3 100644 --- a/src/code/coerce.lisp +++ b/src/code/coerce.lisp @@ -213,6 +213,14 @@ ((csubtypep type (specifier-type '(complex long-float))) (complex (%long-float (realpart object)) (%long-float (imagpart object)))) + ((and (typep object 'rational) + (csubtypep type (specifier-type '(complex float)))) + ;; Perhaps somewhat surprisingly, ANSI specifies + ;; that (COERCE FOO 'FLOAT) is a SINGLE-FLOAT, not + ;; dispatching on *READ-DEFAULT-FLOAT-FORMAT*. By + ;; analogy, we do the same for complex numbers. -- + ;; CSR, 2002-08-06 + (complex (%single-float object))) ((csubtypep type (specifier-type 'complex)) (complex object)) (t diff --git a/src/code/error.lisp b/src/code/error.lisp index 25ef8e3..8a448f1 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -49,6 +49,7 @@ (define-condition simple-file-error (simple-condition file-error) ()) (define-condition simple-program-error (simple-condition program-error) ()) (define-condition simple-stream-error (simple-condition stream-error) ()) +(define-condition simple-parse-error (simple-condition parse-error) ()) ;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that ;;; compiler warnings can be emitted as appropriate. diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index 9eb5d54..18fe19e 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -194,9 +194,13 @@ (if (minusp den) (values (- num) (- den)) (values num den)) - (if (eql den 1) - num - (%make-ratio num den)))) + (cond + ((eql den 0) + (error 'division-by-zero + :operands (list num den) + :operation 'build-ratio)) + ((eql den 1) num) + (t (%make-ratio num den))))) ;;; Truncate X and Y, but bum the case where Y is 1. #!-sb-fluid (declaim (inline maybe-truncate)) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 2ad7a3b..d85f441 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -1414,51 +1414,55 @@ (default to the beginning and end of the string) It skips over whitespace characters and then tries to parse an integer. The radix parameter must be between 2 and 36." - (with-array-data ((string string) - (start start) - (end (or end (length string)))) - (let ((index (do ((i start (1+ i))) - ((= i end) - (if junk-allowed - (return-from parse-integer (values nil end)) - (error "no non-whitespace characters in number"))) - (declare (fixnum i)) - (unless (whitespacep (char string i)) (return i)))) - (minusp nil) - (found-digit nil) - (result 0)) - (declare (fixnum index)) - (let ((char (char string index))) - (cond ((char= char #\-) - (setq minusp t) - (incf index)) - ((char= char #\+) - (incf index)))) - (loop - (when (= index end) (return nil)) - (let* ((char (char string index)) - (weight (digit-char-p char radix))) - (cond (weight - (setq result (+ weight (* result radix)) - found-digit t)) - (junk-allowed (return nil)) - ((whitespacep char) - (do ((jndex (1+ index) (1+ jndex))) - ((= jndex end)) - (declare (fixnum jndex)) - (unless (whitespacep (char string jndex)) - (error "junk in string ~S" string))) - (return nil)) - (t - (error "junk in string ~S" string)))) - (incf index)) - (values - (if found-digit - (if minusp (- result) result) - (if junk-allowed - nil - (error "no digits in string ~S" string))) - index)))) + (macrolet ((parse-error (format-control) + `(error 'simple-parse-error + :format-control ,format-control + :format-arguments (list string)))) + (with-array-data ((string string) + (start start) + (end (or end (length string)))) + (let ((index (do ((i start (1+ i))) + ((= i end) + (if junk-allowed + (return-from parse-integer (values nil end)) + (parse-error "no non-whitespace characters in string ~S."))) + (declare (fixnum i)) + (unless (whitespacep (char string i)) (return i)))) + (minusp nil) + (found-digit nil) + (result 0)) + (declare (fixnum index)) + (let ((char (char string index))) + (cond ((char= char #\-) + (setq minusp t) + (incf index)) + ((char= char #\+) + (incf index)))) + (loop + (when (= index end) (return nil)) + (let* ((char (char string index)) + (weight (digit-char-p char radix))) + (cond (weight + (setq result (+ weight (* result radix)) + found-digit t)) + (junk-allowed (return nil)) + ((whitespacep char) + (do ((jndex (1+ index) (1+ jndex))) + ((= jndex end)) + (declare (fixnum jndex)) + (unless (whitespacep (char string jndex)) + (parse-error "junk in string ~S"))) + (return nil)) + (t + (parse-error "junk in string ~S")))) + (incf index)) + (values + (if found-digit + (if minusp (- result) result) + (if junk-allowed + nil + (parse-error "no digits in string ~S"))) + index))))) ;;;; reader initialization code diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp index b9c1c70..17af5dd 100644 --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -159,14 +159,14 @@ (define-vop (fast-logand/signed-unsigned=>unsigned fast-logand/unsigned=>unsigned) - (:args (x :target r :scs (signed-reg)) - (y :scs (unsigned-reg unsigned-stack))) + (:args (x :scs (signed-reg)) + (y :target r :scs (unsigned-reg))) (:arg-types signed-num unsigned-num)) (define-vop (fast-logand/unsigned-signed=>unsigned fast-logand/unsigned=>unsigned) (:args (x :target r :scs (unsigned-reg)) - (y :scs (signed-reg signed-stack))) + (y :scs (signed-reg))) (:arg-types unsigned-num signed-num)) ;;; Special case fixnum + and - that trap on overflow. Useful when we diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp new file mode 100644 index 0000000..a91151e --- /dev/null +++ b/tests/arith.pure.lisp @@ -0,0 +1,49 @@ +;;;; arithmetic tests with no side effects + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(cl:in-package :cl-user) + +;;; Once upon a time, in the process of porting CMUCL's SPARC backend +;;; to SBCL, multiplications were excitingly broken. While it's +;;; unlikely that anything with such fundamental arithmetic errors as +;;; these are going to get this far, it's probably worth checking. +(macrolet ((test (op res1 res2) + `(progn + (assert (= (,op 4 2) ,res1)) + (assert (= (,op 2 4) ,res2)) + (assert (= (funcall (compile nil (lambda (x y) (,op x y))) 4 2) + ,res1)) + (assert (= (funcall (compile nil (lambda (x y) (,op x y))) 2 4) + ,res2))))) + (test + 6 6) + (test - 2 -2) + (test * 8 8) + (test / 2 1/2) + (test expt 16 16)) + +;;; 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))) + +;;; In a bug reported by Raymond Toy on cmucl-imp 2002-07-18, (COERCE +;;; '(COMPLEX FLOAT)) was failing to return a complex +;;; float; a patch was given by Wolfhard Buss cmucl-imp 2002-07-19. +(assert (= (coerce 1 '(complex float)) #c(1.0 0.0))) +(assert (= (coerce 1/2 '(complex float)) #c(0.5 0.0))) +(assert (= (coerce 1.0d0 '(complex float)) #c(1.0d0 0.0d0))) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 586f57b..db08b0d 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -143,6 +143,22 @@ ;; A5 value and is very, very disappointed in you. (But it doesn't ;; signal BUG any more.) (assert failure-p)) + +;;; On the SPARC, there was an erroneous definition of some VOPs used +;;; to compile LOGANDs, which would lead to compilation of the +;;; following function giving rise to a compile-time error (bug +;;; spotted and fixed by Raymond Toy for CMUCL) +(defun logand-sparc-bogons (a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) + (declare (type (unsigned-byte 32) a0) + (type (signed-byte 32) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) + ;; to ensure that the call is a candidate for + ;; transformation + (optimize (speed 3) (safety 0) (compilation-speed 0) (debug 0))) + (values + ;; the call that fails compilation + (logand a0 a10) + ;; a call to prevent the other arguments from being optimized away + (logand a1 a2 a3 a4 a5 a6 a7 a8 a9))) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/tests/float.pure.lisp b/tests/float.pure.lisp index ab395ad..1b17334 100644 --- a/tests/float.pure.lisp +++ b/tests/float.pure.lisp @@ -41,8 +41,8 @@ (assert (not (<= 6/7 (* 3 -ifni)))) (assert (not (> +ifni +ifni))))) -;;; ANSI: FILE-LENGTH should signal an error of type TYPE-ERROR if -;;; stream is not a stream associated with a file. +;;; ANSI: FLOAT-RADIX should signal an error if its argument is not a +;;; float. ;;; ;;; (Peter Van Eynde's ansi-test suite caught this, and Eric Marsden ;;; reported a fix for CMU CL, which was ported to sbcl-0.6.12.35.) diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index 728722a..77ba498 100644 --- a/tests/reader.pure.lisp +++ b/tests/reader.pure.lisp @@ -59,3 +59,18 @@ (let ((*readtable* (copy-readtable))) (set-syntax-from-char #\7 #\;) (assert (= 1235 (read-from-string "123579")))) + +;;; PARSE-INTEGER must signal an error of type PARSE-ERROR if it is +;;; unable to parse an integer and :JUNK-ALLOWED is NIL. +(macrolet ((assert-parse-error (form) + `(multiple-value-bind (val cond) + (ignore-errors ,form) + (assert (null val)) + (assert (typep cond 'parse-error))))) + (assert-parse-error (parse-integer " ")) + (assert-parse-error (parse-integer "12 a")) + (assert-parse-error (parse-integer "12a")) + (assert-parse-error (parse-integer "a")) + (assert (= (parse-integer "12") 12)) + (assert (= (parse-integer " 12 ") 12)) + (assert (= (parse-integer " 12asdb" :junk-allowed t) 12))) diff --git a/version.lisp-expr b/version.lisp-expr index d69dac7..31f1ad4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.6.12" +"0.7.6.13" -- 1.7.10.4