GitLab

at 2026-05-28T17:12:00-07:00

Drop fractional digit in ~E d-specified when k consumes it

CLHS 22.3.3.2: with D specified, the number of fractional digits is
exactly d-(k-1).  When k >= d+1 (and k >= 2) that count is 0, and
the output is "[int].e[exp]" with no forced ".0".  Bypass
scale-mantissa for this case.  k=1, d=0 keeps the legacy "D.0eN"
behavior cmucl has always produced.

Factor the inline emit added in c841c128d for the d=nil tight-width
path into a shared helper emit-exp-no-fraction that handles
sign-and-pad via pad-overflow.

Update format-e.overflow-no-overflowchar and -shrink-exhausts
expected values: they were pinning the pre-c841c128d behavior of
emitting the full multi-digit shortest form on overflow; the
ansi-correct behavior is now the no-fractional-digit form.

Fixes ansi-test FORMAT.E.19.

@@ -358,6 +358,54 @@
        (declare (dynamic-extent #'write-field))
        (pad-overflow stream field-len w overflowchar padchar #'write-field))))
 +(defun emit-exp-no-fraction (stream mantissa shown-exp int-digits
 +			     is-negative-p at-sign-p
 +			     w e overflowchar padchar exponentchar)
 +  "Emit \"[sign][INT-DIGITS].[marker][exp-sign][exp]\" with no
 +   fractional digits, right-justified in width W.  MANTISSA is a
 +   string of significant digits from d2s/d2exp, with or without an
 +   internal dot; the integer digits are written from it (skipping the
 +   dot if any), zero-padded to INT-DIGITS."
 +  (declare (type simple-string mantissa)
 +	   (fixnum shown-exp int-digits)
 +	   (type (or null fixnum) w e))
 +  (let* ((dotpos     (position #\. mantissa))
 +	 (mant-len   (length mantissa))
 +	 (sig-digits (mantissa-digit-count mantissa))
 +	 (exp-sign   (if (minusp shown-exp) #\- #\+))
 +	 (exp-abs    (abs shown-exp))
 +	 (exp-digits (count-decimal-digits exp-abs))
 +	 (exp-width  (max (or e 1) exp-digits))
 +	 (exp-marker (or exponentchar #\d))
 +	 (sign-len   (if (or is-negative-p at-sign-p) 1 0))
 +	 ;; sign + int + dot + marker + exp-sign + exp-width
 +	 (field-len  (+ sign-len int-digits 3 exp-width)))
 +    (flet ((write-field ()
 +	     (cond (is-negative-p (write-char #\- stream))
 +		   (at-sign-p     (write-char #\+ stream)))
 +	     ;; Write up to sig-digits from mantissa (skipping the dot),
 +	     ;; then zero-pad if int-digits exceeds available.
 +	     (let ((available (min int-digits sig-digits)))
 +	       (cond ((null dotpos)
 +		      (write-string mantissa stream :start 0 :end available))
 +		     ((<= available dotpos)
 +		      (write-string mantissa stream :start 0 :end available))
 +		     (t
 +		      (write-string mantissa stream :start 0 :end dotpos)
 +		      (write-string mantissa stream
 +				    :start (1+ dotpos)
 +				    :end (min mant-len (1+ available))))))
 +	     (loop repeat (- int-digits sig-digits)
 +		   do (write-char #\0 stream))
 +	     (write-char #\. stream)
 +	     (write-char exp-marker stream)
 +	     (write-char exp-sign stream)
 +	     (loop repeat (- exp-width exp-digits)
 +		   do (write-char #\0 stream))
 +	     (princ exp-abs stream)))
 +      (declare (dynamic-extent #'write-field))
 +      (pad-overflow stream field-len w overflowchar padchar #'write-field))))
++
  (defun format-e (value w d e k overflowchar padchar exponentchar at-sign-p)
    (declare (type (or single-float double-float) value)
             (fixnum k)
@@ -371,8 +419,22 @@
           (multiple-value-bind (mantissa exponent)
               (parsed-exp-form (d2exp abs-value
  				     (d2exp-precision d k)))
 -           (format-e-string stream mantissa exponent is-negative-p
 -                            w e k overflowchar padchar exponentchar at-sign-p nil)))
 +	   (cond
 +	     ;; CLHS 22.3.3.2: with D specified, exactly d-(k-1)
 +	     ;; fractional digits appear after the dot.  When that is 0
 +	     ;; (k >= d+1, plusp k), emit "[int].e[exp]" directly with
 +	     ;; no forced ".0" -- the d2exp result has been rounded to
 +	     ;; exactly the digits we need to show.  The k=1, d=0 case
 +	     ;; is excluded: cmucl has always emitted "D.0eN" there and
 +	     ;; existing tests rely on it.
 +	     ((and (>= k 2) (>= k (1+ d)))
 +	      (emit-exp-no-fraction stream mantissa
 +				    (- exponent (1- k))
 +				    k is-negative-p at-sign-p
 +				    w e overflowchar padchar exponentchar))
 +	     (t
 +	      (format-e-string stream mantissa exponent is-negative-p
 +			       w e k overflowchar padchar exponentchar at-sign-p nil)))))
          (t
           (multiple-value-bind (mantissa exponent)
               (parsed-exp-form (float-to-string value))
@@ -410,20 +472,10 @@
                       ;; fall through to the old format-e-string path.
                       (multiple-value-bind (one-digit shown-exp)
                           (parsed-exp-form (d2exp abs-value 0))
 -                       (let* ((exp-sign  (if (minusp shown-exp) #\- #\+))
 -                              (exp-abs   (abs shown-exp))
 -                              (exp-digits (count-decimal-digits exp-abs))
 -                              (exp-width (max (or e 1) exp-digits))
 -                              (exp-marker (or exponentchar #\d)))
 -                         (cond (is-negative-p (write-char #\- stream))
 -                               (at-sign-p     (write-char #\+ stream)))
 -                         (write-string one-digit stream)
 -                         (write-char #\. stream)
 -                         (write-char exp-marker stream)
 -                         (write-char exp-sign stream)
 -                         (loop repeat (- exp-width exp-digits)
 -                               do (write-char #\0 stream))
 -                         (princ exp-abs stream))))
 +                       (emit-exp-no-fraction stream one-digit shown-exp 1
 +					     is-negative-p at-sign-p
 +					     w e overflowchar padchar
 +					     exponentchar)))
                      (t
                       ;; k != 1 and no width fits: fall back to the
                       ;; shortest form (may still emit a forced ".0";

@@ -200,12 +200,15 @@
  (define-test format-e.overflow-no-overflowchar
    (:tag :format-e)
 -  ;; w too small AND no overflowchar -- emit the field at natural
 -  ;; width, exceeding w.  No truncation.
 -  (assert-equal "3.14d+100"
 +  ;; w too small AND no overflowchar -- emit the no-fractional-digit
 +  ;; form "d.e+exp" (overflowing W), per CLHS 22.3.3.2 "single zero
 +  ;; digit ... if the width w permits" (here it does not).
 +  (assert-equal "3.d+100"
                  (lisp::format-e 3.14d100 3 nil nil 1 nil nil #\d nil))
 -  ;; Free-format too long for w with no overflowchar.
 -  (assert-equal "3.14159265358979d+0"
 +  ;; Free-format too long for w with no overflowchar -- same rule:
 +  ;; drop to no-fractional-digit form rather than emitting the full
 +  ;; multi-digit shortest representation.
 +  (assert-equal "3.d+0"
                  (lisp::format-e 3.14159265358979d0 5 nil nil 1 nil nil #\d nil)))
  (define-test format-e.overflow-exponent-too-wide
@@ -232,12 +235,14 @@
  (define-test format-e.overflow-shrink-exhausts
    (:tag :format-e)
 -  ;; w forces shrinking down to d_fit = 0, which still won't fit.
 -  ;; Should produce overflow fill.
 +  ;; w forces shrinking down to d_fit = nil (not even d=0 fits).
 +  ;; With an overflow char, the field is filled.
    (assert-equal "****"
                  (lisp::format-e 3.14159265358979d0 4 nil nil 1 #\* nil #\d nil))
 -  ;; Same but no overflowchar -- emit at natural shortest width.
 -  (assert-equal "3.14159265358979d+0"
 +  ;; Without overflowchar, emit the no-fractional-digit form
 +  ;; "d.e+exp" (overflowing W) rather than the full multi-digit
 +  ;; shortest representation.
 +  (assert-equal "3.d+0"
                  (lisp::format-e 3.14159265358979d0 4 nil nil 1 nil nil #\d nil)))
  (define-test format-e.overflow-with-padchar
@@ -306,6 +311,24 @@
    (assert-equal "-1.e+0"
                  (lisp::format-e -1.0f0 6 nil nil 1 nil nil #\e nil)))
 +(define-test format-e.d-given-k-consumes-fraction
 +  (:tag :format-e)
 +  ;; ANSI FORMAT.E.19: with D specified, the number of fractional
 +  ;; digits is exactly d-(k-1).  When k >= d+1 (and k >= 2) that count
 +  ;; is 0, and the output is "[int].e[exp]" with no forced ".0".
 +  ;; d=2, k=3, value 0.05 -> "5.00E-2" rounded by d2exp -> "500.e-4"
 +  ;; after the k-shift consumes the fractional digits.
 +  (assert-equal "500.e-4"
 +                (lisp::format-e 0.05f0 nil 2 nil 3 nil nil #\e nil))
 +  (assert-equal "500.e-4"
 +                (lisp::format-e 0.05d0 nil 2 nil 3 nil nil #\e nil))
 +  ;; Negated: leading "-" sign included.
 +  (assert-equal "-500.e-4"
 +                (lisp::format-e -0.05d0 nil 2 nil 3 nil nil #\e nil))
 +  ;; At-sign: explicit "+".
 +  (assert-equal "+500.e-4"
 +                (lisp::format-e 0.05d0 nil 2 nil 3 nil nil #\e t)))
++
  ;;; ~F tests
  (define-test format-f.basic
    (:tag :format-f)

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

Commits:

3 changed files:

Changes: