From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: daniel.llorens@bluewin.ch Newsgroups: gmane.lisp.guile.bugs Subject: bug#24908: [PATCH] Workaround for bug #24908 Date: Fri, 9 Dec 2016 14:11:09 +0100 Message-ID: <20161209131109.71940-2-daniel.llorens@bluewin.ch> References: <20161209131109.71940-1-daniel.llorens@bluewin.ch> NNTP-Posting-Host: blaine.gmane.org X-Trace: blaine.gmane.org 1481289146 2797 195.159.176.226 (9 Dec 2016 13:12:26 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 9 Dec 2016 13:12:26 +0000 (UTC) Cc: Daniel Llorens To: 24908@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Fri Dec 09 14:12:20 2016 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cFKyH-0007nx-ML for guile-bugs@m.gmane.org; Fri, 09 Dec 2016 14:12:17 +0100 Original-Received: from localhost ([::1]:46736 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cFKyL-0003vR-Jy for guile-bugs@m.gmane.org; Fri, 09 Dec 2016 08:12:21 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:59814) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cFKy8-0003Zo-Qi for bug-guile@gnu.org; Fri, 09 Dec 2016 08:12:15 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cFKy2-0000ZW-UG for bug-guile@gnu.org; Fri, 09 Dec 2016 08:12:08 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:48183) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cFKy2-0000ZJ-Rm for bug-guile@gnu.org; Fri, 09 Dec 2016 08:12:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cFKy2-000899-NV for bug-guile@gnu.org; Fri, 09 Dec 2016 08:12:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: daniel.llorens@bluewin.ch Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Fri, 09 Dec 2016 13:12:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 24908 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 24908-submit@debbugs.gnu.org id=B24908.148128909031266 (code B ref 24908); Fri, 09 Dec 2016 13:12:02 +0000 Original-Received: (at 24908) by debbugs.gnu.org; 9 Dec 2016 13:11:30 +0000 Original-Received: from localhost ([127.0.0.1]:35348 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cFKxW-000888-Jm for submit@debbugs.gnu.org; Fri, 09 Dec 2016 08:11:30 -0500 Original-Received: from vimdzmsp-sfwd06.bluewin.ch ([195.186.227.133]:40018 helo=smtpauths.lb.bluewin.ch) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cFKxU-00087m-NI for 24908@debbugs.gnu.org; Fri, 09 Dec 2016 08:11:29 -0500 Original-Received: from 4box.hq.corp.viasat.com ([213.193.80.99]) by vimdzmsp-sfwd06.bluewin.ch Swisscom AG with SMTP id FKxMcuNoPVYNhFKxOc9joq; Fri, 09 Dec 2016 14:11:22 +0100 X-Bluewin-Spam-Analysis: v=2.1 cv=U4Mydbfu c=1 sm=1 tr=0 a=DzaHVtLsrNCQ5PccsnG91A==:117 a=DzaHVtLsrNCQ5PccsnG91A==:17 a=L9H7d07YOLsA:10 a=9cW_t1CCXrUA:10 a=s5jvgZ67dGcA:10 a=MqW9qXN99zd6cayfcP4A:9 X-Bluewin-Spam-Score: 0.00 X-FXIT-IP: IPv4[213.193.80.99] Epoch[1481289082] X-Bluewin-AuthAs: daniel.llorens@bluewin.ch X-Mailer: git-send-email 2.10.1 In-Reply-To: <20161209131109.71940-1-daniel.llorens@bluewin.ch> X-CMAE-Envelope: MS4wfPB5KeQkDHKE2e28Lrx0c4XwWsElHxgboCahbWRpDDtzji9bHfArSSutYiAQny5t4frAOvz1NHP2wNMhblZSEUO5TkLja1LcosW2TIHRpu9pkVgsebBR ia6xc2mGlcAmzyk8ArQqpIBrkzlrmx9fjm2DL5POrjsP6syUVogvjjl7ePgU0C7b6fRn0iR6CH6L4YDBN9zwGYsfD32behWAc4W9jFENYwT0oefzlo+mnLt4 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.org gmane.lisp.guile.bugs:8474 Archived-At: From: Daniel Llorens * 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