February 2018 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][master] 2 commits: Complex array accessors are not foldable
by Raymond Toy 19 Feb '18

19 Feb '18

Raymond Toy pushed to branch master at cmucl / cmucl Commits: e9a598e5 by Raymond Toy at 2018-02-19T08:41:07-08:00 Complex array accessors are not foldable Fixes #61 and #62. The `ARRAY-HAS-FILL-POINTER-P` and `ARRAY-DISPLACEMENT` functions are declared inline and the compiler tries to constant-fold these inlined functions operating on simple arrays. Thus don't allow the compiler to constant-fold calls to `%ARRAY-FILL-POINTER-P`. This is normally protected by a call to `ARRAY-HEADER-P`, but when it's inlined, the compiler tries to constant-fold `%ARRAY-FILL-POINTER-P` on an array without such a slot. Likewise `ARRAY-DISPLACEMENT` calls `%ARRAY-DISPLACED-P`, `%ARRAY-DATA-VECTOR`, and `%ARRAY-DISPLACEMENT`, and the calls are protected by `ARRAY-HEADER-P`. So don't constant-fold these either. Maybe we could also make CONSTANT-FOLD-CALL be smarter about this? * src/compiler/generic/objdef.lisp * Remove flushable from these ref-trans methods. * src/general-info/release-21d.md * Update * tests/issues.lisp * Add tests from the bug reports. - - - - - ac4b9fc8 by Raymond Toy at 2018-02-19T16:50:47+00:00 Merge branch 'rtoy-fix-61-62-not-flushable' into 'master' Complex array accessors are not foldable Closes #61 and #62 See merge request cmucl/cmucl!38 - - - - - 3 changed files: - src/compiler/generic/objdef.lisp - src/general-info/release-21d.md - tests/issues.lisp Changes: ===================================== src/compiler/generic/objdef.lisp ===================================== --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -252,29 +252,32 @@ :ref-known (flushable foldable) :set-trans (setf %array-fill-pointer) :set-known (unsafe)) + ;; Don't let these ref-trans to be constant-folded because these + ;; might get called on arrays that don't have these slots. (Because + ;; the lisp functions might be inlined.) (fill-pointer-p :type (member t nil) :ref-trans %array-fill-pointer-p - :ref-known (flushable foldable) + :ref-known (flushable) :set-trans (setf %array-fill-pointer-p) :set-known (unsafe)) (elements :type index :ref-trans %array-available-elements - :ref-known (flushable foldable) + :ref-known (flushable) :set-trans (setf %array-available-elements) :set-known (unsafe)) (data :type array :ref-trans %array-data-vector - :ref-known (flushable foldable) + :ref-known (flushable) :set-trans (setf %array-data-vector) :set-known (unsafe)) (displacement :type (or index null) :ref-trans %array-displacement - :ref-known (flushable foldable) + :ref-known (flushable) :set-trans (setf %array-displacement) :set-known (unsafe)) (displaced-p :type (member t nil) :ref-trans %array-displaced-p - :ref-known (flushable foldable) + :ref-known (flushable) :set-trans (setf %array-displaced-p) :set-known (unsafe)) (dimensions :rest-p t)) ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -35,6 +35,8 @@ public domain. * ~~#59~~ Incorrect type-derivation for `decode-float` * ~~#60~~ The function `C::%UNARY-FROUND` is undefined * ~~#58~~ Bogus type error in comparison of complex number with `THE` form + * ~~#61~~ Segfault when compiling call to `ARRAY-HAS-FILL-POINTER-P` on bit vector constant + * ~~#62~~ Segfault when compiling `ARRAY-DISPLACEMENT` on a string constant * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -521,3 +521,17 @@ (let ((c9 (compile nil #'(lambda (x) (= (the (eql 1.0d0) x) #c(1/2 1/2)))))) (assert-false (funcall c9 1.d0)))) + +(define-test issue.61 + (:tag :issues) + ;; Verifies that the compiler doesn't segfault and that we return + ;; the correct value. + (assert-false + (funcall (compile nil '(lambda () (array-has-fill-pointer-p #*10)))))) + +(define-test issue.62 + (:tag :issues) + ;; Verifies that the compiler doesn't segfault and that we return + ;; the correct value. + (assert-false + (funcall (compile nil '(lambda () (array-displacement "aaaaaaaa")))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/771fd903423d15380c445426… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/771fd903423d15380c445426… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-fix-61-62-not-flushable
by Raymond Toy 19 Feb '18

