This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp".
The branch, master has been updated via d03e178481b3be542e4a2519890ed2772d081fb6 (commit) from 13bd32f69a31581b50582d6283ba08b745eca6d3 (commit)
Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below.
- Log ----------------------------------------------------------------- commit d03e178481b3be542e4a2519890ed2772d081fb6 Author: Raymond Toy toy.raymond@gmail.com Date: Fri Sep 19 22:35:27 2014 -0700
Fix error in type derivation for the sign in DECODE-FLOAT.
Type derivation of the sign of (DECODE-FLOAT X) returned the incorrect value when x was declared to be of type (DOUBLE-FLOAT (0d0)).
* src/compiler/float-tran.lisp * Fix type derivation * tests/float-tran.lisp * New file for tests of DECODE-FLOAT-SIGN-DERIVE-TYPE-AUX. * tests/float.lisp * New file to test that decode-float is compiled correctly.
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index ccb6e06..4aecd5c 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -2082,24 +2082,19 @@
(defun decode-float-sign-derive-type-aux (arg) ;; Derive the sign of the float. - (flet ((calc-sign (x) - (when x - (nth-value 2 (decode-float x))))) - (let* ((lo (bound-func #'calc-sign - (numeric-type-low arg))) - (hi (bound-func #'calc-sign - (numeric-type-high arg)))) - (if (numeric-type-format arg) - (specifier-type `(,(numeric-type-format arg) - ;; If lo or high bounds are NIL, use -1 - ;; or 1 of the appropriate type instead. - ,(or lo (coerce -1 (numeric-type-format arg))) - ,(or hi (coerce 1 (numeric-type-format arg))))) - (specifier-type '(or (member 1f0 -1f0 - 1d0 -1d0 - #+double-double 1w0 - #+double-double -1w0))))))) - + (if (numeric-type-format arg) + (let ((arg-range (interval-range-info (numeric-type->interval arg)))) + (case arg-range + (+ (make-member-type :members (list (coerce 1 (numeric-type-format arg))))) + (- (make-member-type :members (list (coerce -1 (numeric-type-format arg))))) + (otherwise + (make-member-type :members (list (coerce 1 (numeric-type-format arg)) + (coerce -1 (numeric-type-format arg))))))) + (specifier-type '(or (member 1f0 -1f0 + 1d0 -1d0 + #+double-double 1w0 + #+double-double -1w0))))) + (defoptimizer (decode-float derive-type) ((num)) (let ((f (one-arg-derive-type num #'(lambda (arg) diff --git a/tests/float-tran.lisp b/tests/float-tran.lisp new file mode 100644 index 0000000..9c81882 --- /dev/null +++ b/tests/float-tran.lisp @@ -0,0 +1,17 @@ +;; Tests for various float transformations. + +(defpackage :float-tran-tests + (:use :cl :lisp-unit)) + +(in-package "FLOAT-TRAN-TESTS") + +(define-test decode-float-sign + "Test type derivation of the sign from decode-float" + (assert-equalp (c::make-member-type :members (list 1f0 -1f0)) + (c::decode-float-sign-derive-type-aux (c::specifier-type 'single-float))) + (assert-equalp (c::make-member-type :members (list 1d0 -1d0)) + (c::decode-float-sign-derive-type-aux (c::specifier-type 'double-float))) + (assert-equalp (c::make-member-type :members (list 1f0)) + (c::decode-float-sign-derive-type-aux (c::specifier-type '(single-float (0f0)))))) + + \ No newline at end of file diff --git a/tests/float.lisp b/tests/float.lisp new file mode 100644 index 0000000..6fe1f50 --- /dev/null +++ b/tests/float.lisp @@ -0,0 +1,12 @@ +;; Tests of float functions + +(defpackage :float-tests + (:use :cl :lisp-unit)) + +(in-package "FLOAT-TESTS") + +(define-test decode-float + (assert-true (funcall (compile nil #'(lambda (x) + (declare (type (double-float (0d0)) x)) + (decode-float x))) + 1d0)))
-----------------------------------------------------------------------
Summary of changes: src/compiler/float-tran.lisp | 31 +++++++++++++------------------ tests/float-tran.lisp | 17 +++++++++++++++++ tests/float.lisp | 12 ++++++++++++ 3 files changed, 42 insertions(+), 18 deletions(-) create mode 100644 tests/float-tran.lisp create mode 100644 tests/float.lisp
hooks/post-receive