[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 31/55: Support ~N in SRFI-19 string->date
From: |
Andy Wingo |
Subject: |
[Guile-commits] 31/55: Support ~N in SRFI-19 string->date |
Date: |
Thu, 23 May 2019 11:52:41 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 347ec3f0889b7fb60bc251efec94f0a6d6944c3a
Author: Daniel Llorens <address@hidden>
Date: Mon Dec 10 11:57:05 2018 +0100
Support ~N in SRFI-19 string->date
* module/srfi/srfi-19.scm (fractional-integer-reader,
make-fractional-integer-reader): From reference implementation.
(reader-directives): Handle #\N, from reference implementation.
* test-suite/tests/srfi-19: Add tests for string->date ~N.
* doc/ref/srfi-modules.texi (string->date): Add line for ~N.
---
doc/ref/srfi-modules.texi | 5 +++++
module/srfi/srfi-19.scm | 22 ++++++++++++++++++++++
test-suite/tests/srfi-19.test | 10 ++++++++++
3 files changed, 37 insertions(+)
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 630028a..58548a3 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -2927,6 +2927,11 @@ the date.
@tab minute
@tab @nicode{date-minute}
address@hidden @nicode{~N}
address@hidden @nicode{char-numeric?}
address@hidden nanosecond
address@hidden @nicode{date-nanosecond}
+
@item @nicode{~S}
@tab @nicode{char-numeric?}
@tab second
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index 46de91a..66939f9 100644
--- a/module/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -1193,6 +1193,24 @@
(lambda (port)
(integer-reader upto port)))
+;; read an fractional integer upto n characters long on port; upto -> #f if
any length
+;;
+;; The return value is normalized to upto decimal places. For example, if upto
is 9 and
+;; the string read is "123", the return value is 123000000.
+(define (fractional-integer-reader upto port)
+ (define (accum-int port accum nchars)
+ (let ((ch (peek-char port)))
+ (if (or (eof-object? ch)
+ (not (char-numeric? ch))
+ (and upto (>= nchars upto)))
+ (* accum (expt 10 (- upto nchars)))
+ (accum-int port (+ (* accum 10) (char->int (read-char port))) (+
nchars 1)))))
+ (accum-int port 0 0))
+
+(define (make-fractional-integer-reader upto)
+ (lambda (port)
+ (fractional-integer-reader upto port)))
+
;; read *exactly* n characters and convert to integer; could be padded
(define (integer-reader-exact n port)
(let ((padding-ok #t))
@@ -1305,6 +1323,7 @@
(define read-directives
(let ((ireader4 (make-integer-reader 4))
(ireader2 (make-integer-reader 2))
+ (fireader9 (make-fractional-integer-reader 9))
(eireader2 (make-integer-exact-reader 2))
(locale-reader-abbr-weekday (make-locale-reader
locale-abbr-weekday->index))
@@ -1343,6 +1362,9 @@
(list #\M char-numeric? ireader2 (lambda (val object)
(set-date-minute!
object val)))
+ (list #\N char-numeric? fireader9 (lambda (val object)
+ (set-date-nanosecond!
+ object val)))
(list #\S char-numeric? ireader2 (lambda (val object)
(set-date-second! object val)))
(list #\y char-fail eireader2
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 4d79f10..256ff74 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -176,6 +176,16 @@ incomplete numerical tower implementation.)"
(equal? "Sun Jun 05 18:33:00+0200 2005"
(date->string date))))
+ (pass-if "string->date understands nanoseconds (1)"
+ (time=? (date->time-utc (string->date "2018-12-10 10:53:24.189"
+ "~Y-~m-~d ~H:~M:~S.~N"))
+ (date->time-utc (make-date 189000000 24 53 10 10 12 2018 3600))))
+
+ (pass-if "string->date understands nanoseconds (2)"
+ (time=? (date->time-utc (string->date "2018-12-10 10:53:24.189654321"
+ "~Y-~m-~d ~H:~M:~S.~N"))
+ (date->time-utc (make-date 189654321 24 53 10 10 12 2018 3600))))
+
(pass-if "date->string pads small nanoseconds values correctly"
(let* ((date (make-date 99999999 5 34 12 26 3 2017 0)))
(equal? "099999999"
- [Guile-commits] 43/55: Fix typo in comment., (continued)
- [Guile-commits] 43/55: Fix typo in comment., Andy Wingo, 2019/05/23
- [Guile-commits] 04/55: Define AT_SYMLINK_NOFOLLOW et al., Andy Wingo, 2019/05/23
- [Guile-commits] 08/55: Fix list validation of *list->bytevector procedures., Andy Wingo, 2019/05/23
- [Guile-commits] 13/55: Update SRFI-19 leap second table., Andy Wingo, 2019/05/23
- [Guile-commits] 05/55: Fix 'atomic-box-compare-and-swap!'., Andy Wingo, 2019/05/23
- [Guile-commits] 26/55: Add texinfo dependency to README, Andy Wingo, 2019/05/23
- [Guile-commits] 27/55: Bootstrap optimization, Andy Wingo, 2019/05/23
- [Guile-commits] 32/55: Fix tests for SRFI-19 date->string ~N, Andy Wingo, 2019/05/23
- [Guile-commits] 33/55: Do not warn the user when 'madvise' returns ENOSYS., Andy Wingo, 2019/05/23
- [Guile-commits] 30/55: Update (ice-9 match) to include selected bug fixes from upstream., Andy Wingo, 2019/05/23
- [Guile-commits] 31/55: Support ~N in SRFI-19 string->date,
Andy Wingo <=
- [Guile-commits] 28/55: Documentation fixes, Andy Wingo, 2019/05/23
- [Guile-commits] 42/55: Disable test for current value of setitimer on Cygwin, Andy Wingo, 2019/05/23
- [Guile-commits] 29/55: Fix spelling of ellipsis in (ice-9 match)., Andy Wingo, 2019/05/23
- [Guile-commits] 53/55: put-u8: Always write a single byte, regardless of the port encoding., Andy Wingo, 2019/05/23
- [Guile-commits] 52/55: Optimize fixnum exact integer square roots., Andy Wingo, 2019/05/23
- [Guile-commits] 44/55: Avoid passing NULL to 'memcpy' and 'memcmp'., Andy Wingo, 2019/05/23
- [Guile-commits] 14/55: Fix typos, indentation and error reporting in SRFI-19., Andy Wingo, 2019/05/23
- [Guile-commits] 54/55: Strings, i18n: Limit the use of alloca to approximately 8 kilobytes., Andy Wingo, 2019/05/23
- [Guile-commits] 49/55: Fix typo in comment., Andy Wingo, 2019/05/23
- [Guile-commits] 47/55: Reimplement SCM_MAKE_CHAR to evaluate its argument only once., Andy Wingo, 2019/05/23