Commit cc4193e9 authored by Raymond Toy's avatar Raymond Toy
Browse files

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

src/code/pprint.lisp

+3 −1
Original line number Diff line number Diff line
@@ -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 → 100644
+53 −0
Original line number Diff line number Diff line 
;; 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))))