19 Feb '18

Raymond Toy pushed new branch rtoy-fix-61-62-not-flushable at cmucl / cmucl --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-fix-61-62-not-flushable You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #58: Bogus type error in comparison of complex number with `THE` form
by Raymond Toy 18 Feb '18

18 Feb '18

Raymond Toy pushed to branch master at cmucl / cmucl Commits: bccd6a98 by Raymond Toy at 2018-02-18T09:01:08-08:00 Fix #58: Bogus type error in comparison of complex number with `THE` form The deftransforms `upgraded-complex-real-contagion-arg1` and `upgraded-complex-real-contagion-arg2` were coercing the complex number to the exact type of the float number. Because of the `THE` form, the type of the float was `(member 1d0)`, so the compiler was coercing `#c(1/2 1/2)` to `(complex (double-float 1d0))`, which is wrong. Therefore, coerce the complex to just the type format of the real part, ignoring any bounds. * src/compiler/float-tran.lisp * Coerce to format type, discarding any bounds * src/general-info/release-21d.md * Update notes * tests/issues.lisp * Added test for this - - - - - 771fd903 by Raymond Toy at 2018-02-18T17:11:19+00:00 Merge branch 'rtoy-fix-issue-58' into 'master' Fix #58: Bogus type error in comparison of complex number with `THE` form Closes #58 See merge request cmucl/cmucl!37 - - - - - 3 changed files: - src/compiler/float-tran.lisp - src/general-info/release-21d.md - tests/issues.lisp Changes: ===================================== src/compiler/float-tran.lisp ===================================== --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -1903,7 +1903,7 @@ (deftransform upgraded-complex-real-contagion-arg1 ((x y) * * :defun-only t :node node) ;;(format t "upgraded-complex-real-contagion-arg1~%") `(,(continuation-function-name (basic-combination-fun node)) - (coerce x '(complex ,(type-specifier (continuation-type y)))) + (coerce x '(complex ,(numeric-type-format (continuation-type y)))) y)) ;;; (deftransform upgraded-complex-real-contagion-arg2 ((x y) * * :defun-only t :node node) @@ -1912,7 +1912,7 @@ (continuation-type x) (continuation-type y)) `(,(continuation-function-name (basic-combination-fun node)) x - (coerce y '(complex ,(type-specifier (continuation-type x)))))) + (coerce y '(complex ,(numeric-type-format (continuation-type x)))))) (dolist (x '(= + * / -)) ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -34,6 +34,7 @@ public domain. * ~~#47~~ Backquate and multiple splices * ~~#59~~ Incorrect type-derivation for `decode-float` * ~~#60~~ The function `C::%UNARY-FROUND` is undefined + * ~~#58~~ Bogus type error in comparison of complex number with `THE` form * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -515,3 +515,9 @@ (assert-equalp (values 2d0 0d0) (funcall c14 2d0)))) + +(define-test issue.58 + (:tag :issues) + (let ((c9 (compile nil #'(lambda (x) + (= (the (eql 1.0d0) x) #c(1/2 1/2)))))) + (assert-false (funcall c9 1.d0)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/31c6bf9faef2ce24d42d5af0… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/31c6bf9faef2ce24d42d5af0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-fix-issue-58
by Raymond Toy 18 Feb '18

18 Feb '18

Raymond Toy pushed new branch rtoy-fix-issue-58 at cmucl / cmucl --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-fix-issue-58 You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 3 commits: Fix #60: `C::%UNARY-FROUND` is undefined
by Raymond Toy 18 Feb '18

