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

SRFI-19: Fix handling of negative years and negative julian days.

Browse source 
Fixes <https://bugs.gnu.org/21906>.
Mitigates <https://bugs.gnu.org/21903> and <https://bugs.gnu.org/21904>.
Reported by: Zefram <zefram@fysh.org>.

* module/srfi/srfi-19.scm (encode-julian-day-number)
(decode-julian-day-number, date-week-number): Use 'floor-quotient'
instead of 'quotient', and 'floor' instead of 'truncate', where
appropriate.
(time-utc->date): Ensure that the 'nanoseconds' field of the returned
date is non-negative.
(leap-year): Handle negative years properly, and reformulate the
computation.
(week-day): Handle negative years properly.  Use 'floor-quotient'
instead of 'quotient' where appropriate.
(directives): In the handler for '~Y' format escapes, improve the
handling of years outside of the range 0-9999.
(read-directives): Add a FIXME comment to fix the '~Y' reader to handle
years outside of the range 0-9999.
* test-suite/tests/srfi-19.test: Import (srfi srfi-1).  Use Guile's
modern keyword notation in the 'define-module' form.  Add more tests.
This commit is contained in:
Mark H Weaver 2018-10-20 23:02:16 -04:00
parent 5106377a34
commit a58c7abd72
2 changed files with 86 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -22,10 +22,11 @@
;; separate module, or later tests will fail.
(define-module (test-suite test-srfi-19)
:duplicates (last) ;; avoid warning about srfi-19 replacing `current-time'
:use-module (test-suite lib)
:use-module (srfi srfi-19)
:use-module (ice-9 format))
#:duplicates (last) ;; avoid warning about srfi-19 replacing `current-time'
#:use-module (test-suite lib)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (ice-9 format))
;; Make sure we use the default locale.
(when (defined? 'setlocale)
@ -261,7 +262,49 @@ incomplete numerical tower implementation.)"
(pass-if-equal "0024-06-23T12:00:00Z" "0024-06-23T12:00:00Z"
(date->string (julian-day->date 1730000 0) "~4"))
(pass-if-equal "2000-01-01T00:00:00Z" "2000-01-01T00:00:00Z"
(date->string (julian-day->date 4903089/2 0) "~4")))
(date->string (julian-day->date 4903089/2 0) "~4"))
(pass-if-equal "negative julian days"
'((-2000000 . "-10188-02-01T14:24:00Z wk=04 dow=6 doy=032")
(-20000 . "-4767-02-20T14:24:00Z wk=08 dow=0 doy=051")
(-10 . "-4713-11-14T14:24:00Z wk=45 dow=5 doy=318")
(-9 . "-4713-11-15T14:24:00Z wk=45 dow=6 doy=319")
(-8 . "-4713-11-16T14:24:00Z wk=46 dow=0 doy=320")
(-7 . "-4713-11-17T14:24:00Z wk=46 dow=1 doy=321")
(-6 . "-4713-11-18T14:24:00Z wk=46 dow=2 doy=322")
(-5 . "-4713-11-19T14:24:00Z wk=46 dow=3 doy=323")
(-4 . "-4713-11-20T14:24:00Z wk=46 dow=4 doy=324")
(-3 . "-4713-11-21T14:24:00Z wk=46 dow=5 doy=325")
(-2 . "-4713-11-22T14:24:00Z wk=46 dow=6 doy=326")
(-1 . "-4713-11-23T14:24:00Z wk=47 dow=0 doy=327")
(0 . "-4713-11-24T14:24:00Z wk=47 dow=1 doy=328")
(1 . "-4713-11-25T14:24:00Z wk=47 dow=2 doy=329")
(2 . "-4713-11-26T14:24:00Z wk=47 dow=3 doy=330")
(3 . "-4713-11-27T14:24:00Z wk=47 dow=4 doy=331")
(4 . "-4713-11-28T14:24:00Z wk=47 dow=5 doy=332")
(5 . "-4713-11-29T14:24:00Z wk=47 dow=6 doy=333")
(6 . "-4713-11-30T14:24:00Z wk=48 dow=0 doy=334")
(7 . "-4713-12-01T14:24:00Z wk=48 dow=1 doy=335")
(8 . "-4713-12-02T14:24:00Z wk=48 dow=2 doy=336")
(9 . "-4713-12-03T14:24:00Z wk=48 dow=3 doy=337"))
(map (lambda (n)
(cons n (date->string (julian-day->date (+ n 1/10) 0)
"~4 wk=~U dow=~w doy=~j")))
(cons* -2000000 -20000 (iota 20 -10))))
(pass-if-equal "negative year numbers"
'((1721055 . "-0001-12-27T14:24:00Z wk=52 dow=1 doy=361")
(1721056 . "-0001-12-28T14:24:00Z wk=52 dow=2 doy=362")
(1721057 . "-0001-12-29T14:24:00Z wk=52 dow=3 doy=363")
(1721058 . "-0001-12-30T14:24:00Z wk=52 dow=4 doy=364")
(1721059 . "-0001-12-31T14:24:00Z wk=52 dow=5 doy=365")
(1721060 . "0000-01-01T14:24:00Z wk=00 dow=6 doy=001")
(1721061 . "0000-01-02T14:24:00Z wk=01 dow=0 doy=002")
(1721062 . "0000-01-03T14:24:00Z wk=01 dow=1 doy=003")
(1721063 . "0000-01-04T14:24:00Z wk=01 dow=2 doy=004")
(1721064 . "0000-01-05T14:24:00Z wk=01 dow=3 doy=005"))
(map (lambda (n)
(cons n (date->string (julian-day->date (+ n 1/10) 0)
"~4 wk=~U dow=~w doy=~j")))
(iota 10 1721055))))
(with-test-prefix "time-utc->date"
(pass-if-equal "2012-07-01T00:59:59+0100" "2012-07-01T00:59:59+0100"