Fix FORMAT.E.6

clasp-developers · Aug 3, 2024 · 94c2bc7 · 94c2bc7
1 parent 6a84df5
commit 94c2bc7
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 3 deletions.
diff --git a/src/core/float_to_string.cc b/src/core/float_to_string.cc
@@ -106,6 +106,8 @@ T_sp core_float_to_string_free(Float_sp number, Number_sp e_min, Number_sp e_max
   /* Do we have to print in exponent notation? */
   if (clasp_lowereq(exp, e_min) || clasp_lowereq(e_max, exp)) {
     insert_char(buffer, base + 1, '.');
+    if (gc::As<StrNs_sp>(buffer)->fillPointer() == base + 2)
+      buffer->vectorPushExtend(clasp_make_character('0'));
     print_float_exponent(buffer, number, e - 1);
   } else if (e > 0) {
     gc::Fixnum l = gc::As<StrNs_sp>(buffer)->fillPointer() - base;

diff --git a/src/lisp/kernel/lsp/format.lisp b/src/lisp/kernel/lsp/format.lisp
@@ -1374,14 +1374,27 @@
                             nil)))
         (if (and w ovf e (> elen e))   ;exponent overflow
             (dotimes (i w) (write-char ovf stream))
-            (multiple-value-bind (fstr flen lpoint)
+            (multiple-value-bind (fstr flen lpoint tpoint dpos)
                 (sys::flonum-to-string number spaceleft fdig (- expt) fmin)
+              (when (and (plusp k)
+                         (< k dpos))
+                (incf expt (- dpos k))
+                (setf estr (decimal-string (abs expt))
+                      tpoint nil)
+                (loop for pos from dpos downto k
+                      do (setf (char fstr pos) (if (= pos k) #\. (char fstr (1- pos))))))
+              (when (eql fdig 0)
+                (setq tpoint nil))
               (when w
                 (decf spaceleft flen)
                 (when lpoint
                   (if (> spaceleft 0)
                       (decf spaceleft)
-                      (setq lpoint nil))))
+                      (setq lpoint nil)))
+                (when tpoint
+                  (if (> spaceleft 0)
+                      (decf spaceleft)
+                      (setq tpoint nil))))
               (cond ((and w (< spaceleft 0) ovf)
                      ;;significand overflow
                      (dotimes (i w) (write-char ovf stream)))
@@ -1392,6 +1405,7 @@
                            (if atsign (write-char #\+ stream)))
                        (when lpoint (write-char #\0 stream))
                        (write-string fstr stream)
+                       (when tpoint (write-char #\0 stream))
                        (write-char (if marker
                                        marker
                                        (format-exponent-marker number))

diff --git a/tools-for-build/ansi-test-expected-failures.sexp b/tools-for-build/ansi-test-expected-failures.sexp
@@ -87,7 +87,6 @@ DEFCLASS.FORWARD-REF.3
 DEFSTRUCT.ERROR.3
 DEFSTRUCT.ERROR.4
 ALL-EXPORTED-CL-CLASS-NAMES-ARE-VALID
-FORMAT.E.6
 FORMAT.E.26
 
 DEFINE-METHOD-COMBINATION-LONG.05.2