18 Feb '18

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 26e3ad82 by Raymond Toy at 2018-02-17T19:44:02-08:00 Fix #60: `C::%UNARY-FROUND` is undefined Remove the symbol `C::%UNARY-FROUND` and just let the compiler package inherit it from the kernel package. * src/bootfiles/21c/boot-2018-02-1.lisp * Use this to bootstrap the change (by uninterning the symbol) * src/code/float.lisp * Just export %unary-fround * src/general-info/release-21d.md * Update * tests/issues.lisp * Add test for this issue - - - - - 84d9a4bd by Raymond Toy at 2018-02-17T19:56:32-08:00 Oops. Need to build with the bootstrap file. - - - - - 31c6bf9f by Raymond Toy at 2018-02-18T15:30:51+00:00 Merge branch 'rtoy-fix-60-unary-fround-undefined' into 'master' Fix #60: unary fround undefined Closes #60 See merge request cmucl/cmucl!36 - - - - - 5 changed files: - .gitlab-ci.yml - + src/bootfiles/21c/boot-2018-02-1.lisp - src/code/float.lisp - src/general-info/release-21d.md - tests/issues.lisp Changes: ===================================== .gitlab-ci.yml ===================================== --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -12,7 +12,7 @@ linux-runner: - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-$version-linux.tar.bz2; tar xjf ../cmucl-$version-linux.extra.tar.bz2) script: - - bin/build.sh -C "" -o snapshot/bin/lisp + - bin/build.sh -B boot-2018-02-1 -C "" -o snapshot/bin/lisp - bin/make-dist.sh -I dist linux-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log @@ -24,6 +24,6 @@ osx-runner: - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-$version-darwin.tar.bz2) script: - - bin/build.sh -C "" -o snapshot/bin/lisp + - bin/build.sh -B boot-2018-02-1 -C "" -o snapshot/bin/lisp - bin/make-dist.sh -I dist darwin-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log ===================================== src/bootfiles/21c/boot-2018-02-1.lisp ===================================== --- /dev/null +++ b/src/bootfiles/21c/boot-2018-02-1.lisp @@ -0,0 +1,5 @@ +;; Get rid of incorrect symbol c::%unary-fround and just inherit +;; %unary-fround from the kernel package. +(ext:without-package-locks + (unintern 'c::%unary-fround "C")) +(export 'kernel::%unary-fround "KERNEL") ===================================== src/code/float.lisp ===================================== --- a/src/code/float.lisp +++ b/src/code/float.lisp @@ -23,7 +23,7 @@ %unary-ftruncate/single-float %unary-ftruncate/double-float)) #-x87 -(export '(%unary-fround/single-float %unary-fround/double-float)) +(export '(%unary-fround %unary-fround/single-float %unary-fround/double-float)) (in-package "LISP") (export '(least-positive-normalized-short-float ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -29,10 +29,11 @@ public domain. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: - * ~~~#50~~~ CLX (Hemlock) fails to run. - * ~~~#49~~~ CLM crashes - * ~~~#47~~~ Backquate and multiple splices - * ~~~#59~~~ Incorrect type-derivation for `decode-float` + * ~~#50~~ CLX (Hemlock) fails to run. + * ~~#49~~ CLM crashes + * ~~#47~~ Backquate and multiple splices + * ~~#59~~ Incorrect type-derivation for `decode-float` + * ~~#60~~ The function `C::%UNARY-FROUND` is undefined * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -503,4 +503,15 @@ (c::decode-float-exp-derive-type-aux (c::specifier-type `(single-float ,arg-lo ,arg-hi))) arg-lo - arg-hi)))) \ No newline at end of file + arg-hi)))) + +(define-test issue.60 + (:tag :issues) + (let ((c14 (compile nil #'(lambda (x) + (fround (the (member 1.0 2d0) x)))))) + (assert-equalp + (values 1.0 0.0) + (funcall c14 1.0)) + (assert-equalp + (values 2d0 0d0) + (funcall c14 2d0)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/894e18e020e6a16024bc63f2… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/894e18e020e6a16024bc63f2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-fix-60-unary-fround-undefined] Oops. Need to build with the bootstrap file.
by Raymond Toy 18 Feb '18

18 Feb '18

Raymond Toy pushed to branch rtoy-fix-60-unary-fround-undefined at cmucl / cmucl Commits: 84d9a4bd by Raymond Toy at 2018-02-17T19:56:32-08:00 Oops. Need to build with the bootstrap file. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -12,7 +12,7 @@ linux-runner: - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-$version-linux.tar.bz2; tar xjf ../cmucl-$version-linux.extra.tar.bz2) script: - - bin/build.sh -C "" -o snapshot/bin/lisp + - bin/build.sh -B boot-2018-02-1 -C "" -o snapshot/bin/lisp - bin/make-dist.sh -I dist linux-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log @@ -24,6 +24,6 @@ osx-runner: - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-$version-darwin.tar.bz2) script: - - bin/build.sh -C "" -o snapshot/bin/lisp + - bin/build.sh -B boot-2018-02-1 -C "" -o snapshot/bin/lisp - bin/make-dist.sh -I dist darwin-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/84d9a4bd08f8d30cab242c85e… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/84d9a4bd08f8d30cab242c85e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-fix-60-unary-fround-undefined
by Raymond Toy 18 Feb '18

18 Feb '18

Raymond Toy pushed new branch rtoy-fix-60-unary-fround-undefined at cmucl / cmucl --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-fix-60-unary-fround-un… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new tag snapshot-2018-02
by Raymond Toy 10 Feb '18

10 Feb '18

Raymond Toy pushed new tag snapshot-2018-02 at cmucl / cmucl --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/snapshot-2018-02 You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update from logs
by Raymond Toy 10 Feb '18

10 Feb '18

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 894e18e0 by Raymond Toy at 2018-02-10T08:52:20-08:00 Update from logs - - - - - 1 changed file: - src/general-info/release-21d.md Changes: ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -25,10 +25,14 @@ public domain. * The required state for this generator is just 4 32-bit words instead of the 600+ for MT19937. * The generator is also faster than MT19937 (approximately 28% faster on x86 and 18% on sparc). * The new function `KERNEL:RANDOM-STATE-JUMP` modifies the given state to jump 2^64 samples ahead, allowing 2^64 non-overlapping sequences. - + * Updated CLX to telent clx version 06e39a0d. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: + * ~~~#50~~~ CLX (Hemlock) fails to run. + * ~~~#49~~~ CLM crashes + * ~~~#47~~~ Backquate and multiple splices + * ~~~#59~~~ Incorrect type-derivation for `decode-float` * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/894e18e020e6a16024bc63f2f… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/894e18e020e6a16024bc63f2f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 6 commits: Fix #59: type derivation for decode-float exponent
by Raymond Toy 04 Feb '18

