From: Iustin Pop <ius...@google.com>
Reading the source for that function is scary: it uses local time conversions
in the context of what should be absolute (not local) time, so of course it has
daylight savings time issues. It would be hard to work around those, so add a
FIXME and work around the test failure.
Found by using seed 7676442054323374465 on a 64-bit machine:
timediffAdd: [Failed]
*** Failed! Falsifiable (after 465 tests):
Tue Jul 15 06:06:46 CEST 2008
Wed Jan 5 15:00:19 CET 2028
Fri Oct 5 18:35:48 CEST 2001
Expected equality, but got mismatch
expected: Fri Oct 5 18:35:48 CEST 2001
but got: Fri Oct 5 19:35:48 CEST 2001
Signed-off-by: Iustin Pop <ius...@google.com>
---
src/Ganeti/Utils.hs | 3 +++
test/hs/Test/Ganeti/Utils.hs | 7 ++++++-
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs
index 25f3843..a68826f 100644
--- a/src/Ganeti/Utils.hs
+++ b/src/Ganeti/Utils.hs
@@ -510,6 +510,9 @@ cTimeToClockTime :: EpochTime -> ClockTime
cTimeToClockTime (CTime timet) = TOD (toInteger timet) 0
-- | A version of `diffClockTimes` that works around ghc bug #2519.
+--
+-- FIXME: diffClocktimes uses local time (badly), so it still has
+-- issues when daylight savings time. Move to new time library!
diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
diffClockTimes t1 t2 =
let delta = STime.diffClockTimes t1 t2
diff --git a/test/hs/Test/Ganeti/Utils.hs b/test/hs/Test/Ganeti/Utils.hs
index c65db11..c437807 100644
--- a/test/hs/Test/Ganeti/Utils.hs
+++ b/test/hs/Test/Ganeti/Utils.hs
@@ -299,7 +299,12 @@ prop_timediffAdd :: ClockTime -> ClockTime -> ClockTime ->
Property
prop_timediffAdd a b c =
let fwd = Ganeti.Utils.diffClockTimes a b
back = Ganeti.Utils.diffClockTimes b a
- in addToClockTime fwd (addToClockTime back c) ==? c
+ c' = addToClockTime fwd (addToClockTime back c)
+ TOD cs cp = c
+ TOD cs' cp' = c'
+ in counterexample "Dates match exactly" (c' ==? c) .||.
+ counterexample "Dates match except daylight savings time"
+ (cs' - cs ==? 3600 .&&. cp' ==? cp)
-- | Test normal operation for 'chompPrefix'.
--
--
2.8.1
