GitLab

at 2026-05-28T07:23:00-07:00

Round ~F to width when d is unspecified

`format-f-free` emitted the un-rounded shortest form when it didn't
fit in the field width of w.  Add `emit-rounded-to-width`: round to
the fractional digits that fit, always showing at least one (CLHS
22.3.3.1), dropping the leading zero to fit.  Fixes ansi-tests
FORMAT.F.45 and F.47.

Tests in ryu.lisp also updated because they erroneously used the
un-rounded result instead of one that fits in the specified width.

@@ -491,24 +491,79 @@
               (int-len     (max 1 (1+ exponent)))
               (shortest-d  (max 0 (- digit-count 1 exponent)))
               (sign-len    (if (or is-negative-p at-sign-p) 1 0))
 -             (d-fit       (and w (- w sign-len int-len 1))))
 +             (d-fit       (and w (- w sign-len int-len 1)))
 +	     ;; When the magnitude is < 1 the integer part is a single
 +	     ;; "0" that may be dropped (the leading zero is optional),
 +	     ;; freeing one more slot for a fractional digit.  Compute
 +	     ;; the fractional-digit count that exactly fills W under
 +	     ;; that rule.
 +	     (frac-fit (and w
 +			    (if (plusp (1+ exponent))
 +				(- w sign-len int-len 1)	; "[int]."
 +				(- w sign-len 1)))))		; ".[frac]"
  	(cond
            ((or (null w) (>= d-fit shortest-d))
 -	   ;; No width or the shortest form fits within a field width
 -	   ;; of W.
 +	   ;; No width, or the shortest round-trip form already fits
 +	   ;; within a field width of W.  Emit it directly.
             (emit-shortest stream mantissa exponent is-negative-p w
                            overflowchar padchar at-sign-p))
 -	  (overflowchar
 -	   ;; Shortest form does not fit and OVERFLOWCHAR is set; fill
 -	   ;; the field with overflow characters.
 +	  ((and overflowchar (minusp frac-fit))
 +	   ;; Not even the integer part and decimal point fit, and an
 +	   ;; overflow character was supplied: fill the field.
  	   (loop repeat w
  		 do (write-char overflowchar stream)))
  	  (t
 -	   ;; Shortest form does not fit and no OVERFLOWCHAR; emit the
 -	   ;; full shortest form, letting the field expand.  CLHS
 -	   ;; 22.3.3.1 requires this.
 -	   (emit-shortest stream mantissa exponent is-negative-p w
 -			  overflowchar padchar at-sign-p)))))))
 +	   ;; The shortest form does not fit in W.  D was not specified,
 +	   ;; so round the value to the largest number of fractional
 +	   ;; digits FRAC-FIT that fits, then display it.  Per CLHS
 +	   ;; 22.3.3.1, if the fraction rounds away to nothing a single
 +	   ;; zero digit must still appear after the decimal point.  We
 +	   ;; therefore round at FRAC-FIT places (which may be 0) but
 +	   ;; always show at least one fractional digit.
 +	   (emit-rounded-to-width stream value (max 0 frac-fit)
 +				  is-negative-p w
 +				  overflowchar padchar at-sign-p)))))))