04 Feb '18

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 3acdd1b7 by Raymond Toy at 2018-02-03T08:57:28-08:00 Fix #59: type derivation for decode-float exponent Type derivation for exponent part of decode-float was incorrect. We need to take the absolute value of the argument before deriving the type since the exponent is, of course, independent of the sign of the number. In the test case, the negative interval caused the lower and upper bounds to be reversed, resulting in an invalid interval. - - - - - 62c5f3e9 by Raymond Toy at 2018-02-03T09:03:04-08:00 Add test for issue #59. - - - - - 2292400e by Raymond Toy at 2018-02-04T08:16:35-08:00 Fix typo. double-double-float is in the kernel package - - - - - 4e58e53c by Raymond Toy at 2018-02-04T08:19:13-08:00 Be more careful in computing the decode-float bounds If 0 is the lower bound then the smallest exponent is not for 0, but for the least positive float because of denormals. Also handle exclusive bounds. - - - - - 7b336362 by Raymond Toy at 2018-02-04T08:19:37-08:00 Add more tests decode-float. - - - - - 90df7817 by Raymond Toy at 2018-02-04T18:46:50+00:00 Merge branch 'rtoy-fix-59-derive-decode-float' into 'master' Fix #59: derive decode float Closes #59 See merge request cmucl/cmucl!34 - - - - - 3 changed files: - src/compiler/float-tran.lisp - tests/float-tran.lisp - tests/issues.lisp Changes: ===================================== src/compiler/float-tran.lisp ===================================== --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -2028,31 +2028,36 @@ (defun decode-float-exp-derive-type-aux (arg) ;; Derive the exponent part of the float. It's always an integer ;; type. - (flet ((calc-exp (x) - (when x - (nth-value 1 (decode-float x)))) - (min-exp () - ;; Use decode-float on the least positive float of the - ;; appropriate type to find the min exponent. If we don't - ;; know the actual number format, use double, which has the - ;; widest range (including double-double-float). - (nth-value 1 (decode-float (if (eq 'single-float (numeric-type-format arg)) - least-positive-single-float - least-positive-double-float)))) - (max-exp () - ;; Use decode-float on the most postive number of the - ;; appropriate type to find the max exponent. If we don't - ;; know the actual number format, use double, which has the - ;; widest range (including double-double-float). - (if (eq (numeric-type-format arg) 'single-float) - (nth-value 1 (decode-float most-positive-single-float)) - (nth-value 1 (decode-float most-positive-double-float))))) - (let* ((lo (or (bound-func #'calc-exp - (numeric-type-low arg)) - (min-exp))) - (hi (or (bound-func #'calc-exp - (numeric-type-high arg)) - (max-exp)))) + (labels + ((calc-exp (x) + (when x + (bound-func #'(lambda (arg) + (nth-value 1 (decode-float arg))) + x))) + (min-exp (interval) + ;; (decode-float 0d0) returns an exponent of -1022. But + ;; (decode-float least-positive-double-float returns -1073. + ;; Hence, if the low value is less than this, we need to + ;; return the exponent of the least positive number. + (let ((least (if (eq 'single-float (numeric-type-format arg)) + least-positive-single-float + least-positive-double-float))) + (if (or (interval-contains-p 0 interval) + (interval-contains-p least interval)) + (calc-exp least) + (calc-exp (bound-value (interval-low interval)))))) + (max-exp (interval) + ;; Use decode-float on the most postive number of the + ;; appropriate type to find the max exponent. If we don't + ;; know the actual number format, use double, which has the + ;; widest range (including double-double-float). + (or (calc-exp (bound-value (interval-high interval))) + (calc-exp (if (eq 'single-float (numeric-type-format arg)) + most-positive-single-float + most-positive-double-float))))) + (let* ((interval (interval-abs (numeric-type->interval arg))) + (lo (min-exp interval)) + (hi (max-exp interval))) (specifier-type `(integer ,(or lo '*) ,(or hi '*)))))) (defun decode-float-sign-derive-type-aux (arg) ===================================== tests/float-tran.lisp ===================================== --- a/tests/float-tran.lisp +++ b/tests/float-tran.lisp @@ -28,7 +28,7 @@ #+double-double (assert-equalp (c::specifier-type '(integer -1073 1024)) (c::decode-float-exp-derive-type-aux - (c::specifier-type 'double-double-float))) + (c::specifier-type 'kernel:double-double-float))) (assert-equalp (c::specifier-type '(integer 2 8)) (c::decode-float-exp-derive-type-aux (c::specifier-type '(double-float 2d0 128d0))))) ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -443,3 +443,64 @@ (write (read-from-string "`(,@vars ,@vars)") :pretty t :stream s))))) + +(define-test issue.59 + (:tag :issues) + (let ((f (compile nil #'(lambda (z) + (declare (type (double-float -2d0 0d0) z)) + (nth-value 2 (decode-float z)))))) + (assert-equal -1d0 (funcall f -1d0)))) + +(define-test issue.59.1-double + (:tag :issues) + (dolist (entry '(((-2d0 2d0) (-1073 2)) + ((-2d0 0d0) (-1073 2)) + ((0d0 2d0) (-1073 2)) + ((1d0 4d0) (1 3)) + ((-4d0 -1d0) (1 3)) + (((0d0) (10d0)) (-1073 4)) + ((-2f0 2f0) (-148 2)) + ((-2f0 0f0) (-148 2)) + ((0f0 2f0) (-148 2)) + ((1f0 4f0) (1 3)) + ((-4f0 -1f0) (1 3)) + ((0f0) (10f0)) (-148 4))) + (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi)) + entry + (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi)) + (c::decode-float-exp-derive-type-aux + (c::specifier-type `(double-float ,arg-lo ,arg-hi))))))) + +(define-test issue.59.1-double + (:tag :issues) + (dolist (entry '(((-2d0 2d0) (-1073 2)) + ((-2d0 0d0) (-1073 2)) + ((0d0 2d0) (-1073 2)) + ((1d0 4d0) (1 3)) + ((-4d0 -1d0) (1 3)) + (((0d0) (10d0)) (-1073 4)) + (((0.5d0) (4d0)) (0 3)))) + (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi)) + entry + (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi)) + (c::decode-float-exp-derive-type-aux + (c::specifier-type `(double-float ,arg-lo ,arg-hi))) + arg-lo + arg-hi)))) + +(define-test issue.59.1-float + (:tag :issues) + (dolist (entry '(((-2f0 2f0) (-148 2)) + ((-2f0 0f0) (-148 2)) + ((0f0 2f0) (-148 2)) + ((1f0 4f0) (1 3)) + ((-4f0 -1f0) (1 3)) + (((0f0) (10f0)) (-148 4)) + (((0.5f0) (4f0)) (0 3)))) + (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi)) + entry + (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi)) + (c::decode-float-exp-derive-type-aux + (c::specifier-type `(single-float ,arg-lo ,arg-hi))) + arg-lo + arg-hi)))) \ No newline at end of file View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/e7f97a5d5e72b65650ecfc28… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/e7f97a5d5e72b65650ecfc28… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0