Commit 23f449e4 authored by Raymond Toy's avatar Raymond Toy
Browse files

Merge branch 'master' into issue-275b-signal-float-underflow

parents 45532060 8ed3d1d3
Loading
Loading
Loading
Loading
+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))
+11 −10
Original line number Diff line number Diff line
@@ -1869,6 +1869,7 @@ 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)))
@@ -1876,8 +1877,8 @@ the end of the stream."
	    ;; 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)
            (error _"Underflow"))
          result))
    (floating-point-underflow ()
      (let ((zero (coerce 0 float-format)))
        (restart-case

tests/pprint.lisp

0 → 100644
+28 −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)
  (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))))