[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty: tests for leap-second conversion (7c29ef7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/time

On branches: format-widths,ghc,improve-leapseconds,master,posix-perf,tasty
Link       : http://git.haskell.org/packages/time.git/commitdiff/7c29ef790802bfab897ad1b116b0b94761e4eff0

>---------------------------------------------------------------

commit 7c29ef790802bfab897ad1b116b0b94761e4eff0
Author: Ashley Yakeley <ashley at yakeley.org>
Date:   Sat Nov 19 00:14:39 2016 -0800

    tests for leap-second conversion


>---------------------------------------------------------------

7c29ef790802bfab897ad1b116b0b94761e4eff0
 test/Test/TestTAI.hs  | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++
 test/Test/TestUtil.hs | 20 +++++++++++++++++
 test/Test/Tests.hs    |  2 ++
 time.cabal            |  1 +
 4 files changed, 83 insertions(+)

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