![](https://secure.gravatar.com/avatar/5634a99cd64dd70d4a6692c3031a1284.jpg?s=120&d=mm&r=g)
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/ad88cf6367efa2a53a2b430... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ad88cf6367efa2a53a2b430... You're receiving this email because of your account on gitlab.common-lisp.net.
participants (1)
-
Raymond Toy (@rtoy)