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

test unix: fix time-zone test

parent 5615013a
No related branches found
No related tags found
No related merge requests found
......@@ -101,7 +101,7 @@ toCTime t = let
tt = fromIntegral t
t' = fromIntegral tt
-- there's no instance Bounded CTime, so this is the easiest way to check for overflow
in if t' == t then return $ CTime tt else fail "Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow" where
in if t' == t then return $ CTime tt else fail "Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow"
-- | Get the local time-zone for a given time (varying as per summertime adjustments).
getTimeZoneSystem :: SystemTime -> IO TimeZone
......
......@@ -9,7 +9,7 @@ import Test.Tasty.HUnit
testTimeZone :: TestTree
testTimeZone = testCase "getTimeZone respects TZ env var" $ do
let epoch = UTCTime (ModifiedJulianDay 0) 0
let epoch = UTCTime (ModifiedJulianDay 57000) 0
putEnv "TZ=UTC+0"
zone1 <- getTimeZone epoch
putEnv "TZ=EST+5"
......
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