[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Fix date->string ~f operator to not emit leading
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/01: Fix date->string ~f operator to not emit leading zeros |
Date: |
Wed, 19 Apr 2017 09:47:03 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 4b39c1a9e53c63df8e19151f6e82040c6f734b89
Author: Andy Wingo <address@hidden>
Date: Wed Apr 19 15:42:03 2017 +0200
Fix date->string ~f operator to not emit leading zeros
* module/srfi/srfi-19.scm (directives): Format ~f without leading
zeroes. Fixes https://bugs.gnu.org/26260.
* test-suite/tests/srfi-19.test ("SRFI date/time library"): Add test.
---
module/srfi/srfi-19.scm | 26 ++++++++------------------
test-suite/tests/srfi-19.test | 6 +++++-
2 files changed, 13 insertions(+), 19 deletions(-)
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index 1b795f3..c6a55a2 100644
--- a/module/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -1005,24 +1005,14 @@
#\Space 2)
port)))
(cons #\f (lambda (date pad-with port)
- (if (> (date-nanosecond date)
- nano)
- (display (padding (+ (date-second date) 1)
- pad-with 2)
- port)
- (display (padding (date-second date)
- pad-with 2)
- port))
- (receive (i f)
- (split-real (/
- (date-nanosecond date)
- nano 1.0))
- (let* ((ns (number->string f))
- (le (string-length ns)))
- (if (> le 2)
- (begin
- (display (locale-decimal-point) port)
- (display (substring ns 2 le) port)))))))
+ (receive (s ns) (floor/ (+ (* (date-second date) nano)
+ (date-nanosecond date))
+ nano)
+ (display (number->string s) port)
+ (display (locale-decimal-point) port)
+ (let ((str (padding ns #\0 9)))
+ (display (substring str 0 1) port)
+ (display (string-trim-right str #\0 1) port)))))
(cons #\h (lambda (date pad-with port)
(display (date->string date "~b") port)))
(cons #\H (lambda (date pad-with port)
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 534cd7c..717047b 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -2,7 +2,7 @@
;;;; Matthias Koeppe <address@hidden> --- June 2001
;;;;
;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008,
-;;;; 2011, 2014 Free Software Foundation, Inc.
+;;;; 2011, 2014, 2017 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -180,6 +180,10 @@ incomplete numerical tower implementation.)"
(equal? "099999999"
(date->string date "~N"))))
+ (pass-if "date->string correct ~f"
+ (let ((date (make-date 200000000 5 34 12 26 3 2017 0)))
+ (equal? "5.2" (date->string date "~f"))))
+
;; check time comparison procedures
(let* ((time1 (make-time time-monotonic 0 0))
(time2 (make-time time-monotonic 0 0))