unofficial mirror of bug-guile@gnu.org 
 help / color / mirror / Atom feed
* bug#74841: [PATCH] srfi-19: Fix ~V converter in date->string.
@ 2024-12-12 21:03 Tomas Volf
  2024-12-22 21:41 ` Ludovic Courtès
  2025-01-24 16:23 ` bug#74841: [PATCH v2] " Tomas Volf
  0 siblings, 2 replies; 4+ messages in thread
From: Tomas Volf @ 2024-12-12 21:03 UTC (permalink / raw)
  To: 74841; +Cc: Tomas Volf

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






^ permalink raw reply related	[flat|nested] 4+ messages in thread

* bug#74841: [PATCH] srfi-19: Fix ~V converter in date->string.
  2024-12-12 21:03 bug#74841: [PATCH] srfi-19: Fix ~V converter in date->string Tomas Volf
@ 2024-12-22 21:41 ` Ludovic Courtès
  2025-01-24 16:23   ` Tomas Volf
  2025-01-24 16:23 ` bug#74841: [PATCH v2] " Tomas Volf
  1 sibling, 1 reply; 4+ messages in thread
From: Ludovic Courtès @ 2024-12-22 21:41 UTC (permalink / raw)
  To: Tomas Volf; +Cc: 74841

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’.





^ permalink raw reply	[flat|nested] 4+ messages in thread

* bug#74841: [PATCH v2] srfi-19: Fix ~V converter in date->string.
  2024-12-12 21:03 bug#74841: [PATCH] srfi-19: Fix ~V converter in date->string Tomas Volf
  2024-12-22 21:41 ` Ludovic Courtès
@ 2025-01-24 16:23 ` Tomas Volf
  1 sibling, 0 replies; 4+ messages in thread
From: Tomas Volf @ 2025-01-24 16:23 UTC (permalink / raw)
  To: 74841; +Cc: Tomas Volf

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






^ permalink raw reply related	[flat|nested] 4+ messages in thread

* bug#74841: [PATCH] srfi-19: Fix ~V converter in date->string.
  2024-12-22 21:41 ` Ludovic Courtès
@ 2025-01-24 16:23   ` Tomas Volf
  0 siblings, 0 replies; 4+ messages in thread
From: Tomas Volf @ 2025-01-24 16:23 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 74841

[-- Attachment #1: Type: text/plain, Size: 1438 bytes --]

Ludovic Courtès <ludo@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.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 853 bytes --]

^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2025-01-24 16:23 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-12-12 21:03 bug#74841: [PATCH] srfi-19: Fix ~V converter in date->string Tomas Volf
2024-12-22 21:41 ` Ludovic Courtès
2025-01-24 16:23   ` Tomas Volf
2025-01-24 16:23 ` bug#74841: [PATCH v2] " Tomas Volf

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).