calendar: change the behavior of 1 months time+

Before, it would create an invalid date:

  IN: scratchpad 2021 1 30 <date> 1 months time+ .
  T{ timestamp
      { year 2021 }
      { month 2 }
      { day 30 }
      { gmt-offset T{ duration { hour -6 } } }
  }

After, it sets it to the last day of the month:

  IN: scratchpad 2021 1 30 <date> 1 months time+ .
  T{ timestamp
      { year 2021 }
      { month 2 }
      { day 28 }
      { gmt-offset T{ duration { hour -8 } } }
  }

diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor
index 3b2324eea34ff1e639ea96afb3c35e269796073e..20321455998419d28833063b731993099e22fdf7 100644 (file)
--- a/basis/calendar/calendar-tests.factor
+++ b/basis/calendar/calendar-tests.factor
@@ -199,7 +199,7 @@ IN: calendar
 
 { t } [
     2009 1 29 <date> 1 months time+
-    2009 3 1 <date> =
+    2009 2 28 <date> =
 ] unit-test
 
 { t } [

diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor
index df7349d65e30a231cf90eec16f31f0bc5808aabd..28771a04ea6b758de134e321f914537419ef5d2e 100644 (file)
--- a/basis/calendar/calendar.factor
+++ b/basis/calendar/calendar.factor
@@ -182,6 +182,8 @@ M: timestamp easter
 : microseconds ( x -- duration ) 1000000 / seconds ;
 : nanoseconds ( x -- duration ) 1000000000 / seconds ;
 
+DEFER: days-in-month
+
 <PRIVATE
 
 GENERIC: +year ( timestamp x -- timestamp )
@@ -213,7 +215,10 @@ M: real +year
     12 /rem [ 1 - 12 ] when-zero swap ; inline
 
 M: integer +month
-    [ over month>> + months/years [ >>month ] dip +year ] unless-zero ;
+    [
+        over month>> + months/years
+        [ >>month dup days-in-month '[ _ min ] change-day ] dip +year
+    ] unless-zero ;
 
 M: real +month
     float>whole-part swapd average-month * +day swap +month ;