cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Git][cmucl/cmucl][issue-298-with-float-rounding-mode] Fix typos caused by renaming
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-298-with-float-rounding-mode at cmucl / cmucl Commits: 0e716eab by Raymond Toy at 2024-04-07T17:02:55-07:00 Fix typos caused by renaming We renamed `old-rounding-mode` to `old-mode`, but forgot to update all uses. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -514,7 +514,7 @@ modes are not modified. " (let ((old-mode (gensym "OLD-MODE-")) (new-mode (gensym "NEW-MODE-"))) - `(let ((,old-rounding-mode (ldb float-rounding-mode (floating-point-modes))) + `(let ((,old-mode (ldb float-rounding-mode (floating-point-modes))) (,new-mode (cdr (assoc ,rounding-mode rounding-mode-alist)))) (unwind-protect (progn @@ -523,4 +523,4 @@ ,@body) ;; Restore just the rounding mode to the original value. (setf (floating-point-modes) - (dpb ,old-rounding-mode float-rounding-mode (floating-point-modes))))))) + (dpb ,old-mode float-rounding-mode (floating-point-modes))))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0e716eabb1708f9f8e51289… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0e716eabb1708f9f8e51289… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #295: Add docstring for define-assembly-routine
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: b8923ba5 by Raymond Toy at 2024-04-08T00:00:36+00:00 Fix #295: Add docstring for define-assembly-routine - - - - - e77ded50 by Raymond Toy at 2024-04-08T00:00:39+00:00 Merge branch 'issue-295-docstring-for-define-assembly-routine' into 'master' Fix #295: Add docstring for define-assembly-routine Closes #295 See merge request cmucl/cmucl!204 - - - - - 1 changed file: - src/assembly/assemfile.lisp Changes: ===================================== src/assembly/assemfile.lisp ===================================== @@ -209,7 +209,61 @@ ,(reg-spec-temp res)))) results)))))) +;;; Define-Assembly-Routine -- Public +;;; +;;; Parse the code to produce an assembly routine and create a VOP +;;; that calls the assembly routine. (defmacro define-assembly-routine (name&options vars &rest code) + "Define-Assembly-Routine (Name&Options Vars Code*) + Define a Lisp assembly routine, and a VOP to that calls the assembly + routine, if enabled. (A VOP is not created if the reader + conditional #+assembler precedes the definition of the assembly + routine.) + + Name&Options + A list giving the name of the assembly routine and options + describing the assembly routine options and VOP options. The + format is (Name ({Key Value})*) where Name is the name of the + assembly routine. Options is a list of options: + + Options + + :Cost Cost + The cost of the VOP. This is used in the generated VOP. + + :Policy {:Small | :Fast | :Safe | :Fast-Safe} + The policy for the VOP. + + :Translate Name + The translation for the VOP. + + :Arg-Types arg-types + :Result-Types result-types + The template restrictions for the arguments of the VOP and the + results of the VOP. + + :Return-Style {:Raw :Full-Call :None} + + Vars is a list of the arguments and returned results and + temporaries used by the assembly routine. + + :Arg Arg-Name (SC*) SC-Offset + Input argument for the assembly routine with the name + Arg-Name. The argument must be one of the SC types. The register + assigned to this argument is given by SC-Offset which must be + the offset for the register holding this argument. + + :Res Res-Name SC SC-Offset + Result of the assembly routine with the name Res-Name. The + result must be a register of the specified storage class SC. The + Sc-offset is the register used for the result. + + :Temp Temp-Name SC SC-Offset + Like :Res, except this names a temporary register that the + assembly routine can use. + + Code + The code for the assembly routine." (multiple-value-bind (name options) (if (atom name&options) (values name&options nil) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/94a2c674d2a5cd3cc9e7e9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/94a2c674d2a5cd3cc9e7e9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-295-docstring-for-define-assembly-routine] Apply 1 suggestion(s) to 1 file(s)
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-295-docstring-for-define-assembly-routine at cmucl / cmucl Commits: bc64497d by Carl Shapiro at 2024-04-07T23:26:05+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - src/assembly/assemfile.lisp Changes: ===================================== src/assembly/assemfile.lisp ===================================== @@ -249,7 +249,7 @@ :Arg Arg-Name (SC*) SC-Offset Input argument for the assembly routine with the name - Arg-Name. The argument must be one of the Sc types. The register + Arg-Name. The argument must be one of the SC types. The register assigned to this argument is given by SC-Offset which must be the offset for the register holding this argument. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bc64497dc19a742601e1b75… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bc64497dc19a742601e1b75… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-295-docstring-for-define-assembly-routine] Apply 12 suggestion(s) to 1 file(s)
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-295-docstring-for-define-assembly-routine at cmucl / cmucl Commits: 7200acc8 by Carl Shapiro at 2024-04-07T23:22:29+00:00 Apply 12 suggestion(s) to 1 file(s) - - - - - 1 changed file: - src/assembly/assemfile.lisp Changes: ===================================== src/assembly/assemfile.lisp ===================================== @@ -209,18 +209,18 @@ ,(reg-spec-temp res)))) results)))))) -;;; Define-assembly-routine -- Public +;;; Define-Assembly-Routine -- Public ;;; ;;; Parse the code to produce an assembly routine and create a VOP ;;; that calls the assembly routine. (defmacro define-assembly-routine (name&options vars &rest code) - "Define-assembly-routine (name&options vars Code*) + "Define-Assembly-Routine (Name&Options Vars Code*) Define a Lisp assembly routine, and a VOP to that calls the assembly routine, if enabled. (A VOP is not created if the reader conditional #+assembler precedes the definition of the assembly routine.) - Name&options + Name&Options A list giving the name of the assembly routine and options describing the assembly routine options and VOP options. The format is (Name ({Key Value})*) where Name is the name of the @@ -231,11 +231,11 @@ :Cost Cost The cost of the VOP. This is used in the generated VOP. - :Policy Policy - The policy for the VOP + :Policy {:Small | :Fast | :Safe | :Fast-Safe} + The policy for the VOP. :Translate Name - The translation for the VOP + The translation for the VOP. :Arg-Types arg-types :Result-Types result-types @@ -247,19 +247,19 @@ Vars is a list of the arguments and returned results and temporaries used by the assembly routine. - :Arg Arg-name (Sc*) Sc-Offset + :Arg Arg-Name (SC*) SC-Offset Input argument for the assembly routine with the name Arg-Name. The argument must be one of the Sc types. The register - assigned to this argument is given by Sc-Offset which must be + assigned to this argument is given by SC-Offset which must be the offset for the register holding this argument. - :Res Res-Name Sc Sc-offset + :Res Res-Name SC SC-Offset Result of the assembly routine with the name Res-Name. The - result must be a register of the specified storage class Sc. The + result must be a register of the specified storage class SC. The Sc-offset is the register used for the result. - :Temp Temp-Name Sc Sc-offset - Like :res, except this names a temporary register that the + :Temp Temp-Name SC SC-Offset + Like :Res, except this names a temporary register that the assembly routine can use. Code View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7200acc8f06baf993172136… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7200acc8f06baf993172136… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-298-with-float-rounding-mode] Make variable names consistent.
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch issue-298-with-float-rounding-mode at cmucl / cmucl Commits: 6ba75434 by Carl Shapiro at 2024-04-07T23:19:27+00:00 Make variable names consistent. - - - - - 1 changed file: - src/code/float-trap.lisp Changes: ===================================== src/code/float-trap.lisp ===================================== @@ -512,7 +512,7 @@ Only the rounding mode is restored on exit; other floating-point modes are not modified. " - (let ((old-rounding-mode (gensym "OLD-ROUNDING-MODE-")) + (let ((old-mode (gensym "OLD-MODE-")) (new-mode (gensym "NEW-MODE-"))) `(let ((,old-rounding-mode (ldb float-rounding-mode (floating-point-modes))) (,new-mode (cdr (assoc ,rounding-mode rounding-mode-alist)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6ba754346e8ddf8a2457496… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6ba754346e8ddf8a2457496… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #300: Reduce code duplication in random
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: bb1bc462 by Raymond Toy at 2024-04-07T22:53:45+00:00 Fix #300: Reduce code duplication in random - - - - - 94a2c674 by Raymond Toy at 2024-04-07T22:53:51+00:00 Merge branch 'issue-300-reduce-code-dup-in-random' into 'master' Fix #300: Reduce code duplication in random Closes #300 See merge request cmucl/cmucl!206 - - - - - 2 changed files: - src/bootfiles/21e/boot-2023-08.lisp - src/code/rand-xoroshiro.lisp Changes: ===================================== src/bootfiles/21e/boot-2023-08.lisp ===================================== @@ -2,3 +2,46 @@ ;; *SOFTWARE-VERSION* from the LISP package to the SYSTEM package. (ext:without-package-locks (unintern 'lisp::*software-version* "LISP")) + +#+(or random-mt19937 random-xoroshiro) +(in-package "C") +#+(or random-mt19937 random-xoroshiro) +(deftransform random ((num &optional state) + ((integer 1 #.(expt 2 32)) &optional *)) + _N"use inline (unsigned-byte 32) operations" + (let* ((num-type (continuation-type num)) + (num-high (cond ((numeric-type-p num-type) + (numeric-type-high num-type)) + ((union-type-p num-type) + ;; Find the maximum of the union type. We + ;; know this works because if we're in this + ;; routine, NUM must be a subtype of + ;; (INTEGER 1 2^32), so each member of the + ;; union must be a subtype too. + (reduce #'max (union-type-types num-type) + :key #'numeric-type-high)) + (t + (give-up))))) + ;; Rather than doing (rem (random-chunk) num-high), we do, + ;; essentially, (rem (* num-high (random-chunk)) #x100000000). I + ;; (rtoy) believe this approach doesn't have the bias issue with + ;; doing rem. This method works by treating (random-chunk) as if + ;; it were a 32-bit fraction between 0 and 1, exclusive. Multiply + ;; this by num-high to get a random number between 0 and num-high, + ;; This should have no bias. + (cond ((constant-continuation-p num) + (if (= num-high (expt 2 32)) + '(random-chunk (or state *random-state*)) + '(values (bignum::%multiply + (random-chunk (or state *random-state*)) + num)))) + ((< num-high (expt 2 32)) + '(values (bignum::%multiply (random-chunk (or state *random-state*)) + num))) + ((= num-high (expt 2 32)) + '(if (= num (expt 2 32)) + (random-chunk (or state *random-state*)) + (values (bignum::%multiply (random-chunk (or state *random-state*)) + num)))) + (t + (error (intl:gettext "Shouldn't happen")))))) ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -490,11 +490,8 @@ (declare (inline %random-single-float %random-double-float)) (cond ((typep arg '(integer 1 #x100000000)) - ;; Do the same thing as the deftransform would do. - (if (= arg (expt 2 32)) - (random-chunk state) - (values (bignum::%multiply (random-chunk state) - arg)))) + ;; Let the compiler deftransform take care of this case. + (random arg state)) ((and (typep arg 'single-float) (> arg 0.0F0)) (%random-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0D0)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7bec290fda1c29972afe32… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7bec290fda1c29972afe32… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #297: Print new-assem:assemble with less indentation
by Raymond Toy (＠rtoy) 08 Apr '24

08 Apr '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 62631e15 by Raymond Toy at 2024-04-07T22:52:52+00:00 Fix #297: Print new-assem:assemble with less indentation - - - - - 7bec290f by Raymond Toy at 2024-04-07T22:53:01+00:00 Merge branch 'issue-297-pprint-assemble' into 'master' Fix #297: Print new-assem:assemble with less indentation Closes #297 See merge request cmucl/cmucl!203 - - - - - 3 changed files: - src/code/pprint.lisp - src/general-info/release-21f.md - tests/pprint.lisp Changes: ===================================== src/code/pprint.lisp ===================================== @@ -2088,6 +2088,7 @@ When annotations are present, invoke them at the right positions." (c:define-vop pprint-define-vop) (c:sc-case pprint-sc-case) (c:define-assembly-routine pprint-define-assembly) + (new-assem:assemble pprint-multiple-value-bind) (c:deftransform pprint-defun) (c:defoptimizer pprint-defun) (ext:with-float-traps-masked pprint-with-like) ===================================== src/general-info/release-21f.md ===================================== @@ -65,6 +65,7 @@ public domain. * ~~#288~~ Re-enable `deftransform` for random integers. * ~~#290~~ Pprint `with-float-traps-masked` better * ~~#291~~ Pprint `handler-case` neatly. + * ~~#297~~ Pprint `new-assem:assemble` with less indentation. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/pprint.lisp ===================================== @@ -121,3 +121,17 @@ (:no-error () (format nil "Nothing bad happened."))) s)))) + +(define-test pprint.assemble + (:tag :issues) + (assert-equal + " +(NEW-ASSEM:ASSEMBLE (C:*CODE-SEGMENT* 'X86::XOROSHIRO-UPDATE) + X86::XOROSHIRO-UPDATE + (PUSH (CONS 'X86::XOROSHIRO-UPDATE X86::XOROSHIRO-UPDATE) + C::*ASSEMBLER-ROUTINES*))" + (with-output-to-string (s) + (pprint '(new-assem:assemble (c::*code-segment* 'vm::xoroshiro-update) + vm::xoroshiro-update + (push (cons 'vm::xoroshiro-update vm::xoroshiro-update) c::*assembler-routines*)) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3cdf6b8fa3f23952a90f5c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3cdf6b8fa3f23952a90f5c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-293-restart-on-reader-fp-overflow] 2 commits: Update expected FP underflow message in reader
by Raymond Toy (＠rtoy) 07 Apr '24

07 Apr '24

Raymond Toy pushed to branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl Commits: 875638b6 by Raymond Toy at 2024-04-07T11:16:53-07:00 Update expected FP underflow message in reader We changed the message string for FP underflows in the reader so we need to update the test with this new string. - - - - - a7b57151 by Raymond Toy at 2024-04-07T11:22:19-07:00 Merge branch 'issue-275b-signal-float-underflow' into issue-293-restart-on-reader-fp-overflow - - - - - 1 changed file: - tests/float.lisp Changes: ===================================== tests/float.lisp ===================================== @@ -231,7 +231,7 @@ (:tag :issues) (lisp::with-float-traps-enabled (:underflow) ;; The expected string comes from make-float-aux. - (let ((expected "Floating point underflow when reading ~S")) + (let ((expected "Floating point underflow when reading ~S: ~S")) (flet ((test-reader-underflow (string) ;; Test that the we got a reader-error when a number ;; would underflow and that the message says we got an View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/d9a8993608611d809179b3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/d9a8993608611d809179b3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] Update expected FP underflow message in reader
by Raymond Toy (＠rtoy) 07 Apr '24

07 Apr '24

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl Commits: 875638b6 by Raymond Toy at 2024-04-07T11:16:53-07:00 Update expected FP underflow message in reader We changed the message string for FP underflows in the reader so we need to update the test with this new string. - - - - - 1 changed file: - tests/float.lisp Changes: ===================================== tests/float.lisp ===================================== @@ -231,7 +231,7 @@ (:tag :issues) (lisp::with-float-traps-enabled (:underflow) ;; The expected string comes from make-float-aux. - (let ((expected "Floating point underflow when reading ~S")) + (let ((expected "Floating point underflow when reading ~S: ~S")) (flet ((test-reader-underflow (string) ;; Test that the we got a reader-error when a number ;; would underflow and that the message says we got an View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/875638b6a1a7f7525e82045… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/875638b6a1a7f7525e82045… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-293-restart-on-reader-fp-overflow] 16 commits: Fix #287: Clean up make-float-aux
by Raymond Toy (＠rtoy) 07 Apr '24

07 Apr '24

Raymond Toy pushed to branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl Commits: f3e5a7e6 by Raymond Toy at 2024-03-23T12:13:54-07:00 Fix #287: Clean up make-float-aux We don't need to try to round small numbers to least positive float here. When #277 was fixed, this was taken care of. Hence we can remove all the code for that and just throw a reader-error immediately if the result is 0 but the number is not zero. - - - - - 9d01b5ca by Raymond Toy at 2024-03-23T12:38:44-07:00 Oops. Need handler-case to catch errors from large numbers. For large numbers that weren't caught the with the rough check, the conversion of the large ratio to a float signals a `simple-type-error` from `coerce`. We need to catch that and signal a `reader-error`. - - - - - 01857e1c by Raymond Toy at 2024-03-23T14:39:01-07:00 Fix #275: Signal underflow for denormals If the floating-point underflow trap is enabled, signal an underflow error when the number would underflow to a denormal. We still signal a reader-error if the number would not fit in a float. - - - - - 45532060 by Raymond Toy at 2024-03-23T14:56:58-07:00 Add tests for float underflows in the reader - - - - - 23f449e4 by Raymond Toy at 2024-03-26T07:46:47-07:00 Merge branch 'master' into issue-275b-signal-float-underflow - - - - - 488cbe98 by Raymond Toy at 2024-03-26T07:47:46-07:00 Add a comment about continuing with 0 - - - - - bb8eb44c by Raymond Toy at 2024-03-26T08:25:46-07:00 Fix bad merge Actually need to remove `with-float-traps-masked`. Duh! - - - - - ba400bf5 by Raymond Toy at 2024-03-29T07:11:07-07:00 Signal reader-error on underflow instead of FP underflow. The error message makes it clear we have a FP underflow like so: ``` * 1d-308 Reader error on #<Two-Way Stream, Input = #<Synonym Stream to SYSTEM:*STDIN*>, Output = #<Synonym Stream to SYSTEM:*STDOUT*>>: Underflow when reading "1d-308" [Condition of type READER-ERROR] Restarts: 0: [CONTINUE] Return 0.0d0 1: [ABORT ] Return to Top-Level. ``` - - - - - f3d64ced by Raymond Toy at 2024-03-29T07:16:02-07:00 Change message to mention floating point Instead of just saying "Underflow when reading...", say "Floating point underflow when reading..." to make it a bit clearer what happened. - - - - - 4ba5145d by Raymond Toy at 2024-03-29T07:20:32-07:00 Undo some space changes and correct a comment. Undo some tab vs space changes at the end of make-float-aux. The comment about double-float exponent range was in the wrong place so put it in the right place. - - - - - e1a35617 by Raymond Toy at 2024-03-29T07:55:55-07:00 Test FP underflow signals reader-error We now signal a `reader-error` on a FP underflow. Thus, test that we get a reader error. Also test that the message says we got an underflow. This is to verify that we tell the user that it's an underflow and not some other reader error. - - - - - 031b5ce0 by Raymond Toy at 2024-03-29T07:58:47-07:00 Update pot file for updated message string. - - - - - 047a0f08 by Raymond Toy at 2024-03-29T08:00:08-07:00 Add comment on where the expected string comes from. - - - - - ca07a140 by Raymond Toy at 2024-03-29T15:45:54-07:00 Merge branch 'master' into issue-275b-signal-float-underflow - - - - - 2eda1257 by Raymond Toy at 2024-04-07T10:50:22-07:00 Change underflow message to be a bit clearer Update the pot file due to the change in the message string. - - - - - d9a89936 by Raymond Toy at 2024-04-07T11:03:13-07:00 Merge branch 'issue-275b-signal-float-underflow' into issue-293-restart-on-reader-fp-overflow - - - - - 3 changed files: - src/code/reader.lisp - src/i18n/locale/cmucl.pot - tests/float.lisp Changes: ===================================== src/code/reader.lisp ===================================== @@ -1929,8 +1929,8 @@ the end of the stream." ;; 0. (let ((zero (coerce 0 float-format))) (restart-case - (%reader-error stream _"Floating point underflow when reading ~S" - (read-buffer-to-string)) + (%reader-error stream _"Floating point underflow when reading ~S: ~S" + float-format (read-buffer-to-string)) (continue () :report (lambda (stream) (format stream "Return ~A" zero)) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8736,7 +8736,7 @@ msgid "Underflow" msgstr "" #: src/code/reader.lisp -msgid "Floating point underflow when reading ~S" +msgid "Floating point underflow when reading ~S: ~S" msgstr "" #: src/code/reader.lisp ===================================== tests/float.lisp ===================================== @@ -213,6 +213,39 @@ (assert-error 'reader-error (read-from-string "1.8d308")) (assert-error 'reader-error (read-from-string "1d999999999"))) +(define-test reader.float-underflow + (:tag :issues) + (lisp::with-float-traps-enabled (:underflow) + ;; A denormal + (assert-error 'reader-error + (read-from-string "1e-40")) + (assert-error 'reader-error + (read-from-string (format nil "~A" least-positive-single-float))) + ;; The same for double-floats + (assert-error 'reader-error + (read-from-string "1d-308")) + (assert-error 'reader-error + (read-from-string (format nil "~A" least-positive-double-float))))) + +(define-test reader.float-underflow + (:tag :issues) + (lisp::with-float-traps-enabled (:underflow) + ;; The expected string comes from make-float-aux. + (let ((expected "Floating point underflow when reading ~S")) + (flet ((test-reader-underflow (string) + ;; Test that the we got a reader-error when a number + ;; would underflow and that the message says we got an + ;; underflow. + (let ((condition (nth-value 1 (ignore-errors (read-from-string string))))) + (assert-equal 'reader-error (type-of condition)) + (assert-equal expected (lisp::reader-error-format-control condition))))) + ;; Underflow single-floats + (test-reader-underflow "1e-40") + (test-reader-underflow (format nil "~A" least-positive-single-float)) + ;; Underflow double-floats + (test-reader-underflow "1d-308") + (test-reader-underflow (format nil "~A" least-positive-double-float)))))) + (define-test fp-overflow-restarts.infinity (:tag :issues) ;; Test that the "infinity" restart from reader on floating-point View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/deb940458edf3da1156447… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/deb940458edf3da1156447… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs