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/047a0f088f75a6cb88e98e9...