++
 +(defun emit-rounded-to-width (stream value frac is-negative-p w
 +			      overflowchar padchar at-sign-p)
 +  "Round (the magnitude of) VALUE to FRAC fractional digits with
 +   d2fixed and write it right-justified in a field of width W.  At
 +   least one fractional digit is always shown: if FRAC is 0 the
 +   rounded value is integral and a single \"0\" is appended after the
 +   decimal point (CLHS 22.3.3.1).  The optional leading zero before
 +   the decimal point is dropped when the field would otherwise
 +   overflow W.  Used by the free-format ~F path when the shortest
 +   representation does not fit in W."
 +  (declare (type (or single-float double-float) value)
 +	   (type (integer 0 *) frac))
 +  (let* ((rounded   (d2fixed (float (abs value) 1d0) frac))
 +	 ;; ROUNDED is "ddd" (frac=0) or "ddd.ddd" (frac>0).  Split it
 +	 ;; into integer and fractional digit runs.
 +	 (dot        (position #\. rounded))
 +	 (int-part   (if dot (subseq rounded 0 dot) rounded))
 +	 (frac-part  (if dot (subseq rounded (1+ dot)) ""))
 +	 ;; Force at least one fractional digit.
 +	 (frac-out   (if (zerop (length frac-part)) "0" frac-part))
 +	 (sign-len   (if (or is-negative-p at-sign-p) 1 0))
 +	 ;; The leading "0." may be shortened to "." when the magnitude
 +	 ;; is < 1 (integer part is a single "0") and nonzero, and the
 +	 ;; full field would not fit in W.
 +	 (lpoint-droppable
 +	   (and (string= int-part "0")
 +		(not (zerop value))))
 +	 (full-len   (+ sign-len (length int-part) 1 (length frac-out)))
 +	 (drop-leading-zero-p
 +	   (and lpoint-droppable w (> full-len w)))
 +	 (field-len  (if drop-leading-zero-p (1- full-len) full-len)))
 +    (flet ((write-field ()
 +	     (cond (is-negative-p (write-char #\- stream))
 +		   (at-sign-p     (write-char #\+ stream)))
 +	     (unless drop-leading-zero-p
 +	       (write-string int-part stream))
 +	     (write-char #\. stream)
 +	     (write-string frac-out stream)))
 +      (declare (dynamic-extent #'write-field))
 +      (pad-overflow stream field-len w overflowchar padchar #'write-field))))
  (defun format-f (value w d k overflowchar padchar at-sign-p)
    (declare (type (or single-float double-float) value)

@@ -367,20 +367,17 @@
    (assert-equal "       1.0"
                  (lisp::format-f  1d0        10 nil 0 nil nil nil)))
 -(define-test format-f.d-nil-with-w-no-shrink
 +(define-test format-f.d-nil-with-w-shrinks
    (:tag :format-f)
 -  ;; CLHS 22.3.3.1: when d is unspecified, the digit count is set so
 -  ;; that the result reads back as an EQUAL float, with no extraneous
 -  ;; trailing zeros.  This is the round-trip count.  When the result
 -  ;; does not fit in w and no overflowchar is supplied, the field
 -  ;; expands -- it does NOT shrink the digits, because doing so would
 -  ;; produce a different float on read-back.  (Earlier ryu code did
 -  ;; shrink here; that change was needed to pass ANSI FORMAT.F.5.)
 -  (assert-equal "1.234567"
 +  ;; d=nil with a tight width: CL rounds the value to the largest
 +  ;; number of fractional digits that fits in W (matching the B&D
 +  ;; reference output).  3.141592653589793 shrinks to fit; 1.234567
 +  ;; with w=6 rounds to "1.2346".
 +  (assert-equal "1.2346"
                  (lisp::format-f  1.234567d0   6 nil 0 nil nil nil))
 -  (assert-equal "3.141592653589793"
 +  (assert-equal "3.14159265"
                  (lisp::format-f  3.141592653589793d0 10 nil 0 nil nil nil))
 -  (assert-equal "3.141592653589793"
 +  (assert-equal "3.141593"
                  (lisp::format-f  3.141592653589793d0  8 nil 0 nil nil nil)))
  (define-test format-f.d-nil-with-w-overflow
@@ -755,10 +752,11 @@
  (define-test format-f.single-narrow-width-no-overflow-char
    (:tag :format-f :single-float)
 -  ;; CLHS 22.3.3.1: when the shortest form does not fit in the
 -  ;; specified width and no overflow character is supplied, the field
 -  ;; expands rather than truncating digits.  Round-trip and the
 -  ;; "at least one digit after the decimal point" rule must both hold.
 +  ;; ~F with unspecified d and a width too small for the shortest form:
 +  ;; the value is rounded to the fractional digits that fit, but at
 +  ;; least one fractional digit is always shown (CLHS 22.3.3.1).  With
 +  ;; no overflow char the field expands when even that minimum
 +  ;; doesn't fit.  1.0 -> "1.0".
    (assert-equal "1.0"
                  (lisp::format-f 1.0f0 2 nil 0 nil nil nil))
    (assert-equal "1.0"
@@ -767,6 +765,21 @@
    (assert-equal "1.0"
                  (lisp::format-f 1.0d0 2 nil 0 nil nil nil)))
 +(define-test format-f.d-nil-rounds-to-width-with-forced-zero
 +  (:tag :format-f)
 +  ;; ANSI FORMAT.F.45/F.47: ~F with unspecified d rounds the value to
 +  ;; the fractional digits that fit in W, but always shows at least one
 +  ;; fractional digit (a single "0" if the fraction rounds away).  The
 +  ;; field expands past W when even that minimum doesn't fit and no
 +  ;; overflow char is given.
 +  ;; ~2f of 1.1 and 1.9 round to integers, forced ".0", overflow to 3.
 +  (assert-equal "1.0" (lisp::format-f 1.1f0 2 nil 0 nil nil nil))
 +  (assert-equal "2.0" (lisp::format-f 1.9f0 2 nil 0 nil nil nil))
 +  ;; ~3f of 1e-6: rounds to .00 (leading zero dropped to fit width 3).
 +  (assert-equal ".00" (lisp::format-f 1.0f-6 3 nil 0 nil nil nil))
 +  ;; ~4f of 1e-6: .000.
 +  (assert-equal ".000" (lisp::format-f 1.0f-6 4 nil 0 nil nil nil)))
++
  (define-test format-f.single-narrow-width-with-overflow-char
    (:tag :format-f :single-float)
    ;; With overflowchar supplied, the field is filled with the overflow

Raymond Toy pushed to branch rtoy-print-using-ryu at cmucl / cmucl

Commits:

3 changed files:

Changes: