mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-19 08:48:21 +03:00
Fix missing date under/overflow in DA.Date.date (#7393)
* Fix missing date under/overflow in DA.Date.date changelog_begin - [DAML Standard Library] Bugfix: DA.Date.date now raises an error when the day argument is outside the valid range. changelog_end * Add test for underflow too
This commit is contained in:
parent
f28c877584
commit
ef67efbaaf
@ -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,6 +82,7 @@ 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
|
||||
@ -88,8 +90,12 @@ date year month day =
|
||||
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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user