mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 02:30:23 +02:00
Code Activity

srfi-19: Fix `string->date' weekday lookup.

Browse source 
* srfi/srfi-19.scm (priv:locale-abbr-weekday->index): Use
  `locale-day-short' since it expects integers in the range 1-7, unlike
  `priv:locale-abbr-weekday'.
  (priv:locale-long-weekday->index): Likewise.

* test-suite/tests/srfi-19.test ("SRFI date/time
  library")["string->date works on Sunday"]: New test.
This commit is contained in:
Ludovic Courtès 2008-12-18 22:34:23 +01:00
parent 55aae98356
commit 8891556e50
2 changed files with 11 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

4
srfi/srfi-19.scm
View file

@ -937,10 +937,10 @@
(else (loop (+ index 1)))))) (else (loop (+ index 1))))))
(define (priv:locale-abbr-weekday->index string) (define (priv:locale-abbr-weekday->index string)
(priv:date-reverse-lookup string priv:locale-abbr-weekday 7 string=?)) (priv:date-reverse-lookup string locale-day-short 7 string=?))
(define (priv:locale-long-weekday->index string) (define (priv:locale-long-weekday->index string)
(priv:date-reverse-lookup string priv:locale-long-weekday 7 string=?)) (priv:date-reverse-lookup string locale-day 7 string=?))
(define (priv:locale-abbr-month->index string) (define (priv:locale-abbr-month->index string)
(priv:date-reverse-lookup string priv:locale-abbr-month 12 string=?)) (priv:date-reverse-lookup string priv:locale-abbr-month 12 string=?))

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

@ -1,7 +1,7 @@
;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*- ;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*-
;;;; 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 Free Software Foundation, Inc. ;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by ;;;; it under the terms of the GNU General Public License as published by
@ -166,6 +166,14 @@ incomplete numerical tower implementation.)"
0))) 0)))
(date->time-utc (date->time-utc
(make-date 0 0 0 0 9 12 2006 0)))) (make-date 0 0 0 0 9 12 2006 0))))
(pass-if "string->date works on Sunday"
;; `string->date' never rests!
(let* ((str "Sun, 05 Jun 2005 18:33:00 +0200")
(date (string->date str "~a, ~d ~b ~Y ~H:~M:~S ~z")))
(equal? "Sun Jun 05 18:33:00+0200 2005"
(date->string date))))
;; 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))