From 8891556e50be2609f7dd7daaecfac150415b6331 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 18 Dec 2008 22:34:23 +0100 Subject: [PATCH] srfi-19: Fix `string->date' weekday lookup. * 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. --- srfi/srfi-19.scm | 4 ++-- test-suite/tests/srfi-19.test | 10 +++++++++- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/srfi/srfi-19.scm b/srfi/srfi-19.scm index 96ef3448a..1863fd3d1 100644 --- a/srfi/srfi-19.scm +++ b/srfi/srfi-19.scm @@ -937,10 +937,10 @@ (else (loop (+ index 1)))))) (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) - (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) (priv:date-reverse-lookup string priv:locale-abbr-month 12 string=?)) diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test index a553ce4f8..259a88a4e 100644 --- a/test-suite/tests/srfi-19.test +++ b/test-suite/tests/srfi-19.test @@ -1,7 +1,7 @@ ;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*- ;;;; Matthias Koeppe --- 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 ;;;; it under the terms of the GNU General Public License as published by @@ -166,6 +166,14 @@ incomplete numerical tower implementation.)" 0))) (date->time-utc (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 (let* ((time1 (make-time time-monotonic 0 0)) (time2 (make-time time-monotonic 0 0))