Fix missing date under/overflow in DA.Date.date

compiler/damlc/daml-stdlib-src/DA/Date.daml

@@ -21,6 +21,7 @@ module DA.Date
   , passToDate
   ) where
 
+import DA.Text (implode)
 import DA.Date.Types
 import DA.Internal.Date
 import DA.Internal.Time
@@ -81,15 +82,20 @@ toGregorian date =
 
 -- | Given the three values (year, month, day), constructs a `Date` value.
 -- `date y m d` turns the year `y`, month `m`, and day `d` into a `Date` value.
+-- Raises an error if `d` is outside the range `1 .. monthDayCount y m`.
 date : Int -> Month -> Int -> Date
 date year month day =
   let a = (14 - (fromMonth month)) / 12
       y = year + 4800 - a
       m = (fromMonth month) + 12 * a - 3
       date = day + (153 * m + 2) / 5 + y * 365 + y / 4 - y / 100 + y / 400 - 2472633
       ml = monthDayCount year month
-  in daysSinceEpochToDate date
-  -- assert day >= 1 && ml >= day
+  in
+    if 1 <= day && day <= ml
+      then daysSinceEpochToDate date
+      else error $ implode
+          [ "Day ", show day, " falls outside of valid day range (1 .. "
+          , show ml, ") for ", show month, " ", show year, "." ]
 
 -- | Returns `True` if the given year is a leap year.
 isLeapYear : Int -> Bool

compiler/damlc/tests/daml-test-files/PreludeTest.daml

@@ -1,40 +1,41 @@
 -- Copyright (c) 2020, Digital Asset (Switzerland) GmbH and/or its affiliates.
 -- All rights reserved.
 
--- @INFO range=51:26-51:42; Use uncurry
--- @INFO range=65:8-65:18; Redundant identity
--- @INFO range=66:12-66:26; Redundant identity
--- @INFO range=67:22-67:60; Redundant identity
--- @INFO range=89:8-89:17; Evaluate
--- @INFO range=93:12-93:21; Use elem
+-- @INFO range=52:26-52:42; Use uncurry
+-- @INFO range=66:8-66:18; Redundant identity
+-- @INFO range=67:12-67:26; Redundant identity
+-- @INFO range=68:22-68:60; Redundant identity
+-- @INFO range=90:8-90:17; Evaluate
 -- @INFO range=94:12-94:21; Use elem
--- @INFO range=95:10-95:19; Use elem
--- @INFO range=99:22-99:59; Redundant if
--- @INFO range=108:23-108:61; Redundant if
--- @INFO range=111:12-111:36; Use ||
--- @INFO range=113:11-113:34; Use ||
--- @INFO range=114:11-114:26; Use ||
--- @INFO range=117:12-117:37; Use &&
--- @INFO range=119:12-119:36; Use &&
--- @INFO range=120:11-120:27; Use &&
--- @INFO range=155:11-155:35; Use isNone
--- @INFO range=155:20-155:34; Use $>
--- @INFO range=161:9-161:55; Evaluate
--- @INFO range=162:9-162:58; Evaluate
--- @INFO range=175:16-175:35; Use ++
--- @INFO range=179:8-179:21; Redundant flip
--- @INFO range=180:14-180:37; Redundant flip
--- @INFO range=206:12-206:52; Evaluate
--- @INFO range=218:9-218:28; Take on a non-positive
--- @INFO range=224:9-224:28; Drop on a non-positive
--- @INFO range=290:27-290:38; Use zip
--- @INFO range=291:37-291:48; Use zip
--- @INFO range=295:37-295:50; Use zip3
--- @INFO range=296:52-296:65; Use zip3
--- @INFO range=308:8-308:20; Evaluate
--- @INFO range=311:10-311:22; Evaluate
--- @INFO range=315:12-315:19; Evaluate
-
+-- @INFO range=95:12-95:21; Use elem
+-- @INFO range=96:10-96:19; Use elem
+-- @INFO range=100:22-100:59; Redundant if
+-- @INFO range=109:23-109:61; Redundant if
+-- @INFO range=112:12-112:36; Use ||
+-- @INFO range=114:11-114:34; Use ||
+-- @INFO range=115:11-115:26; Use ||
+-- @INFO range=118:12-118:37; Use &&
+-- @INFO range=120:12-120:36; Use &&
+-- @INFO range=121:11-121:27; Use &&
+-- @INFO range=156:11-156:35; Use isNone
+-- @INFO range=156:20-156:34; Use $>
+-- @INFO range=162:9-162:55; Evaluate
+-- @INFO range=163:9-163:58; Evaluate
+-- @INFO range=176:16-176:35; Use ++
+-- @INFO range=180:8-180:21; Redundant flip
+-- @INFO range=181:14-181:37; Redundant flip
+-- @INFO range=207:12-207:52; Evaluate
+-- @INFO range=219:9-219:28; Take on a non-positive
+-- @INFO range=225:9-225:28; Drop on a non-positive
+-- @INFO range=291:27-291:38; Use zip
+-- @INFO range=292:37-292:48; Use zip
+-- @INFO range=296:37-296:50; Use zip3
+-- @INFO range=297:52-297:65; Use zip3
+-- @INFO range=309:8-309:20; Evaluate
+-- @INFO range=312:10-312:22; Evaluate
+-- @INFO range=316:12-316:19; Evaluate
+-- @ERROR range=383:0-383:16; Day 29 falls outside of valid day range (1 .. 28) for Feb 2100.
+-- @ERROR range=387:0-387:17; Day 0 falls outside of valid day range (1 .. 31) for Jan 2000.
 
 module PreludeTest where
 
@@ -377,3 +378,11 @@ testDiv = scenario do
 testDayOfWeek = scenario do
     assert $ dayOfWeek (date 1900 Jan 01) == Monday
     assert $ dayOfWeek (date 2018 Jan 17) == Wednesday
+    assert $ dayOfWeek (date 2020 Feb 29) == Saturday
+
+testDateOverflow = scenario do
+    pure $ date 2100 Feb 29
+      -- 2100 is not a leap year!
+
+testDateUnderflow = scenario do
+    pure $ date 2000 Jan 0