GNU bug report logs - #74841
[PATCH] srfi-19: Fix ~V converter in date->string.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 74841 in the body.
You can then email your comments to 74841 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Tomas Volf <~@wolfsden.cz>
To: bug-guile <at> gnu.org
Cc: Tomas Volf <~@wolfsden.cz>
Subject: [PATCH] srfi-19: Fix ~V converter in date->string.
Date: Thu, 12 Dec 2024 22:03:21 +0100

The ~V is supposed to print ISO week number, not a week number.  This
commit fixes that.

* module/srfi/srfi-19.scm (date-week-number-iso): New procedure taken
from the reference implementation.
(directives)<#\V>: Use it.
* test-suite/tests/srfi-19.test ("date->string ~V"): Add tests taken
from the reference test suite.
---
 module/srfi/srfi-19.scm       | 21 ++++++++++++-
 test-suite/tests/srfi-19.test | 57 ++++++++++++++++++++++++++++++++++-
 2 files changed, 76 insertions(+), 2 deletions(-)

diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index d809ac1ec..77be57a0e 100644
--- a/module/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -753,6 +753,25 @@
                      (days-before-first-week  date day-of-week-starting-week))
                   7))
 
+(define (date-week-number-iso date)
+  ;; The week with the year's first Thursday is week 01.
+  (let* ((first-day-of-the-week (week-day 1 1 (date-year date)))
+         (offset (if (> first-day-of-the-week 4) 0 1))
+         ;; -2: decrement one day to compensate 1-origin of date-year-day,
+         ;; and decrement one more day for Sunday belongs to the previous week.
+         (w (+ (floor-quotient (+ (date-year-day date) first-day-of-the-week -2)
+                               7)
+               offset)))
+    (cond ((zero? w)
+           ;; date belongs to the last week of the previous year
+           (date-week-number-iso (make-date 0 0 0 0 31 12
+                                            (- (date-year date) 1) 0)))
+          ((and (= w 53)
+                (<= (week-day 1 1 (+ (date-year date) 1)) 4))
+           ;; date belongs to the first week of the next year
+           1)
+          (else w))))
+
 (define (current-date . tz-offset)
   (let ((time (current-time time-utc)))
     (time-utc->date
@@ -1043,7 +1062,7 @@
                    (display (padding (date-week-number date 0)
                                      #\0 2) port))))
    (cons #\V (lambda (date pad-with port)
-               (display (padding (date-week-number date 1)
+               (display (padding (date-week-number-iso date)
                                  #\0 2) port)))
    (cons #\w (lambda (date pad-with port)
                (display (date-week-day date) port)))
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 55eb82320..5e3e1f445 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -412,7 +412,62 @@ incomplete numerical tower implementation.)"
   (with-test-prefix "date-week-number"
     (pass-if (= 0 (date-week-number (make-date 0 0 0 0 1 1 1984 0) 0)))
     (pass-if (= 0 (date-week-number (make-date 0 0 0 0 7 1 1984 0) 0)))
-    (pass-if (= 1 (date-week-number (make-date 0 0 0 0 8 1 1984 0) 0)))))
+    (pass-if (= 1 (date-week-number (make-date 0 0 0 0 8 1 1984 0) 0))))
+
+  (let ((convert (λ (lst)
+                   (date->string
+                    (make-date 0 0 0 0
+                               (caddr lst) (cadr lst) (car lst)
+                               0)
+                    "~V"))))
+    (with-test-prefix "date->string ~V"
+      (pass-if-equal "Thursday, week 53" "53"
+        (convert '(2020 12 31)))
+      (pass-if-equal "Friday, week 53 (previous year)" "53"
+        (convert '(2021 1 1)))
+      (pass-if-equal "Sunday, week 53 (previous year)" "53"
+        (convert '(2021 1 3)))
+      (pass-if-equal "Monday, week 1" "01"
+        (convert '(2021 1 4)))
+
+      (pass-if-equal "Sunday, week 52" "52"
+        (convert '(2019 12 29)))
+      (pass-if-equal "Monday, week 1 (next year)" "01"
+        (convert '(2019 12 30)))
+      (pass-if-equal "Tuesday, week 1 (next year)" "01"
+        (convert '(2019 12 31)))
+      (pass-if-equal "Wednesday, week 1" "01"
+        (convert '(2020 1 1)))
+
+      (pass-if-equal "Saturday, week 52" "52"
+        (convert '(2016 12 31)))
+      (pass-if-equal "Sunday, week 52 (previous year)" "52"
+        (convert '(2017 1 1)))
+      (pass-if-equal "Monday, week 1" "01"
+        (convert '(2017 1 2)))
+      (pass-if-equal "Sunday, week 1" "01"
+        (convert '(2017 1 8)))
+      (pass-if-equal "Monday, week 2" "02"
+        (convert '(2017 1 9)))
+
+      (pass-if-equal "Sunday, week 52" "52"
+        (convert '(2014 12 28)))
+      (pass-if-equal "Monday, week 1 (next year)" "01"
+        (convert '(2014 12 29)))
+      (pass-if-equal "Tuesday, week 1 (next year)" "01"
+        (convert '(2014 12 30)))
+      (pass-if-equal "Wednesday, week 1 (next year)" "01"
+        (convert '(2014 12 31)))
+      (pass-if-equal "Thursday, week 1" "01"
+        (convert '(2015 1 1)))
+      (pass-if-equal "Friday, week 1" "01"
+        (convert '(2015 1 2)))
+      (pass-if-equal "Saturday, week 1" "01"
+        (convert '(2015 1 3)))
+      (pass-if-equal "Sunday, week 1" "01"
+        (convert '(2015 1 4)))
+      (pass-if-equal "Monday, week 2" "02"
+        (convert '(2015 1 5))))))
 
 
 ;; Local Variables:
-- 
2.46.0

Message #8 received at 74841 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Tomas Volf <~@wolfsden.cz>
Cc: 74841 <at> debbugs.gnu.org
Subject: Re: bug#74841: [PATCH] srfi-19: Fix ~V converter in date->string.
Date: Sun, 22 Dec 2024 22:41:41 +0100

Hi,

Tomas Volf <~@wolfsden.cz> skribis:

> The ~V is supposed to print ISO week number, not a week number.  This
> commit fixes that.
>
> * module/srfi/srfi-19.scm (date-week-number-iso): New procedure taken
> from the reference implementation.
> (directives)<#\V>: Use it.
> * test-suite/tests/srfi-19.test ("date->string ~V"): Add tests taken
> from the reference test suite.

The manual just reads this:

     ~U     week of year, Sunday first day of week, ‘00’ to
            ‘52’
     ~V     week of year, Monday first day of week, ‘01’ to
            ‘53’

Should it be fixed or clarified?

> +(define (date-week-number-iso date)

Please add a docstring.

> +  (let ((convert (λ (lst)
> +                   (date->string
> +                    (make-date 0 0 0 0
> +                               (caddr lst) (cadr lst) (car lst)

Please use ‘match-lambda’.

> +    (with-test-prefix "date->string ~V"
> +      (pass-if-equal "Thursday, week 53" "53"

If these are from the SRFI-19 spec, could you add a comment to say so?

Thanks,
Ludo’.

Message #11 received at 74841 <at> debbugs.gnu.org (full text, mbox):

From: Tomas Volf <~@wolfsden.cz>
To: 74841 <at> debbugs.gnu.org
Cc: Tomas Volf <~@wolfsden.cz>
Subject: [PATCH v2] srfi-19: Fix ~V converter in date->string.
Date: Fri, 24 Jan 2025 17:23:17 +0100

The ~V is supposed to print ISO week number, not a week number.  This
commit fixes that.

* module/srfi/srfi-19.scm (date-week-number-iso): New procedure taken
from the reference implementation.
(directives)<#\V>: Use it.
* test-suite/tests/srfi-19.test ("date->string ~V"): Add tests taken
from the reference test suite.
* doc/ref/srfi-modules.texi (SRFI-19 Date to string): Mention ISO-8601
in description for ~V.
---
 doc/ref/srfi-modules.texi     |  4 +--
 module/srfi/srfi-19.scm       | 24 +++++++++++++-
 test-suite/tests/srfi-19.test | 60 +++++++++++++++++++++++++++++++++--
 3 files changed, 83 insertions(+), 5 deletions(-)

diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index f072e6c3f..0b663902e 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -2864,8 +2864,8 @@ with locale decimal point, eg.@: @samp{5.2}
 @item @nicode{~T} @tab time, 24 hour clock, @samp{~H:~M:~S}
 @item @nicode{~U} @tab week of year, Sunday first day of week,
 @samp{00} to @samp{52}
-@item @nicode{~V} @tab week of year, Monday first day of week,
-@samp{01} to @samp{53}
+@item @nicode{~V} @tab ISO 8601 week number of the year,
+Monday first day of week, @samp{01} to @samp{53}
 @item @nicode{~w} @tab day of week, 0 for Sunday, @samp{0} to @samp{6}
 @item @nicode{~W} @tab week of year, Monday first day of week,
 @samp{00} to @samp{52}
diff --git a/module/srfi/srfi-19.scm b/module/srfi/srfi-19.scm
index d809ac1ec..7ab0ad6dd 100644
--- a/module/srfi/srfi-19.scm
+++ b/module/srfi/srfi-19.scm
@@ -753,6 +753,28 @@
                      (days-before-first-week  date day-of-week-starting-week))
                   7))
 
+;;; Taken from the reference implementation.  Modified to fit Guile's
+;;; code style.
+(define (date-week-number-iso date)
+  "Return a ISO-8601 week number for the @var{date}."
+  ;; The week with the year's first Thursday is week 01.
+  (let* ((first-day-of-the-week (week-day 1 1 (date-year date)))
+         (offset (if (> first-day-of-the-week 4) 0 1))
+         ;; -2: decrement one day to compensate 1-origin of date-year-day,
+         ;; and decrement one more day for Sunday belongs to the previous week.
+         (w (+ (floor-quotient (+ (date-year-day date) first-day-of-the-week -2)
+                               7)
+               offset)))
+    (cond ((zero? w)
+           ;; date belongs to the last week of the previous year
+           (date-week-number-iso (make-date 0 0 0 0 31 12
+                                            (- (date-year date) 1) 0)))
+          ((and (= w 53)
+                (<= (week-day 1 1 (+ (date-year date) 1)) 4))
+           ;; date belongs to the first week of the next year
+           1)
+          (else w))))
+
 (define (current-date . tz-offset)
   (let ((time (current-time time-utc)))
     (time-utc->date
@@ -1043,7 +1065,7 @@
                    (display (padding (date-week-number date 0)
                                      #\0 2) port))))
    (cons #\V (lambda (date pad-with port)
-               (display (padding (date-week-number date 1)
+               (display (padding (date-week-number-iso date)
                                  #\0 2) port)))
    (cons #\w (lambda (date pad-with port)
                (display (date-week-day date) port)))
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 55eb82320..3cacff669 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -26,7 +26,8 @@
   #:use-module (test-suite lib)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
-  #:use-module (ice-9 format))
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match))
 
 ;; Make sure we use the default locale.
 (when (defined? 'setlocale)
@@ -412,7 +413,62 @@ incomplete numerical tower implementation.)"
   (with-test-prefix "date-week-number"
     (pass-if (= 0 (date-week-number (make-date 0 0 0 0 1 1 1984 0) 0)))
     (pass-if (= 0 (date-week-number (make-date 0 0 0 0 7 1 1984 0) 0)))
-    (pass-if (= 1 (date-week-number (make-date 0 0 0 0 8 1 1984 0) 0)))))
+    (pass-if (= 1 (date-week-number (make-date 0 0 0 0 8 1 1984 0) 0))))
+
+  (let ((convert (match-lambda
+                   ((y m d)
+                    (date->string (make-date 0 0 0 0 d m y 0)
+                                  "~V")))))
+    ;; The test cases are taken from the test suite for the reference
+    ;; implementation.
+    (with-test-prefix "date->string ~V"
+      (pass-if-equal "Thursday, week 53" "53"
+        (convert '(2020 12 31)))
+      (pass-if-equal "Friday, week 53 (previous year)" "53"
+        (convert '(2021 1 1)))
+      (pass-if-equal "Sunday, week 53 (previous year)" "53"
+        (convert '(2021 1 3)))
+      (pass-if-equal "Monday, week 1" "01"
+        (convert '(2021 1 4)))
+
+      (pass-if-equal "Sunday, week 52" "52"
+        (convert '(2019 12 29)))
+      (pass-if-equal "Monday, week 1 (next year)" "01"
+        (convert '(2019 12 30)))
+      (pass-if-equal "Tuesday, week 1 (next year)" "01"
+        (convert '(2019 12 31)))
+      (pass-if-equal "Wednesday, week 1" "01"
+        (convert '(2020 1 1)))
+
+      (pass-if-equal "Saturday, week 52" "52"
+        (convert '(2016 12 31)))
+      (pass-if-equal "Sunday, week 52 (previous year)" "52"
+        (convert '(2017 1 1)))
+      (pass-if-equal "Monday, week 1" "01"
+        (convert '(2017 1 2)))
+      (pass-if-equal "Sunday, week 1" "01"
+        (convert '(2017 1 8)))
+      (pass-if-equal "Monday, week 2" "02"
+        (convert '(2017 1 9)))
+
+      (pass-if-equal "Sunday, week 52" "52"
+        (convert '(2014 12 28)))
+      (pass-if-equal "Monday, week 1 (next year)" "01"
+        (convert '(2014 12 29)))
+      (pass-if-equal "Tuesday, week 1 (next year)" "01"
+        (convert '(2014 12 30)))
+      (pass-if-equal "Wednesday, week 1 (next year)" "01"
+        (convert '(2014 12 31)))
+      (pass-if-equal "Thursday, week 1" "01"
+        (convert '(2015 1 1)))
+      (pass-if-equal "Friday, week 1" "01"
+        (convert '(2015 1 2)))
+      (pass-if-equal "Saturday, week 1" "01"
+        (convert '(2015 1 3)))
+      (pass-if-equal "Sunday, week 1" "01"
+        (convert '(2015 1 4)))
+      (pass-if-equal "Monday, week 2" "02"
+        (convert '(2015 1 5))))))
 
 
 ;; Local Variables:
-- 
2.47.1

Message #14 received at 74841 <at> debbugs.gnu.org (full text, mbox):

From: Tomas Volf <~@wolfsden.cz>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 74841 <at> debbugs.gnu.org
Subject: Re: bug#74841: [PATCH] srfi-19: Fix ~V converter in date->string.
Date: Fri, 24 Jan 2025 17:23:51 +0100

[Message part 1 (text/plain, inline)]

Ludovic Courtès <ludo <at> gnu.org> writes:

> Hi,
>
> Tomas Volf <~@wolfsden.cz> skribis:
>
>> The ~V is supposed to print ISO week number, not a week number.  This
>> commit fixes that.
>>
>> * module/srfi/srfi-19.scm (date-week-number-iso): New procedure taken
>> from the reference implementation.
>> (directives)<#\V>: Use it.
>> * test-suite/tests/srfi-19.test ("date->string ~V"): Add tests taken
>> from the reference test suite.
>
> The manual just reads this:
>
>      ~U     week of year, Sunday first day of week, ‘00’ to
>             ‘52’
>      ~V     week of year, Monday first day of week, ‘01’ to
>             ‘53’
>
> Should it be fixed or clarified?

Definitely, updated to reference the ISO-8601.

>
>> +(define (date-week-number-iso date)
>
> Please add a docstring.

Done.

>
>> +  (let ((convert (λ (lst)
>> +                   (date->string
>> +                    (make-date 0 0 0 0
>> +                               (caddr lst) (cadr lst) (car lst)
>
> Please use ‘match-lambda’.

Yeah that is much nicer.

>
>> +    (with-test-prefix "date->string ~V"
>> +      (pass-if-equal "Thursday, week 53" "53"
>
> If these are from the SRFI-19 spec, could you add a comment to say so?

Good point, done.

>
> Thanks,
> Ludo’.

--
There are only two hard things in Computer Science:
cache invalidation, naming things and off-by-one errors.

[signature.asc (application/pgp-signature, inline)]

Message #19 received at 74841-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Tomas Volf <~@wolfsden.cz>
Cc: 74841-done <at> debbugs.gnu.org
Subject: Re: bug#74841: [PATCH v2] srfi-19: Fix ~V converter in date->string.
Date: Fri, 28 Feb 2025 21:43:02 +0100

Tomas Volf <~@wolfsden.cz> skribis:

> The ~V is supposed to print ISO week number, not a week number.  This
> commit fixes that.
>
> * module/srfi/srfi-19.scm (date-week-number-iso): New procedure taken
> from the reference implementation.
> (directives)<#\V>: Use it.
> * test-suite/tests/srfi-19.test ("date->string ~V"): Add tests taken
> from the reference test suite.
> * doc/ref/srfi-modules.texi (SRFI-19 Date to string): Mention ISO-8601
> in description for ~V.

Applied, thanks!

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.