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

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] 6 commits: Fix #288: Re-enable deftransform for random integers
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl Commits: f6daa48c by Raymond Toy at 2024-03-29T13:17:17+00:00 Fix #288: Re-enable deftransform for random integers - - - - - 1bc97727 by Raymond Toy at 2024-03-29T13:18:30+00:00 Merge branch 'issue-288-re-enable-deftransform-random-int' into 'master' Fix #288: Re-enable deftransform for random integers Closes #288 See merge request cmucl/cmucl!198 - - - - - 3a206076 by Raymond Toy at 2024-03-29T15:43:02+00:00 Fix #291: pprint handler-case neatly - - - - - 7c6275a2 by Raymond Toy at 2024-03-29T15:43:03+00:00 Merge branch 'issue-291-pprint-handler-case' into 'master' Fix #291: pprint handler-case neatly Closes #291 See merge request cmucl/cmucl!200 - - - - - ca064da0 by Raymond Toy at 2024-03-29T08:56:28-07:00 Update notes with fixed issues Forgot to add #288, #290, and #291 to the list of fixed issues. - - - - - ca07a140 by Raymond Toy at 2024-03-29T15:45:54-07:00 Merge branch 'master' into issue-275b-signal-float-underflow - - - - - 7 changed files: - bin/run-ansi-tests.sh - src/code/pprint.lisp - src/compiler/float-tran.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl.pot - tests/pprint.lisp - tests/rng.lisp Changes: ===================================== bin/run-ansi-tests.sh ===================================== @@ -41,7 +41,7 @@ else fi cd ../ansi-test -git checkout cmucl-expected-failures +git checkout issue-288-new-failures make LISP="$LISP batch -noinit -nositeinit" # There should be no unexpected successes or failures; check these separately ===================================== src/code/pprint.lisp ===================================== @@ -1457,6 +1457,19 @@ When annotations are present, invoke them at the right positions." (declare (ignore noise)) (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~W~}~:>") stream list)) + +(defun pprint-handler-case (stream list &rest noise) + (declare (ignore noise)) + ;; Like pprint-handler-bind, but each of the error clauses is + ;; printed with declarations and forms on a separate line, indented + ;; like a function body. The handler-case part, "~:<~^~W~3I + ;; ~:_~W~1I~@{ ~:@_...~:>" comes from pprint-handler-bind, but the + ;; last "~W" is replaced to print out the error clauses in the way + ;; we want. These are done with "~:<~W~^~3I ~:_~W~^~1I~@{ + ;; ~@:_~W~}~:>", taken from PPRINT-WITH-LIKE. + (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~:<~W~^~3I ~:_~W~^~1I~@{ ~@:_~W~}~:>~}~:>") + stream list)) + (defun pprint-quote (stream list &rest noise) (declare (ignore noise)) @@ -2021,7 +2034,7 @@ When annotations are present, invoke them at the right positions." (ecase pprint-case) (etypecase pprint-typecase) (handler-bind pprint-handler-bind) - (handler-case pprint-handler-bind) + (handler-case pprint-handler-case) ;; Loop is handled by pprint-loop.lisp #+nil(loop pprint-loop) (multiple-value-bind pprint-multiple-value-bind) ===================================== src/compiler/float-tran.lisp ===================================== @@ -236,7 +236,7 @@ (frob %random-single-float single-float) (frob %random-double-float double-float)) -#-(or new-random random-mt19937 rand-xoroshiro) +#-(or new-random random-mt19937 random-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.random-fixnum-max) &optional *)) _N"use inline fixnum operations" @@ -259,7 +259,7 @@ '(values (truncate (%random-double-float (coerce num 'double-float) (or state *random-state*))))) -#+(or random-mt19937) +#+(or random-mt19937 random-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.(expt 2 32)) &optional *)) _N"use inline (unsigned-byte 32) operations" ===================================== src/general-info/release-21f.md ===================================== @@ -62,6 +62,9 @@ public domain. * ~~#278~~ Add some more debugging prints to gencgc * ~~#283~~ Add VOP for `integer-length` for `(unsigned-byte 32)` arg. * ~~#284~~ Microoptimize `signed-byte-32-int-len` VOP for x86. + * ~~#288~~ Re-enable `deftransform` for random integers. + * ~~#290~~ Pprint `with-float-traps-masked` better + * ~~#291~~ Pprint `handler-case` neatly. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -19005,6 +19005,10 @@ msgstr "" msgid "use inline (unsigned-byte 32) operations" msgstr "" +#: src/compiler/float-tran.lisp +msgid "Shouldn't happen" +msgstr "" + #: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" ===================================== tests/pprint.lisp ===================================== @@ -26,3 +26,98 @@ (pprint '(ext:with-float-traps-enabled (:underflow) (print "Hello")) s)))) + +(define-test pprint.handler-case.1 + (:tag :issues) + ;; Just an expression + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition)) + s)))) + +(define-test pprint.handler-case.2 + (:tag :issues) + ;; One error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\"))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.")) + s)))) + +(define-test pprint.handler-case.3 + (:tag :issues) + ;; More than one error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition))) + s)))) + +(define-test pprint.handler-case.4 + (:tag :issues) + ;; An expression and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + + +(define-test pprint.handler-case.5 + (:tag :issues) + ;; One error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + +(define-test pprint.handler-case.6 + (:tag :issues) + ;; More than one error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition)) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) ===================================== tests/rng.lisp ===================================== @@ -82,3 +82,27 @@ (assert-equal result (multiple-value-list (64-bit-rng-state *test-state*))))) +;; Test that the deftransform for random integers is working. +(defun rng-int-trans (state) + (declare (type random-state state) + (optimize (speed 3))) + (random 100000 state)) + +(defun rng-int (n state) + (declare (type random-state state)) + (random n state)) + +(define-test deftransform-random-int + (:tag :issues) + ;; Using the same state, generate a random integer with RNG-INT. + ;; This is the expected value. The generate an integer with + ;; RNG-INT-TRANS. The compiler should have used a deftransform in + ;; this function. The values returned should be the same. + (let ((state (kernel::make-random-object :state (kernel::init-random-state 31415926535)))) + (dotimes (k 2) + (print state) + (assert-equal (rng-int 100000 (make-random-state state)) + (rng-int-trans (make-random-state state))) + ;; Generate a random number to change our state. + (random 100000 state)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/047a0f088f75a6cb88e98e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/047a0f088f75a6cb88e98e… 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: Add tests for the FP overflow restarts from the reader
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl Commits: 142252fc by Raymond Toy at 2024-03-29T14:08:12-07:00 Add tests for the FP overflow restarts from the reader Verify that the two new restarts produce the correct values when selecting the "infinity" and "largest-float" restarts. - - - - - 9fe47ce1 by Raymond Toy at 2024-03-29T14:09:20-07:00 Update cmucl.pot for the new messages - - - - - 2 changed files: - src/i18n/locale/cmucl.pot - tests/float.lisp Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8728,13 +8728,21 @@ msgid "Internal error in floating point reader." msgstr "" #: src/code/reader.lisp -msgid "Number not representable as a ~S: ~S" +msgid "~S overflow reading ~S" msgstr "" #: src/code/reader.lisp msgid "Underflow" msgstr "" +#: src/code/reader.lisp +msgid "Floating point underflow when reading ~S" +msgstr "" + +#: src/code/reader.lisp +msgid "Number not representable as a ~S: ~S" +msgstr "" + #: src/code/reader.lisp msgid "Invalid ratio: ~S/~S" msgstr "" ===================================== tests/float.lisp ===================================== @@ -212,3 +212,50 @@ ;; most-positive-double-float. And a really big single-float. (assert-error 'reader-error (read-from-string "1.8d308")) (assert-error 'reader-error (read-from-string "1d999999999"))) + +(define-test fp-overflow-restarts.infinity + (:tag :issues) + ;; Test that the "infinity" restart from reader on floating-point + ;; overflow returns an infinity of the correct type and sign. + (dolist (item (list (list "4e38" ext:single-float-positive-infinity) + (list "-4e38" ext:single-float-negative-infinity) + (list "2d308" ext:double-float-positive-infinity) + (list "-2d308" ext:double-float-negative-infinity) + ;; These test the short-cut case in the reader for + ;; very large numbers. + (list "4e999" ext:single-float-positive-infinity) + (list "-4e999" ext:single-float-negative-infinity) + (list "1d999" ext:double-float-positive-infinity) + (list "-1d999" ext:double-float-negative-infinity))) + (destructuring-bind (string expected-result) + item + (assert-equal expected-result + (values (handler-bind ((reader-error + (lambda (c) + (declare (ignore c)) + (invoke-restart 'lisp::infinity)))) + (read-from-string string))))))) + +(define-test fp-overflow-restarts.huge + (:tag :issues) + ;; Test that the "largest-float" restart from reader on + ;; floating-point overflow returns the largest float of the correct + ;; type and sign. + (dolist (item (list (list "4e38" most-positive-single-float) + (list "-4e38" most-negative-single-float) + (list "2d308" most-positive-double-float) + (list "-2d308" most-negative-double-float) + ;; These test the short-cut case in the reader for + ;; very large numbers. + (list "4e999" most-positive-single-float) + (list "-4e999" most-negative-single-float) + (list "1d999" most-positive-double-float) + (list "-1d999" most-negative-double-float))) + (destructuring-bind (string expected-result) + item + (assert-equal expected-result + (handler-bind ((reader-error + (lambda (c) + (declare (ignore c)) + (values (invoke-restart 'lisp::largest-float))))) + (read-from-string string)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1a7b3a7ce614be51152e36… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1a7b3a7ce614be51152e36… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-293-restart-on-reader-fp-overflow
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed new branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-293-restart-on-read… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update notes with fixed issues
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: ca064da0 by Raymond Toy at 2024-03-29T08:56:28-07:00 Update notes with fixed issues Forgot to add #288, #290, and #291 to the list of fixed issues. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -62,6 +62,9 @@ public domain. * ~~#278~~ Add some more debugging prints to gencgc * ~~#283~~ Add VOP for `integer-length` for `(unsigned-byte 32)` arg. * ~~#284~~ Microoptimize `signed-byte-32-int-len` VOP for x86. + * ~~#288~~ Re-enable `deftransform` for random integers. + * ~~#290~~ Pprint `with-float-traps-masked` better + * ~~#291~~ Pprint `handler-case` neatly. * 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/ca064da0edb5ba58d8bf4bc… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ca064da0edb5ba58d8bf4bc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #291: pprint handler-case neatly
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 3a206076 by Raymond Toy at 2024-03-29T15:43:02+00:00 Fix #291: pprint handler-case neatly - - - - - 7c6275a2 by Raymond Toy at 2024-03-29T15:43:03+00:00 Merge branch 'issue-291-pprint-handler-case' into 'master' Fix #291: pprint handler-case neatly Closes #291 See merge request cmucl/cmucl!200 - - - - - 3 changed files: - src/code/pprint.lisp - src/i18n/locale/cmucl.pot - tests/pprint.lisp Changes: ===================================== src/code/pprint.lisp ===================================== @@ -1457,6 +1457,19 @@ When annotations are present, invoke them at the right positions." (declare (ignore noise)) (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~W~}~:>") stream list)) + +(defun pprint-handler-case (stream list &rest noise) + (declare (ignore noise)) + ;; Like pprint-handler-bind, but each of the error clauses is + ;; printed with declarations and forms on a separate line, indented + ;; like a function body. The handler-case part, "~:<~^~W~3I + ;; ~:_~W~1I~@{ ~:@_...~:>" comes from pprint-handler-bind, but the + ;; last "~W" is replaced to print out the error clauses in the way + ;; we want. These are done with "~:<~W~^~3I ~:_~W~^~1I~@{ + ;; ~@:_~W~}~:>", taken from PPRINT-WITH-LIKE. + (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~:<~W~^~3I ~:_~W~^~1I~@{ ~@:_~W~}~:>~}~:>") + stream list)) + (defun pprint-quote (stream list &rest noise) (declare (ignore noise)) @@ -2021,7 +2034,7 @@ When annotations are present, invoke them at the right positions." (ecase pprint-case) (etypecase pprint-typecase) (handler-bind pprint-handler-bind) - (handler-case pprint-handler-bind) + (handler-case pprint-handler-case) ;; Loop is handled by pprint-loop.lisp #+nil(loop pprint-loop) (multiple-value-bind pprint-multiple-value-bind) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8731,6 +8731,10 @@ msgstr "" msgid "Number not representable as a ~S: ~S" msgstr "" +#: src/code/reader.lisp +msgid "Underflow" +msgstr "" + #: src/code/reader.lisp msgid "Invalid ratio: ~S/~S" msgstr "" ===================================== tests/pprint.lisp ===================================== @@ -26,3 +26,98 @@ (pprint '(ext:with-float-traps-enabled (:underflow) (print "Hello")) s)))) + +(define-test pprint.handler-case.1 + (:tag :issues) + ;; Just an expression + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition)) + s)))) + +(define-test pprint.handler-case.2 + (:tag :issues) + ;; One error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\"))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.")) + s)))) + +(define-test pprint.handler-case.3 + (:tag :issues) + ;; More than one error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition))) + s)))) + +(define-test pprint.handler-case.4 + (:tag :issues) + ;; An expression and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + + +(define-test pprint.handler-case.5 + (:tag :issues) + ;; One error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + +(define-test pprint.handler-case.6 + (:tag :issues) + ;; More than one error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition)) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1bc977276cfcbcf56e38bd… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1bc977276cfcbcf56e38bd… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-291-pprint-handler-case] Add a several smaller test cases for handler-case as requested
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch issue-291-pprint-handler-case at cmucl / cmucl Commits: ac5dde80 by Raymond Toy at 2024-03-29T08:25:47-07:00 Add a several smaller test cases for handler-case as requested - - - - - 1 changed file: - tests/pprint.lisp Changes: ===================================== tests/pprint.lisp ===================================== @@ -27,26 +27,97 @@ (print "Hello")) s)))) -(define-test pprint.handler-case +(define-test pprint.handler-case.1 (:tag :issues) + ;; Just an expression (assert-equal -" + " +(HANDLER-CASE (SIGNAL CONDITION))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition)) + s)))) + +(define-test pprint.handler-case.2 + (:tag :issues) + ;; One error clause + (assert-equal + " (HANDLER-CASE (SIGNAL CONDITION) (WARNING NIL - \"Lots of smoke, but no fire.\") - ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) - (FORMAT NIL \"~S looks especially bad.\" CONDITION)) - (SERIOUS-CONDITION (CONDITION) - (FORMAT NIL \"~S looks serious.\" CONDITION)) - (CONDITION NIL - \"Hardly worth mentioning.\"))" + \"Lots of smoke, but no fire.\"))" (with-output-to-string (s) (pprint '(handler-case (signal condition) - (warning () "Lots of smoke, but no fire.") - ((or arithmetic-error control-error cell-error stream-error) - (condition) - (format nil "~S looks especially bad." condition)) - (serious-condition (condition) - (format nil "~S looks serious." condition)) - (condition () "Hardly worth mentioning.")) + (warning () "Lots of smoke, but no fire.")) s)))) + +(define-test pprint.handler-case.3 + (:tag :issues) + ;; More than one error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition))) + s)))) + +(define-test pprint.handler-case.4 + (:tag :issues) + ;; An expression and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + + +(define-test pprint.handler-case.5 + (:tag :issues) + ;; One error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + +(define-test pprint.handler-case.6 + (:tag :issues) + ;; More than one error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + \"Lots of smoke, but no fire.\") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL \"~S looks especially bad.\" CONDITION)) + (:NO-ERROR NIL + (FORMAT NIL \"Nothing bad happened.\")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition)) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ac5dde808d1f1332da7268d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ac5dde808d1f1332da7268d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] 6 commits: Signal reader-error on underflow instead of FP underflow.
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl Commits: 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. - - - - - 3 changed files: - src/code/reader.lisp - src/i18n/locale/cmucl.pot - tests/float.lisp Changes: ===================================== src/code/reader.lisp ===================================== @@ -1855,12 +1855,12 @@ the end of the stream." vm:single-float-bias)))) ((double-float long-float #+double-double kernel:double-double-float) + ;; Double-float exponent range is -1074 to -1023 (values (* 2 (- vm:double-float-normal-exponent-min vm:double-float-bias vm:double-float-digits)) (* 2 (- vm:double-float-normal-exponent-max vm:double-float-bias))))) - ;; Double-float exponent range is -1074 to -1023 (unless (< log2-low log2-num log2-high) ;; The number is definitely too large or too small to fit. ;; Signal an error. @@ -1879,18 +1879,19 @@ the end of the stream." (error _"Underflow")) result) (floating-point-underflow () - ;; Resignal the underflow, but allow the user to continue with + ;; Resignal a reader error, but allow the user to continue with ;; 0. (let ((zero (coerce 0 float-format))) (restart-case - (error 'floating-point-underflow) + (%reader-error stream _"Floating point underflow when reading ~S" + (read-buffer-to-string)) (continue () :report (lambda (stream) (format stream "Return ~A" zero)) zero)))) (error () - (%reader-error stream _"Number not representable as a ~S: ~S" - float-format (read-buffer-to-string))))) + (%reader-error stream _"Number not representable as a ~S: ~S" + float-format (read-buffer-to-string))))) (defun make-ratio (stream) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8731,6 +8731,14 @@ msgstr "" msgid "Number not representable as a ~S: ~S" msgstr "" +#: src/code/reader.lisp +msgid "Underflow" +msgstr "" + +#: src/code/reader.lisp +msgid "Floating point underflow when reading ~S" +msgstr "" + #: src/code/reader.lisp msgid "Invalid ratio: ~S/~S" msgstr "" ===================================== tests/float.lisp ===================================== @@ -217,12 +217,31 @@ (:tag :issues) (lisp::with-float-traps-enabled (:underflow) ;; A denormal - (assert-error 'floating-point-underflow + (assert-error 'reader-error (read-from-string "1e-40")) - (assert-error 'floating-point-underflow + (assert-error 'reader-error (read-from-string (format nil "~A" least-positive-single-float))) ;; The same for double-floats - (assert-error 'floating-point-underflow + (assert-error 'reader-error (read-from-string "1d-308")) - (assert-error 'floating-point-underflow + (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)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bb8eb44c424cc0ab2dba0e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bb8eb44c424cc0ab2dba0e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #288: Re-enable deftransform for random integers
by Raymond Toy (＠rtoy) 29 Mar '24

29 Mar '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f6daa48c by Raymond Toy at 2024-03-29T13:17:17+00:00 Fix #288: Re-enable deftransform for random integers - - - - - 1bc97727 by Raymond Toy at 2024-03-29T13:18:30+00:00 Merge branch 'issue-288-re-enable-deftransform-random-int' into 'master' Fix #288: Re-enable deftransform for random integers Closes #288 See merge request cmucl/cmucl!198 - - - - - 4 changed files: - bin/run-ansi-tests.sh - src/compiler/float-tran.lisp - src/i18n/locale/cmucl.pot - tests/rng.lisp Changes: ===================================== bin/run-ansi-tests.sh ===================================== @@ -41,7 +41,7 @@ else fi cd ../ansi-test -git checkout cmucl-expected-failures +git checkout issue-288-new-failures make LISP="$LISP batch -noinit -nositeinit" # There should be no unexpected successes or failures; check these separately ===================================== src/compiler/float-tran.lisp ===================================== @@ -236,7 +236,7 @@ (frob %random-single-float single-float) (frob %random-double-float double-float)) -#-(or new-random random-mt19937 rand-xoroshiro) +#-(or new-random random-mt19937 random-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.random-fixnum-max) &optional *)) _N"use inline fixnum operations" @@ -259,7 +259,7 @@ '(values (truncate (%random-double-float (coerce num 'double-float) (or state *random-state*))))) -#+(or random-mt19937) +#+(or random-mt19937 random-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.(expt 2 32)) &optional *)) _N"use inline (unsigned-byte 32) operations" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -18997,6 +18997,10 @@ msgstr "" msgid "use inline (unsigned-byte 32) operations" msgstr "" +#: src/compiler/float-tran.lisp +msgid "Shouldn't happen" +msgstr "" + #: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" ===================================== tests/rng.lisp ===================================== @@ -82,3 +82,27 @@ (assert-equal result (multiple-value-list (64-bit-rng-state *test-state*))))) +;; Test that the deftransform for random integers is working. +(defun rng-int-trans (state) + (declare (type random-state state) + (optimize (speed 3))) + (random 100000 state)) + +(defun rng-int (n state) + (declare (type random-state state)) + (random n state)) + +(define-test deftransform-random-int + (:tag :issues) + ;; Using the same state, generate a random integer with RNG-INT. + ;; This is the expected value. The generate an integer with + ;; RNG-INT-TRANS. The compiler should have used a deftransform in + ;; this function. The values returned should be the same. + (let ((state (kernel::make-random-object :state (kernel::init-random-state 31415926535)))) + (dotimes (k 2) + (print state) + (assert-equal (rng-int 100000 (make-random-state state)) + (rng-int-trans (make-random-state state))) + ;; Generate a random number to change our state. + (random 100000 state)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8ed3d1d3bf250cfe50691e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8ed3d1d3bf250cfe50691e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-288-re-enable-deftransform-random-int] Checkout ansi-test issue-288-new-failures
by Raymond Toy (＠rtoy) 27 Mar '24

27 Mar '24

Raymond Toy pushed to branch issue-288-re-enable-deftransform-random-int at cmucl / cmucl Commits: 23c5bc24 by Raymond Toy at 2024-03-27T10:40:24-07:00 Checkout ansi-test issue-288-new-failures We have new failures in ansi-tests. Checkout the ansi-test branch that has the new failures listed. - - - - - 1 changed file: - bin/run-ansi-tests.sh Changes: ===================================== bin/run-ansi-tests.sh ===================================== @@ -41,7 +41,7 @@ else fi cd ../ansi-test -git checkout cmucl-expected-failures +git checkout issue-288-new-failures make LISP="$LISP batch -noinit -nositeinit" # There should be no unexpected successes or failures; check these separately View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/23c5bc242a62fa40f271057… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/23c5bc242a62fa40f271057… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] Fix bad merge
by Raymond Toy (＠rtoy) 26 Mar '24

26 Mar '24

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl Commits: bb8eb44c by Raymond Toy at 2024-03-26T08:25:46-07:00 Fix bad merge Actually need to remove `with-float-traps-masked`. Duh! - - - - - 1 changed file: - src/code/reader.lisp Changes: ===================================== src/code/reader.lisp ===================================== @@ -1869,16 +1869,15 @@ the end of the stream." ;; Otherwise the number might fit, so we carefully compute the result. (handler-case - (with-float-traps-masked (:underflow) - (let* ((ratio (/ (* (expt 10 exponent) number) - divisor)) - (result (coerce ratio float-format))) - (when (and (zerop result) (not (zerop number))) - ;; The number we've read is so small that it gets - ;; converted to 0.0, but is not actually zero. Signal an - ;; error. See CLHS 2.3.1.1. - (error _"Underflow")) - result)) + (let* ((ratio (/ (* (expt 10 exponent) number) + divisor)) + (result (coerce ratio float-format))) + (when (and (zerop result) (not (zerop number))) + ;; The number we've read is so small that it gets + ;; converted to 0.0, but is not actually zero. Signal an + ;; error. See CLHS 2.3.1.1. + (error _"Underflow")) + result) (floating-point-underflow () ;; Resignal the underflow, but allow the user to continue with ;; 0. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bb8eb44c424cc0ab2dba0e4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bb8eb44c424cc0ab2dba0e4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0