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...