mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

Fix date->string ~f operator to not emit leading zeros

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2017-04-19 15:42:03 +02:00
parent 1978085b22
commit 4b39c1a9e5
2 changed files with 13 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

22
module/srfi/srfi-19.scm
View file

@ -1005,24 +1005,14 @@
#\Space 2) #\Space 2)
port))) port)))
(cons #\f (lambda (date pad-with port) (cons #\f (lambda (date pad-with port)
(if (> (date-nanosecond date) (receive (s ns) (floor/ (+ (* (date-second date) nano)
(date-nanosecond date))
nano) nano)
(display (padding (+ (date-second date) 1) (display (number->string s) port)
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 (locale-decimal-point) port)
(display (substring ns 2 le) 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) (cons #\h (lambda (date pad-with port)
(display (date->string date "~b") port))) (display (date->string date "~b") port)))
(cons #\H (lambda (date pad-with port) (cons #\H (lambda (date pad-with port)

6
test-suite/tests/srfi-19.test
View file

@ -2,7 +2,7 @@
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001 ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
;;;; ;;;;
;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008, ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -180,6 +180,10 @@ incomplete numerical tower implementation.)"
(equal? "099999999" (equal? "099999999"
(date->string date "~N")))) (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 ;; check time comparison procedures
(let* ((time1 (make-time time-monotonic 0 0)) (let* ((time1 (make-time time-monotonic 0 0))
(time2 (make-time time-monotonic 0 0)) (time2 (make-time time-monotonic 0 0))