unofficial mirror of bug-guile@gnu.org 
 help / color / mirror / Atom feed
From: daniel.llorens@bluewin.ch
To: 24908@debbugs.gnu.org
Cc: Daniel Llorens <daniel.llorens@bluewin.ch>
Subject: bug#24908: [PATCH] Workaround for bug #24908
Date: Fri,  9 Dec 2016 14:11:09 +0100	[thread overview]
Message-ID: <20161209131109.71940-2-daniel.llorens@bluewin.ch> (raw)
In-Reply-To: <20161209131109.71940-1-daniel.llorens@bluewin.ch>

From: Daniel Llorens <daniel.llorens@bluewin.ch>

* module/ice-9/format.scm (format:fn-round): Don't let i become
  negative.
* test-suite/tests/format.test: Regression test for "~2f".
---
 module/ice-9/format.scm      | 15 ++++++++-------
 test-suite/tests/format.test |  6 +++++-
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index 1ef4cb5ef..d3066a527 100644
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -1510,11 +1510,12 @@
            (set! format:fn-len (- format:fn-len n)))
         (string-set! format:fn-str (- i n) (string-ref format:fn-str i))))
 
+    ;; carry i+1 to work around bug #24908
     (define (format:fn-round digits)    ; round format:fn-str
       (set! digits (+ digits format:fn-dot))
-      (do ((i digits (- i 1))		; "099",2 -> "10"
+      (do ((i (+ digits 1) (- i 1))	; "099",2 -> "10"
            (c 5))                       ; "023",2 -> "02"
-          ((or (= c 0) (< i 0))         ; "999",2 -> "100"
+          ((or (= c 0) (<= i 0))        ; "999",2 -> "100"
            (if (= c 1)			; "005",2 -> "01"
                (begin			; carry overflow
                  (set! format:fn-len digits)
@@ -1522,12 +1523,12 @@
                  (string-set! format:fn-str 0 #\1)
                  (set! format:fn-dot (+ format:fn-dot 1)))
                (set! format:fn-len digits)))
-        (set! c (+ (- (char->integer (string-ref format:fn-str i))
+        (set! c (+ (- (char->integer (string-ref format:fn-str (- i 1)))
                       format:zero-ch) c))
-        (string-set! format:fn-str i (integer->char
-                                      (if (< c 10) 
-                                          (+ c format:zero-ch)
-                                          (+ (- c 10) format:zero-ch))))
+        (string-set! format:fn-str (- i 1) (integer->char
+                                            (if (< c 10)
+                                              (+ c format:zero-ch)
+                                              (+ (- c 10) format:zero-ch))))
         (set! c (if (< c 10) 0 1))))
 
     (define (format:fn-out modifier add-leading-zero?)
diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test
index cc31942cc..8aab7e96b 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -112,7 +112,11 @@
   ;; in guile prior to 1.6.9 and 1.8.1, leading zeros were incorrectly
   ;; stripped, moving the decimal point and giving "25.0" here
   (pass-if "string 02.5"
-    (string=? "2.5" (format #f "~f" "02.5"))))
+    (string=? "2.5" (format #f "~f" "02.5")))
+
+  ;; regression against bug #24908
+  (pass-if "2f"
+    (string=? "10." (format #f "~2f" 9.9))))
 
 ;;;
 ;;; ~h
-- 
2.11.0






  reply	other threads:[~2016-12-09 13:11 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2016-11-09 13:17 bug#24908: Possible unboxing bug in master triggered by (format) Daniel Llorens
2016-12-09 13:11 ` bug#24908: workaround daniel.llorens
2016-12-09 13:11   ` daniel.llorens [this message]
2016-12-15 11:59 ` bug#24908: closing Daniel Llorens

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/guile/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20161209131109.71940-2-daniel.llorens@bluewin.ch \
    --to=daniel.llorens@bluewin.ch \
    --cc=24908@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).