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

[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

[Git][cmucl/cmucl][issue-275b-signal-float-underflow] 6 commits: Fix #287: Clean up make-float-aux
by Raymond Toy (＠rtoy) 26 Mar '24

26 Mar '24

Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl Commits: 059069f8 by Raymond Toy at 2024-03-24T23:16:11+00:00 Fix #287: Clean up make-float-aux - - - - - ad88cf63 by Raymond Toy at 2024-03-24T23:16:13+00:00 Merge branch 'issue-287-clean-up-make-float-aux' into 'master' Fix #287: Clean up make-float-aux Closes #287 See merge request cmucl/cmucl!196 - - - - - e2c9eeea by Raymond Toy at 2024-03-25T14:33:02+00:00 Fix #290: Neatly pprint with-float-traps-masked and friends - - - - - 8ed3d1d3 by Raymond Toy at 2024-03-25T14:33:07+00:00 Merge branch 'issue-290-pprint-with-float-traps' into 'master' Fix #290: Neatly pprint with-float-traps-masked and friends Closes #290 See merge request cmucl/cmucl!199 - - - - - 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 - - - - - 3 changed files: - src/code/pprint.lisp - src/code/reader.lisp - + tests/pprint.lisp Changes: ===================================== src/code/pprint.lisp ===================================== @@ -2076,7 +2076,9 @@ When annotations are present, invoke them at the right positions." (c:sc-case pprint-sc-case) (c:define-assembly-routine pprint-define-assembly) (c:deftransform pprint-defun) - (c:defoptimizer pprint-defun))) + (c:defoptimizer pprint-defun) + (ext:with-float-traps-masked pprint-with-like) + (ext:with-float-traps-enabled pprint-with-like))) (defun pprint-init () (setf *initial-pprint-dispatch* (make-pprint-dispatch-table)) ===================================== src/code/reader.lisp ===================================== @@ -1868,17 +1868,20 @@ the end of the stream." float-format (read-buffer-to-string))))))) ;; Otherwise the number might fit, so we carefully compute the result. - (handler-case - (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) + (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)) (floating-point-underflow () + ;; Resignal the underflow, but allow the user to continue with + ;; 0. (let ((zero (coerce 0 float-format))) (restart-case (error 'floating-point-underflow) ===================================== tests/pprint.lisp ===================================== @@ -0,0 +1,28 @@ +;; Tests for pprinter + +(defpackage :pprint-tests + (:use :cl :lisp-unit)) + +(in-package "PPRINT-TESTS") + +(define-test pprint.with-float-traps-masked + (:tag :issues) + (assert-equal +" +(WITH-FLOAT-TRAPS-MASKED (:UNDERFLOW) + (PRINT \"Hello\"))" + (with-output-to-string (s) + (pprint '(ext:with-float-traps-masked (:underflow) + (print "Hello")) + s)))) + +(define-test pprint.with-float-traps-enabled + (:tag :issues) + (assert-equal +" +(WITH-FLOAT-TRAPS-ENABLED (:UNDERFLOW) + (PRINT \"Hello\"))" + (with-output-to-string (s) + (pprint '(ext:with-float-traps-enabled (:underflow) + (print "Hello")) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/45532060060f711842edbf… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/45532060060f711842edbf… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-291-pprint-handler-case] 4 commits: Fix #290: Neatly pprint with-float-traps-masked and friends
by Raymond Toy (＠rtoy) 25 Mar '24

25 Mar '24

Raymond Toy pushed to branch issue-291-pprint-handler-case at cmucl / cmucl Commits: e2c9eeea by Raymond Toy at 2024-03-25T14:33:02+00:00 Fix #290: Neatly pprint with-float-traps-masked and friends - - - - - 8ed3d1d3 by Raymond Toy at 2024-03-25T14:33:07+00:00 Merge branch 'issue-290-pprint-with-float-traps' into 'master' Fix #290: Neatly pprint with-float-traps-masked and friends Closes #290 See merge request cmucl/cmucl!199 - - - - - e35e7327 by Raymond Toy at 2024-03-25T07:39:35-07:00 Merge branch 'master' into issue-291-pprint-handler-case - - - - - 41522236 by Raymond Toy at 2024-03-25T08:16:46-07:00 Fix up typos in comments - - - - - 2 changed files: - src/code/pprint.lisp - tests/pprint.lisp Changes: ===================================== src/code/pprint.lisp ===================================== @@ -1460,8 +1460,8 @@ When annotations are present, invoke them at the right positions." (defun pprint-handler-case (stream list &rest noise) (declare (ignore noise)) - ;; Like pprint-handler-bind, but the each of the error clauses is - ;; printed with declaractions and forms on a separate line, indented + ;; 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 @@ -2089,7 +2089,9 @@ When annotations are present, invoke them at the right positions." (c:sc-case pprint-sc-case) (c:define-assembly-routine pprint-define-assembly) (c:deftransform pprint-defun) - (c:defoptimizer pprint-defun))) + (c:defoptimizer pprint-defun) + (ext:with-float-traps-masked pprint-with-like) + (ext:with-float-traps-enabled pprint-with-like))) (defun pprint-init () (setf *initial-pprint-dispatch* (make-pprint-dispatch-table)) ===================================== tests/pprint.lisp ===================================== @@ -10,21 +10,10 @@ (assert-equal " (WITH-FLOAT-TRAPS-MASKED (:UNDERFLOW) - (LET* ((RATIO - (/ (* (EXPT 10 PPRINT-TESTS::EXPONENT) NUMBER) - PPRINT-TESTS::DIVISOR)) - (PPRINT-TESTS::RESULT (COERCE RATIO PPRINT-TESTS::FLOAT-FORMAT))) - (WHEN (AND (ZEROP PPRINT-TESTS::RESULT) (NOT (ZEROP NUMBER))) - (ERROR \"Underflow\")) - PPRINT-TESTS::RESULT))" + (PRINT \"Hello\"))" (with-output-to-string (s) (pprint '(ext:with-float-traps-masked (:underflow) - (let* ((ratio (/ (* (expt 10 exponent) number) - divisor)) - (result (coerce ratio float-format))) - (when (and (zerop result) (not (zerop number))) - (error "Underflow")) - result)) + (print "Hello")) s)))) (define-test pprint.with-float-traps-enabled @@ -32,21 +21,10 @@ (assert-equal " (WITH-FLOAT-TRAPS-ENABLED (:UNDERFLOW) - (LET* ((RATIO - (/ (* (EXPT 10 PPRINT-TESTS::EXPONENT) NUMBER) - PPRINT-TESTS::DIVISOR)) - (PPRINT-TESTS::RESULT (COERCE RATIO PPRINT-TESTS::FLOAT-FORMAT))) - (WHEN (AND (ZEROP PPRINT-TESTS::RESULT) (NOT (ZEROP NUMBER))) - (ERROR \"Underflow\")) - PPRINT-TESTS::RESULT))" + (PRINT \"Hello\"))" (with-output-to-string (s) (pprint '(ext:with-float-traps-enabled (:underflow) - (let* ((ratio (/ (* (expt 10 exponent) number) - divisor)) - (result (coerce ratio float-format))) - (when (and (zerop result) (not (zerop number))) - (error "Underflow")) - result)) + (print "Hello")) s)))) (define-test pprint.handler-case View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2f62e54cd7d4de4b46b841… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2f62e54cd7d4de4b46b841… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #290: Neatly pprint with-float-traps-masked and friends
by Raymond Toy (＠rtoy) 25 Mar '24

25 Mar '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: e2c9eeea by Raymond Toy at 2024-03-25T14:33:02+00:00 Fix #290: Neatly pprint with-float-traps-masked and friends - - - - - 8ed3d1d3 by Raymond Toy at 2024-03-25T14:33:07+00:00 Merge branch 'issue-290-pprint-with-float-traps' into 'master' Fix #290: Neatly pprint with-float-traps-masked and friends Closes #290 See merge request cmucl/cmucl!199 - - - - - 2 changed files: - src/code/pprint.lisp - + tests/pprint.lisp Changes: ===================================== src/code/pprint.lisp ===================================== @@ -2076,7 +2076,9 @@ When annotations are present, invoke them at the right positions." (c:sc-case pprint-sc-case) (c:define-assembly-routine pprint-define-assembly) (c:deftransform pprint-defun) - (c:defoptimizer pprint-defun))) + (c:defoptimizer pprint-defun) + (ext:with-float-traps-masked pprint-with-like) + (ext:with-float-traps-enabled pprint-with-like))) (defun pprint-init () (setf *initial-pprint-dispatch* (make-pprint-dispatch-table)) ===================================== tests/pprint.lisp ===================================== @@ -0,0 +1,28 @@ +;; Tests for pprinter + +(defpackage :pprint-tests + (:use :cl :lisp-unit)) + +(in-package "PPRINT-TESTS") + +(define-test pprint.with-float-traps-masked + (:tag :issues) + (assert-equal +" +(WITH-FLOAT-TRAPS-MASKED (:UNDERFLOW) + (PRINT \"Hello\"))" + (with-output-to-string (s) + (pprint '(ext:with-float-traps-masked (:underflow) + (print "Hello")) + s)))) + +(define-test pprint.with-float-traps-enabled + (:tag :issues) + (assert-equal +" +(WITH-FLOAT-TRAPS-ENABLED (:UNDERFLOW) + (PRINT \"Hello\"))" + (with-output-to-string (s) + (pprint '(ext:with-float-traps-enabled (:underflow) + (print "Hello")) + s)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ad88cf6367efa2a53a2b43… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ad88cf6367efa2a53a2b43… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-290-pprint-with-float-traps] Use simpler forms for tests
by Raymond Toy (＠rtoy) 25 Mar '24

25 Mar '24

Raymond Toy pushed to branch issue-290-pprint-with-float-traps at cmucl / cmucl Commits: 83778858 by Raymond Toy at 2024-03-25T07:14:46-07:00 Use simpler forms for tests Don't use a real example for the tests; replace the body with a simple print to reduce the chance of failures due to other pprint changes. - - - - - 1 changed file: - tests/pprint.lisp Changes: ===================================== tests/pprint.lisp ===================================== @@ -10,21 +10,10 @@ (assert-equal " (WITH-FLOAT-TRAPS-MASKED (:UNDERFLOW) - (LET* ((RATIO - (/ (* (EXPT 10 PPRINT-TESTS::EXPONENT) NUMBER) - PPRINT-TESTS::DIVISOR)) - (PPRINT-TESTS::RESULT (COERCE RATIO PPRINT-TESTS::FLOAT-FORMAT))) - (WHEN (AND (ZEROP PPRINT-TESTS::RESULT) (NOT (ZEROP NUMBER))) - (ERROR \"Underflow\")) - PPRINT-TESTS::RESULT))" + (PRINT \"Hello\"))" (with-output-to-string (s) (pprint '(ext:with-float-traps-masked (:underflow) - (let* ((ratio (/ (* (expt 10 exponent) number) - divisor)) - (result (coerce ratio float-format))) - (when (and (zerop result) (not (zerop number))) - (error "Underflow")) - result)) + (print "Hello")) s)))) (define-test pprint.with-float-traps-enabled @@ -32,22 +21,8 @@ (assert-equal " (WITH-FLOAT-TRAPS-ENABLED (:UNDERFLOW) - (LET* ((RATIO - (/ (* (EXPT 10 PPRINT-TESTS::EXPONENT) NUMBER) - PPRINT-TESTS::DIVISOR)) - (PPRINT-TESTS::RESULT (COERCE RATIO PPRINT-TESTS::FLOAT-FORMAT))) - (WHEN (AND (ZEROP PPRINT-TESTS::RESULT) (NOT (ZEROP NUMBER))) - (ERROR \"Underflow\")) - PPRINT-TESTS::RESULT))" + (PRINT \"Hello\"))" (with-output-to-string (s) (pprint '(ext:with-float-traps-enabled (:underflow) - (let* ((ratio (/ (* (expt 10 exponent) number) - divisor)) - (result (coerce ratio float-format))) - (when (and (zerop result) (not (zerop number))) - (error "Underflow")) - result)) + (print "Hello")) s)))) - - - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8377885822cc4d08f760b54… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8377885822cc4d08f760b54… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-291-pprint-handler-case
by Raymond Toy (＠rtoy) 25 Mar '24

25 Mar '24

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

1 0