From 7c29ef790802bfab897ad1b116b0b94761e4eff0 Mon Sep 17 00:00:00 2001
From: Ashley Yakeley <ashley@yakeley.org>
Date: Sat, 19 Nov 2016 00:14:39 -0800
Subject: [PATCH] tests for leap-second conversion
---
test/Test/TestTAI.hs | 60 +++++++++++++++++++++++++++++++++++++++++++
test/Test/TestUtil.hs | 20 +++++++++++++++
test/Test/Tests.hs | 2 ++
time.cabal | 1 +
4 files changed, 83 insertions(+)
create mode 100644 test/Test/TestTAI.hs
diff --git a/test/Test/TestTAI.hs b/test/Test/TestTAI.hs
new file mode 100644
index 0000000..9284f35
--- /dev/null
+++ b/test/Test/TestTAI.hs
@@ -0,0 +1,60 @@
+module Test.TestTAI(testTAI) where
+
+import Data.Time
+import Data.Time.Clock.TAI
+import Test.TestUtil
+
+
+sampleLeapSecondMap :: LeapSecondMap Maybe
+sampleLeapSecondMap d | d < fromGregorian 1972 1 1 = Nothing
+sampleLeapSecondMap d | d < fromGregorian 1972 7 1 = Just 10
+sampleLeapSecondMap d | d < fromGregorian 1975 1 1 = Just 11
+sampleLeapSecondMap _ = Nothing
+
+testTAI :: TestTree;
+testTAI = testGroup "leap second transition" $ let
+ dayA = fromGregorian 1972 6 30
+ dayB = fromGregorian 1972 7 1
+
+ utcTime1 = UTCTime dayA 86399
+ utcTime2 = UTCTime dayA 86400
+ utcTime3 = UTCTime dayB 0
+
+ mAbsTime1 = utcToTAITime sampleLeapSecondMap utcTime1
+ mAbsTime2 = utcToTAITime sampleLeapSecondMap utcTime2
+ mAbsTime3 = utcToTAITime sampleLeapSecondMap utcTime3
+ in
+ [
+ testCase "mapping" $ do
+ assertEqual "dayA" (Just 10) $ sampleLeapSecondMap dayA
+ assertEqual "dayB" (Just 11) $ sampleLeapSecondMap dayB
+ ,
+ testCase "day length" $ do
+ assertEqual "dayA" (Just 86401) $ utcDayLength sampleLeapSecondMap dayA
+ assertEqual "dayB" (Just 86400) $ utcDayLength sampleLeapSecondMap dayB
+ ,
+ testCase "differences" $ do
+ absTime1 <- assertJust mAbsTime1
+ absTime2 <- assertJust mAbsTime2
+ absTime3 <- assertJust mAbsTime3
+ assertEqual "absTime2 - absTime1" 1 $ diffAbsoluteTime absTime2 absTime1
+ assertEqual "absTime3 - absTime2" 1 $ diffAbsoluteTime absTime3 absTime2
+ ,
+ testGroup "round-trip"
+ [
+ testCase "1" $ do
+ absTime <- assertJust mAbsTime1
+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime
+ assertEqual "round-trip" utcTime1 utcTime
+ ,
+ testCase "2" $ do
+ absTime <- assertJust mAbsTime2
+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime
+ assertEqual "round-trip" utcTime2 utcTime
+ ,
+ testCase "3" $ do
+ absTime <- assertJust mAbsTime3
+ utcTime <- assertJust $ taiToUTCTime sampleLeapSecondMap absTime
+ assertEqual "round-trip" utcTime3 utcTime
+ ]
+ ]
diff --git a/test/Test/TestUtil.hs b/test/Test/TestUtil.hs
index b711f93..cef8763 100644
--- a/test/Test/TestUtil.hs
+++ b/test/Test/TestUtil.hs
@@ -37,3 +37,23 @@ diff :: (Show a,Eq a) => a -> a -> Result
diff expected found | expected == found = Pass
diff expected found = Fail ("expected " ++ (show expected) ++ " but found " ++ (show found))
+
+-- for tasty-like test code
+
+type TestTree = Test
+type Assertion = Either String ()
+
+testCase :: String -> Assertion -> Test
+testCase name (Right ()) = pureTest name Pass
+testCase name (Left s) = pureTest name (Fail s)
+
+assertFailure :: String -> Either String a
+assertFailure = Left
+
+assertEqual :: (Show a,Eq a) => String -> a -> a -> Assertion
+assertEqual _ expected found | expected == found = return ()
+assertEqual name expected found = assertFailure $ name ++ ": expected " ++ (show expected) ++ " but found " ++ (show found)
+
+assertJust :: Maybe a -> Either String a
+assertJust (Just a) = return a
+assertJust Nothing = assertFailure "Nothing"
diff --git a/test/Test/Tests.hs b/test/Test/Tests.hs
index cd5ac0f..d241204 100644
--- a/test/Test/Tests.hs
+++ b/test/Test/Tests.hs
@@ -11,6 +11,7 @@ import Test.TestEaster
import Test.TestFormat
import Test.TestMonthDay
import Test.TestParseTime
+import Test.TestTAI
import Test.TestTime
import Test.TestTimeZone
import Test.TestValid
@@ -25,6 +26,7 @@ tests = [ addDaysTest
, testFormat
, testMonthDay
, testParseTime
+ , testTAI
, testTime
, testTimeZone
, testValid ]
diff --git a/time.cabal b/time.cabal
index e48087a..8b520b4 100644
--- a/time.cabal
+++ b/time.cabal
@@ -140,6 +140,7 @@ test-suite tests
Test.TestEasterRef
Test.TestCalendars
Test.TestCalendarsRef
+ Test.TestTAI
Test.TestTimeZone
Test.TestValid
Test.LongWeekYears
--
GitLab