cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Cmucl-cvs] [git] CMU Common Lisp branch 20f-branch updated. snapshot-2014-09-14-g227e508
by Raymond Toy 02 Oct '14

02 Oct '14

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, 20f-branch has been updated via 227e5085c4e1bc0792c77a2cf0f06bfa518e4a38 (commit) from 8329e1d53ee57bf375c63675642b21358790ea2b (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 227e5085c4e1bc0792c77a2cf0f06bfa518e4a38 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 1 20:56:23 2014 -0700 Editorial fixes. * Remove [In progress] * Rephrase some items. * Fix typos. diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 2cdc460..1dc4fb1 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -1,10 +1,8 @@ ========================== C M U C L 20 f ============================= -[In Progress] - The CMUCL project is pleased to announce the release of CMUCL 20f. This is a major release which contains numerous enhancements and -bug fixes from the 20c release. +bug fixes from the 20e release. CMUCL is a free, high performance implementation of the Common Lisp programming language which runs on most major Unix platforms. It @@ -19,12 +17,12 @@ over the Internet, and is mostly in the public domain. New in this release: * Known issues: - * Support for x87 will be dropped after the 2014-04 snapshot. All - further snapshots will require an x86 chip that supports sse2. - SSE2 was introduced with the Pentium 4 in 2001. + * Support for x87 has been dropped (effective with the 2014-05 + snapshot). All further releases will require an x86 chip that + supports sse2. SSE2 was introduced with the Pentium 4 in 2001. * Feature enhancements - * Trig functions are signficantly faster. + * Trig functions are significantly faster. * Accuracy of trig functions improved. (Previously, they could be off by one or two ulp.) * RUN-PROGRAM accepts :ELEMENT-TYPE to allow specifying the @@ -49,14 +47,14 @@ New in this release: * Micro-optimization: (expt -1 power) just returns -1 or 1 without actually computing the power. * Run-time checks for zero pages on newly allocated pages has been - disabled now that the lazy zeroing of the heap pages has been - the default for several months now. + disabled. Lazy zeroing of the heap pages is the default + now. which can speed up GC and allocation. * Add lisp-unit as a contrib. Use (require :lisp-unit) to load it. Precompiled fasls are not included. * CMUCL now uses fdlibm C functions to implement the special functions. All platforms use this so they should produce identical results everywhere. - * Consing for the trig functions is removed now since we call out + * Consing for the trig functions is reduced now since we call out to fdlibm instead of implementing them in Lisp. * Source location information has been added for DEFINE-CONDITION. (From Helmut Eller.) @@ -79,12 +77,12 @@ New in this release: * On the ppc port, handle FP exceptions a bit better by not failing if cmucl is unable to interpret the instruction that caused the exception. - * Microoptimization for sparc in rounding a double-float to a + * Micro-optimization for sparc in rounding a double-float to a 32-bit signed integer. * The compiler can now derive the type of ROUND. (But more work is needed.) * Fix an issue with multi-processing destroy-process doesn't take - effect for a schedulable processbecause it has no run-reason + effect for a schedulable process because it has no run-reason and/or arrest-reason. * ANSI compliance fixes: @@ -120,7 +118,7 @@ New in this release: cleared. * In some situations KERNEL:DOUBLE-FLOAT-BITS on x86 would cause a segfault. This has been fixed. - * For linux, motifd is no longer a 64-bit app. + * For Linux, motifd is no longer a 64-bit app. * (exp 1d0) now returns the correctly rounded value of e. Previously, it was off by one bit. * INTEGER-DECODE-FLOAT returns the correct values for denormal ----------------------------------------------------------------------- Summary of changes: src/general-info/release-20f.txt | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch 20f-branch updated. snapshot-2014-09-13-g8329e1d
by Raymond Toy 02 Oct '14

02 Oct '14

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, 20f-branch has been updated via 8329e1d53ee57bf375c63675642b21358790ea2b (commit) from ab0a979db83310c64fcbbc13b178d5c31af9f5c9 (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 8329e1d53ee57bf375c63675642b21358790ea2b Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Wed Oct 1 20:29:32 2014 -0700 Fix regression in %ENUMERATE-DIRECTORIES. Previously (18a at least), %ENUMERATE-DIRECTORIES would return a path even if a directory element did not exist. This behavior is restored. See email from cmucl-help, Sep 26, 2014. * src/code/filesys.lisp: * Fix regression.in %ENUMERATE-DIRECTORIES. Even if the directory does not exist, we continue recursing instead of stopping. * src/general-info/release-20f.txt: * Update * tests/filesys.lisp: * New file adding tests for UNIX-NAMESTRING. diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 9d224df..ee844e3 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -710,9 +710,13 @@ (with-directory-node-noted ((head) &body body) `(multiple-value-bind (res dev ino mode) (unix-xstat ,head) - (when (and res (eql (logand mode unix:s-ifmt) unix:s-ifdir)) - (let ((nodes (cons (cons dev ino) nodes))) - ,@body)))) + ;; Even if the directory does not exist, we want to + ;; continue recursing. + (let ((nodes (if (and res (eql (logand mode unix:s-ifmt) + unix:s-ifdir)) + (cons (cons dev ino) nodes) + nodes))) + ,@body))) (do-directory-entries ((name directory) &body body) `(let ((dir (unix:open-dir ,directory))) (when dir diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 4fd57e3..2cdc460 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -127,6 +127,8 @@ New in this release: doubles. As a side-effect of this fix, DECODE-FLOAT returns the correct values for denormals, and SCALE-FLOAT scales denormals correctly. + * EXT:UNIX-NAMESTRING no longer returns NIL if a directory does + not exist. This was a regression from at least 18a. * Trac Tickets: * Ticket #90 fixed. diff --git a/tests/filesys.lisp b/tests/filesys.lisp new file mode 100644 index 0000000..a3d99e8 --- /dev/null +++ b/tests/filesys.lisp @@ -0,0 +1,60 @@ +;;; Tests for the functions in filesys.lisp. + +(defpackage :filesys-tests + (:use :cl :lisp-unit)) + +(in-package "FILESYS-TESTS") + +;; These tests for unix-namestring come from the cmucl-help mailing +;; list, Sep 26, 2014 by Jared C. Davis + +(define-test unix-namestring.1.exists + ;; Make sure the desired directories exist. + (assert-equal #P"/tmp/foo/bar/hello.txt" + (ensure-directories-exist "/tmp/foo/bar/hello.txt")) + (dolist (path '("/tmp/hello.txt" + "/tmp/foo/" + "/tmp/foo/hello.txt" + "/tmp/foo/bar/hello.txt" + "/tmp/foo/bar/bye.txt" + "/tmp/foo/bar/" + "/tmp/foo/bar/baz" + "/tmp/foo/bye.txt" + "/tmp/bye.txt")) + (assert-equal path + (ext:unix-namestring path nil) + path))) + +(define-test unix-namestring.1.non-existent + ;; Make sure the desired directories exist. + (assert-equal #P"/tmp/foo/bar/hello.txt" + (ensure-directories-exist "/tmp/foo/bar/hello.txt")) + ;; These paths contain directories that don't exist. + (dolist (path '("/tmp/oops/" + "/tmp/oops/hello.txt" + "/tmp/foo/oops/hello.txt" + "/tmp/foo/bar/oops/hello.txt" + "/tmp/foo/oops/" + )) + (assert-equal path + (ext:unix-namestring path nil) + path))) + +(define-test unix-namestring.2 + ;; Make sure the desired directories exist. + (assert-equal #P"/tmp/foo/bar/hello.txt" + (ensure-directories-exist "/tmp/foo/bar/hello.txt")) + (unwind-protect + (progn + ;; Create a symlink loop + ;; ln -s /tmp/foo/bar/symlink /tmp/foo/ + (unix:unix-unlink "/tmp/foo/bar/symlink") + (assert-equal t + (unix:unix-symlink "/tmp/foo/" "/tmp/foo/bar/symlink")) + (assert-equal "/tmp/foo/bar/symlink" + (ext:unix-namestring "/tmp/foo/bar/symlink" nil))) + (unix:unix-unlink "/tmp/foo/bar/symlink"))) + + + + ----------------------------------------------------------------------- Summary of changes: src/code/filesys.lisp | 10 +++++-- src/general-info/release-20f.txt | 2 ++ tests/filesys.lisp | 60 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 69 insertions(+), 3 deletions(-) create mode 100644 tests/filesys.lisp hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-28-g2f31675
by Raymond Toy 02 Oct '14

02 Oct '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-27-g19ac8cd
by Raymond Toy 01 Oct '14

01 Oct '14

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 19ac8cdc20d4124a6ef32578007e1183dc741305 (commit) from 6f1c1c59b5e719143012ac7b217458953f2a0bed (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 19ac8cdc20d4124a6ef32578007e1183dc741305 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Sep 30 21:30:11 2014 -0700 Move fdlibm tests from trig.lisp to fdlibm.lisp. diff --git a/tests/fdlibm.lisp b/tests/fdlibm.lisp new file mode 100644 index 0000000..98657ef --- /dev/null +++ b/tests/fdlibm.lisp @@ -0,0 +1,268 @@ +;; Test that fdlibm routines signals exceptions as expected. + +(defpackage :fdlibm-tests + (:use :cl :lisp-unit)) + +(in-package "FDLIBM-TESTS") + +(defparameter *qnan* + (kernel::with-float-traps-masked (:invalid) + (* 0 ext:double-float-positive-infinity)) + "Some randon quiet MaN value") + +(defparameter *snan* + (kernel:make-double-float #x7ff00000 1) + "A randon signaling MaN value") + +(define-test %cosh.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-overflow + (kernel:%cosh 1000d0)) + (assert-error 'floating-point-overflow + (kernel:%cosh -1000d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%cosh *snan*)) + (assert-true (ext:float-nan-p (kernel:%cosh *qnan*))) + + ;; Same, but with overflow's masked + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%cosh 1000d0)) + (assert-equal ext:double-float-positive-infinity + (kernel:%cosh -1000d0)) + (assert-equal ext:double-float-positive-infinity + (kernel:%cosh ext:double-float-positive-infinity)) + (assert-equal ext:double-float-positive-infinity + (kernel:%cosh ext:double-float-negative-infinity))) + ;; Test NaN + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%cosh *snan*))))) + +(define-test %sinh.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-overflow + (kernel:%sinh 1000d0)) + (assert-error 'floating-point-overflow + (kernel:%sinh -1000d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%sinh *snan*)) + (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))) + ;; Same, but with overflow's masked + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%sinh 1000d0)) + (assert-equal ext:double-float-negative-infinity + (kernel:%sinh -1000d0)) + (assert-equal ext:double-float-positive-infinity + (kernel:%sinh ext:double-float-positive-infinity)) + (assert-equal ext:double-float-negative-infinity + (kernel:%sinh ext:double-float-negative-infinity))) + ;; Test NaN + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))))) + + +(define-test %tanh.exceptions + (:tag :fdlibm) + (assert-true (ext:float-nan-p (kernel:%tanh *qnan*))) + (assert-error 'floating-point-invalid-operation + (kernel:%tanh *snan*)) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%tanh *snan*))))) + +(define-test %acosh.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-overflow + (kernel:%acosh ext:double-float-positive-infinity)) + (assert-error 'floating-point-invalid-operation + (kernel:%acosh 0d0)) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%acosh ext:double-float-positive-infinity))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%acosh 0d0))))) + +(define-test %asinh.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%asinh *snan*)) + (assert-error 'floating-point-overflow + (kernel:%asinh ext:double-float-positive-infinity)) + (assert-error 'floating-point-overflow + (kernel:%asinh ext:double-float-negative-infinity)) + (assert-true (ext:float-nan-p (kernel:%asinh *qnan*))) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%asinh ext:double-float-positive-infinity)) + (assert-error ext:double-float-negative-infinity + (kernel:%asinh ext:double-float-negative-infinity))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%asinh *snan*))))) + +(define-test %atanh.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%atanh 2d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%atanh -2d0)) + (assert-error 'division-by-zero + (kernel:%atanh 1d0)) + (assert-error 'division-by-zero + (kernel:%atanh -1d0)) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%atanh 2d0))) + (assert-true (ext:float-nan-p (kernel:%atanh -2d0)))) + (kernel::with-float-traps-masked (:divide-by-zero) + (assert-equal ext:double-float-positive-infinity + (kernel:%atanh 1d0)) + (assert-equal ext:double-float-negative-infinity + (kernel:%atanh -1d0)))) + +(define-test %expm1.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-overflow + (kernel:%expm1 709.8d0)) + (assert-equal ext:double-float-positive-infinity + (kernel:%expm1 ext:double-float-positive-infinity)) + (assert-error 'floating-point-invalid-operation + (kernel:%expm1 *snan*)) + (assert-true (ext:float-nan-p (kernel:%expm1 *qnan*))) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%expm1 709.8d0)) + ) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext::float-nan-p (kernel:%expm1 *snan*))))) + +(define-test %log1p.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%log1p -2d0)) + (assert-error 'floating-point-overflow + (kernel:%log1p -1d0)) + (assert-true (ext:float-nan-p (kernel:%log1p *qnan*))) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-negative-infinity + (kernel:%log1p -1d0))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%log1p *snan*))))) + +(define-test %exp.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-overflow + (kernel:%exp 710d0)) + (assert-true (ext:float-nan-p (kernel:%exp *qnan*))) + (assert-error 'floating-point-invalid-operation + (kernel:%exp *snan*)) + (assert-equal ext:double-float-positive-infinity + (kernel:%exp ext:double-float-positive-infinity)) + (assert-equal 0d0 + (kernel:%exp -1000d0)) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%exp 710d0))) + (let ((modes (ext:get-floating-point-modes))) + (unwind-protect + (progn + (ext:set-floating-point-modes :traps '(:underflow)) + (assert-error 'floating-point-underflow + (kernel:%exp -1000d0))) + (apply #'ext:set-floating-point-modes modes)))) + +(define-test %log.exception + (:tag :fdlibm) + (assert-error 'division-by-zero + (kernel:%log 0d0)) + (assert-error 'division-by-zero + (kernel:%log -0d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%log -1d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%log *snan*)) + (assert-true (ext:float-nan-p (kernel:%log *qnan*))) + (kernel::with-float-traps-masked (:divide-by-zero) + (assert-equal ext:double-float-negative-infinity + (kernel:%log 0d0)) + (assert-equal ext:double-float-negative-infinity + (kernel:%log -0d0))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%log -1d0))) + (assert-true (ext:float-nan-p (kernel:%log *snan*))))) + +(define-test %acos.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%acos 2d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%acos -2d0)) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%acos 2d0))) + (assert-true (ext:float-nan-p (kernel:%acos -2d0))))) + +(define-test %asin.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%asin 2d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%asin -2d0)) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%asin 2d0))) + (assert-true (ext:float-nan-p (kernel:%asin -2d0))))) + +(define-test %atan.exceptions + (:tag :fdlibm) + (assert-error 'floating-point-invalid-operation + (kernel:%atan *snan*)) + (assert-true (ext:float-nan-p (kernel:%atan *qnan*))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%atan *snan*))))) + +(define-test %log10.exceptions + (:tag :fdlibm) + ;; %log10(2^k) = k + (dotimes (k 23) + (assert-equalp k + (kernel:%log10 (float (expt 10 k) 1d0)))) + (assert-error 'division-by-zero + (kernel:%log10 0d0)) + (assert-error 'floating-point-invalid-operation + (kernel:%log10 -1d0)) + (assert-true (ext:float-nan-p (kernel:%log10 *qnan*))) + (assert-equal ext:double-float-positive-infinity + (kernel:%log10 ext:double-float-positive-infinity)) + (kernel::with-float-traps-masked (:divide-by-zero) + (assert-equal ext:double-float-negative-infinity + (kernel:%log10 0d0)) + (assert-equal ext:double-float-negative-infinity + (kernel:%log10 -0d0))) + (kernel::with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%log10 -1d0))))) + +(define-test %scalbn.exceptions + (:tag :fdlibm) + (let ((modes (ext:get-floating-point-modes))) + (unwind-protect + (progn + (ext:set-floating-point-modes :traps '(:underflow)) + (assert-error 'floating-point-underflow + (kernel:%scalbn 1d0 -51000))) + (apply #'ext:set-floating-point-modes modes))) + (assert-true 0d0 + (kernel:%scalbn 1d0 -51000)) + (assert-true -0d0 + (kernel:%scalbn -1d0 -51000)) + (assert-error 'floating-point-overflow + (kernel:%scalbn ext:double-float-positive-infinity 1)) + (assert-error 'floating-point-invalid-operation + (kernel:%scalbn *snan* 1)) + (assert-error 'floating-point-overflow + (kernel:%scalbn most-positive-double-float 2)) + (assert-error 'floating-point-overflow + (kernel:%scalbn most-negative-double-float 2)) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%scalbn ext:double-float-positive-infinity 1)) + (assert-equal ext:double-float-positive-infinity + (kernel:%scalbn most-positive-double-float 2)) + (assert-equal ext:double-float-negative-infinity + (kernel:%scalbn most-negative-double-float 2)))) diff --git a/tests/trig.lisp b/tests/trig.lisp index 86fdb39..84fc74c 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -792,267 +792,3 @@ (get-signs (atanh-def #c(2d0 +1d-20))) (assert-true (check-signs #'atanh #c(2d0 0d0) tr ti)) (assert-true (check-signs #'atanh #c(2w0 0w0) tr ti)))) - -;; Test that fdlibm routines signals exceptions as expected. - -(defparameter *qnan* - (kernel::with-float-traps-masked (:invalid) - (* 0 ext:double-float-positive-infinity)) - "Some randon quiet MaN value") - -(defparameter *snan* - (kernel:make-double-float #x7ff00000 1) - "A randon signaling MaN value") - -(define-test %cosh.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-overflow - (kernel:%cosh 1000d0)) - (assert-error 'floating-point-overflow - (kernel:%cosh -1000d0)) - (assert-error 'floating-point-invalid-operation - (kernel:%cosh *snan*)) - (assert-true (ext:float-nan-p (kernel:%cosh *qnan*))) - - ;; Same, but with overflow's masked - (kernel::with-float-traps-masked (:overflow) - (assert-equal ext:double-float-positive-infinity - (kernel:%cosh 1000d0)) - (assert-equal ext:double-float-positive-infinity - (kernel:%cosh -1000d0)) - (assert-equal ext:double-float-positive-infinity - (kernel:%cosh ext:double-float-positive-infinity)) - (assert-equal ext:double-float-positive-infinity - (kernel:%cosh ext:double-float-negative-infinity))) - ;; Test NaN - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%cosh *snan*))))) - -(define-test %sinh.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-overflow - (kernel:%sinh 1000d0)) - (assert-error 'floating-point-overflow - (kernel:%sinh -1000d0)) - (assert-error 'floating-point-invalid-operation - (kernel:%sinh *snan*)) - (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))) - ;; Same, but with overflow's masked - (kernel::with-float-traps-masked (:overflow) - (assert-equal ext:double-float-positive-infinity - (kernel:%sinh 1000d0)) - (assert-equal ext:double-float-negative-infinity - (kernel:%sinh -1000d0)) - (assert-equal ext:double-float-positive-infinity - (kernel:%sinh ext:double-float-positive-infinity)) - (assert-equal ext:double-float-negative-infinity - (kernel:%sinh ext:double-float-negative-infinity))) - ;; Test NaN - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))))) - - -(define-test %tanh.exceptions - (:tag :fdlibm) - (assert-true (ext:float-nan-p (kernel:%tanh *qnan*))) - (assert-error 'floating-point-invalid-operation - (kernel:%tanh *snan*)) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%tanh *snan*))))) - -(define-test %acosh.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-overflow - (kernel:%acosh ext:double-float-positive-infinity)) - (assert-error 'floating-point-invalid-operation - (kernel:%acosh 0d0)) - (kernel::with-float-traps-masked (:overflow) - (assert-equal ext:double-float-positive-infinity - (kernel:%acosh ext:double-float-positive-infinity))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%acosh 0d0))))) - -(define-test %asinh.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-invalid-operation - (kernel:%asinh *snan*)) - (assert-error 'floating-point-overflow - (kernel:%asinh ext:double-float-positive-infinity)) - (assert-error 'floating-point-overflow - (kernel:%asinh ext:double-float-negative-infinity)) - (assert-true (ext:float-nan-p (kernel:%asinh *qnan*))) - (kernel::with-float-traps-masked (:overflow) - (assert-equal ext:double-float-positive-infinity - (kernel:%asinh ext:double-float-positive-infinity)) - (assert-error ext:double-float-negative-infinity - (kernel:%asinh ext:double-float-negative-infinity))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%asinh *snan*))))) - -(define-test %atanh.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-invalid-operation - (kernel:%atanh 2d0)) - (assert-error 'floating-point-invalid-operation - (kernel:%atanh -2d0)) - (assert-error 'division-by-zero - (kernel:%atanh 1d0)) - (assert-error 'division-by-zero - (kernel:%atanh -1d0)) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%atanh 2d0))) - (assert-true (ext:float-nan-p (kernel:%atanh -2d0)))) - (kernel::with-float-traps-masked (:divide-by-zero) - (assert-equal ext:double-float-positive-infinity - (kernel:%atanh 1d0)) - (assert-equal ext:double-float-negative-infinity - (kernel:%atanh -1d0)))) - -(define-test %expm1.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-overflow - (kernel:%expm1 709.8d0)) - (assert-equal ext:double-float-positive-infinity - (kernel:%expm1 ext:double-float-positive-infinity)) - (assert-error 'floating-point-invalid-operation - (kernel:%expm1 *snan*)) - (assert-true (ext:float-nan-p (kernel:%expm1 *qnan*))) - (kernel::with-float-traps-masked (:overflow) - (assert-equal ext:double-float-positive-infinity - (kernel:%expm1 709.8d0)) - ) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext::float-nan-p (kernel:%expm1 *snan*))))) - -(define-test %log1p.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-invalid-operation - (kernel:%log1p -2d0)) - (assert-error 'floating-point-overflow - (kernel:%log1p -1d0)) - (assert-true (ext:float-nan-p (kernel:%log1p *qnan*))) - (kernel::with-float-traps-masked (:overflow) - (assert-equal ext:double-float-negative-infinity - (kernel:%log1p -1d0))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%log1p *snan*))))) - -(define-test %exp.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-overflow - (kernel:%exp 710d0)) - (assert-true (ext:float-nan-p (kernel:%exp *qnan*))) - (assert-error 'floating-point-invalid-operation - (kernel:%exp *snan*)) - (assert-equal ext:double-float-positive-infinity - (kernel:%exp ext:double-float-positive-infinity)) - (assert-equal 0d0 - (kernel:%exp -1000d0)) - (kernel::with-float-traps-masked (:overflow) - (assert-equal ext:double-float-positive-infinity - (kernel:%exp 710d0))) - (let ((modes (ext:get-floating-point-modes))) - (unwind-protect - (progn - (ext:set-floating-point-modes :traps '(:underflow)) - (assert-error 'floating-point-underflow - (kernel:%exp -1000d0))) - (apply #'ext:set-floating-point-modes modes)))) - -(define-test %log.exception - (:tag :fdlibm) - (assert-error 'division-by-zero - (kernel:%log 0d0)) - (assert-error 'division-by-zero - (kernel:%log -0d0)) - (assert-error 'floating-point-invalid-operation - (kernel:%log -1d0)) - (assert-error 'floating-point-invalid-operation - (kernel:%log *snan*)) - (assert-true (ext:float-nan-p (kernel:%log *qnan*))) - (kernel::with-float-traps-masked (:divide-by-zero) - (assert-equal ext:double-float-negative-infinity - (kernel:%log 0d0)) - (assert-equal ext:double-float-negative-infinity - (kernel:%log -0d0))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%log -1d0))) - (assert-true (ext:float-nan-p (kernel:%log *snan*))))) - -(define-test %acos.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-invalid-operation - (kernel:%acos 2d0)) - (assert-error 'floating-point-invalid-operation - (kernel:%acos -2d0)) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%acos 2d0))) - (assert-true (ext:float-nan-p (kernel:%acos -2d0))))) - -(define-test %asin.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-invalid-operation - (kernel:%asin 2d0)) - (assert-error 'floating-point-invalid-operation - (kernel:%asin -2d0)) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%asin 2d0))) - (assert-true (ext:float-nan-p (kernel:%asin -2d0))))) - -(define-test %atan.exceptions - (:tag :fdlibm) - (assert-error 'floating-point-invalid-operation - (kernel:%atan *snan*)) - (assert-true (ext:float-nan-p (kernel:%atan *qnan*))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%atan *snan*))))) - -(define-test %log10.exceptions - (:tag :fdlibm) - ;; %log10(2^k) = k - (dotimes (k 23) - (assert-equalp k - (kernel:%log10 (float (expt 10 k) 1d0)))) - (assert-error 'division-by-zero - (kernel:%log10 0d0)) - (assert-error 'floating-point-invalid-operation - (kernel:%log10 -1d0)) - (assert-true (ext:float-nan-p (kernel:%log10 *qnan*))) - (assert-equal ext:double-float-positive-infinity - (kernel:%log10 ext:double-float-positive-infinity)) - (kernel::with-float-traps-masked (:divide-by-zero) - (assert-equal ext:double-float-negative-infinity - (kernel:%log10 0d0)) - (assert-equal ext:double-float-negative-infinity - (kernel:%log10 -0d0))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%log10 -1d0))))) - -(define-test %scalbn.exceptions - (:tag :fdlibm) - (let ((modes (ext:get-floating-point-modes))) - (unwind-protect - (progn - (ext:set-floating-point-modes :traps '(:underflow)) - (assert-error 'floating-point-underflow - (kernel:%scalbn 1d0 -51000))) - (apply #'ext:set-floating-point-modes modes))) - (assert-true 0d0 - (kernel:%scalbn 1d0 -51000)) - (assert-true -0d0 - (kernel:%scalbn -1d0 -51000)) - (assert-error 'floating-point-overflow - (kernel:%scalbn ext:double-float-positive-infinity 1)) - (assert-error 'floating-point-invalid-operation - (kernel:%scalbn *snan* 1)) - (assert-error 'floating-point-overflow - (kernel:%scalbn most-positive-double-float 2)) - (assert-error 'floating-point-overflow - (kernel:%scalbn most-negative-double-float 2)) - (kernel::with-float-traps-masked (:overflow) - (assert-equal ext:double-float-positive-infinity - (kernel:%scalbn ext:double-float-positive-infinity 1)) - (assert-equal ext:double-float-positive-infinity - (kernel:%scalbn most-positive-double-float 2)) - (assert-equal ext:double-float-negative-infinity - (kernel:%scalbn most-negative-double-float 2)))) ----------------------------------------------------------------------- Summary of changes: tests/fdlibm.lisp | 268 +++++++++++++++++++++++++++++++++++++++++++++++++++++ tests/trig.lisp | 264 ---------------------------------------------------- 2 files changed, 268 insertions(+), 264 deletions(-) create mode 100644 tests/fdlibm.lisp hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-26-g6f1c1c5
by Raymond Toy 01 Oct '14

01 Oct '14

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 6f1c1c59b5e719143012ac7b217458953f2a0bed (commit) via 098f3c14711de24cfeb3ce6a74bca320fd8e2aa1 (commit) from f61fb8591ba745046f96770093330be7d12e45d2 (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 6f1c1c59b5e719143012ac7b217458953f2a0bed Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Sep 30 21:12:52 2014 -0700 Add tests for kernel:%scalbn. diff --git a/tests/trig.lisp b/tests/trig.lisp index cdebe39..86fdb39 100644 --- a/tests/trig.lisp +++ b/tests/trig.lisp @@ -1027,3 +1027,32 @@ (kernel:%log10 -0d0))) (kernel::with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%log10 -1d0))))) + +(define-test %scalbn.exceptions + (:tag :fdlibm) + (let ((modes (ext:get-floating-point-modes))) + (unwind-protect + (progn + (ext:set-floating-point-modes :traps '(:underflow)) + (assert-error 'floating-point-underflow + (kernel:%scalbn 1d0 -51000))) + (apply #'ext:set-floating-point-modes modes))) + (assert-true 0d0 + (kernel:%scalbn 1d0 -51000)) + (assert-true -0d0 + (kernel:%scalbn -1d0 -51000)) + (assert-error 'floating-point-overflow + (kernel:%scalbn ext:double-float-positive-infinity 1)) + (assert-error 'floating-point-invalid-operation + (kernel:%scalbn *snan* 1)) + (assert-error 'floating-point-overflow + (kernel:%scalbn most-positive-double-float 2)) + (assert-error 'floating-point-overflow + (kernel:%scalbn most-negative-double-float 2)) + (kernel::with-float-traps-masked (:overflow) + (assert-equal ext:double-float-positive-infinity + (kernel:%scalbn ext:double-float-positive-infinity 1)) + (assert-equal ext:double-float-positive-infinity + (kernel:%scalbn most-positive-double-float 2)) + (assert-equal ext:double-float-negative-infinity + (kernel:%scalbn most-negative-double-float 2)))) commit 098f3c14711de24cfeb3ce6a74bca320fd8e2aa1 Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Sep 30 21:12:37 2014 -0700 Add alien interface to scalbn. diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index c07e979..8ddd413 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -91,6 +91,12 @@ (def-math-rtn ("fdlibm_log1p" %log1p) 1) (def-math-rtn ("fdlibm_expm1" %expm1) 1) +(declaim (inline %scalbn)) +(export '%scalbn) +(alien:def-alien-routine ("fdlibm_scalbn" %scalbn) c-call:double + (x double-float) + (n c-call:int)) + ;; These are needed for use by byte-compiled files. But don't use ;; these with sse2 since we don't support using the x87 instructions ;; here. ----------------------------------------------------------------------- Summary of changes: src/code/irrat.lisp | 6 ++++++ tests/trig.lisp | 29 +++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) hooks/post-receive -- CMU Common Lisp

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-24-gf61fb85
by Raymond Toy 01 Oct '14

01 Oct '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-23-g33adf3d
by Raymond Toy 29 Sep '14

29 Sep '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-22-g95551b4
by Raymond Toy 28 Sep '14

28 Sep '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-21-ge82e6d3
by Raymond Toy 28 Sep '14

28 Sep '14

1 0

[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-20-g3c677fd
by Raymond Toy 28 Sep '14

28 Sep '14

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs