From cc4193e93f405e6c18e1b85160ee988502ac8fb5 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Sun, 24 Mar 2024 16:06:26 -0700 Subject: [PATCH 1/2] Fix #290: Neatly pprint with-float-traps-masked and friends Make the pprinter print `with-float-traps-masked` and `with-float-traps-enabled` in the same was as typical `with-foo` forms. We can do this by using existing `pprint-with-like` function. Add a couple of tests for this as well in tests/pprint.lisp. --- src/code/pprint.lisp | 4 +++- tests/pprint.lisp | 53 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 1 deletion(-) create mode 100644 tests/pprint.lisp diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp index f624be4a1..77f660e62 100644 --- a/src/code/pprint.lisp +++ b/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)) diff --git a/tests/pprint.lisp b/tests/pprint.lisp new file mode 100644 index 000000000..e67d0f613 --- /dev/null +++ b/tests/pprint.lisp @@ -0,0 +1,53 @@ +;; 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) + (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))" + (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)) + s)))) + +(define-test pprint.with-float-traps-enabled + (:tag :issues) + (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))" + (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)) + s)))) + + + -- GitLab From 8377885822cc4d08f760b5423ea1614bb89a07e3 Mon Sep 17 00:00:00 2001 From: Raymond Toy Date: Mon, 25 Mar 2024 07:14:46 -0700 Subject: [PATCH 2/2] 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. --- tests/pprint.lisp | 33 ++++----------------------------- 1 file changed, 4 insertions(+), 29 deletions(-) diff --git a/tests/pprint.lisp b/tests/pprint.lisp index e67d0f613..dd87307a4 100644 --- a/tests/pprint.lisp +++ b/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)))) - - - -- GitLab