Skip to content
Snippets Groups Projects
Commit 7c29ef79 authored by Ashley Yakeley's avatar Ashley Yakeley
Browse files

tests for leap-second conversion

parent d6863ffe
No related branches found
No related tags found
No related merge requests found
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
]
]
...@@ -37,3 +37,23 @@ diff :: (Show a,Eq a) => a -> a -> Result ...@@ -37,3 +37,23 @@ diff :: (Show a,Eq a) => a -> a -> Result
diff expected found | expected == found = Pass diff expected found | expected == found = Pass
diff expected found = Fail ("expected " ++ (show expected) ++ " but found " ++ (show found)) 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"
...@@ -11,6 +11,7 @@ import Test.TestEaster ...@@ -11,6 +11,7 @@ import Test.TestEaster
import Test.TestFormat import Test.TestFormat
import Test.TestMonthDay import Test.TestMonthDay
import Test.TestParseTime import Test.TestParseTime
import Test.TestTAI
import Test.TestTime import Test.TestTime
import Test.TestTimeZone import Test.TestTimeZone
import Test.TestValid import Test.TestValid
...@@ -25,6 +26,7 @@ tests = [ addDaysTest ...@@ -25,6 +26,7 @@ tests = [ addDaysTest
, testFormat , testFormat
, testMonthDay , testMonthDay
, testParseTime , testParseTime
, testTAI
, testTime , testTime
, testTimeZone , testTimeZone
, testValid ] , testValid ]
...@@ -140,6 +140,7 @@ test-suite tests ...@@ -140,6 +140,7 @@ test-suite tests
Test.TestEasterRef Test.TestEasterRef
Test.TestCalendars Test.TestCalendars
Test.TestCalendarsRef Test.TestCalendarsRef
Test.TestTAI
Test.TestTimeZone Test.TestTimeZone
Test.TestValid Test.TestValid
Test.LongWeekYears Test.LongWeekYears
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment