time 1.8 → 1.8.0.1
raw patch · 15 files changed
+86/−60 lines, 15 filesdep +random
Dependencies added: random
Files
- changelog.md +3/−0
- configure.ac +1/−1
- lib/Data/Time/Format.hs +1/−1
- lib/Data/Time/Format/Parse.hs +2/−2
- lib/Data/Time/LocalTime/Internal/TimeZone.hs +13/−2
- test/main/Main.hs +1/−6
- test/main/Test/Calendar/ClipDates.hs +0/−2
- test/main/Test/Calendar/Easter.hs +0/−2
- test/main/Test/Format/ParseTime.hs +7/−9
- test/main/Test/TestUtil.hs +0/−1
- test/unix/Main.hs +1/−6
- test/unix/Test/Format/Format.hs +53/−23
- test/unix/Test/LocalTime/TimeZone.hs +1/−3
- test/unix/Test/TestUtil.hs +0/−1
- time.cabal +3/−1
changelog.md view
@@ -1,5 +1,8 @@ # Change Log +## [1.8.0.1]+- Get building on 32 bit machine+ ## [1.8] - Added SystemTime - Data.Time.Format: allow padding widths in specifiers for formatting (but not parsing)
configure.ac view
@@ -1,4 +1,4 @@-AC_INIT([Haskell time package], [1.8], [ashley@semantic.org], [time])+AC_INIT([Haskell time package], [1.8.0.1], [ashley@semantic.org], [time]) # Safety check: Ensure that we are in the correct source directory. AC_CONFIG_SRCDIR([lib/include/HsTime.h])
lib/Data/Time/Format.hs view
@@ -273,7 +273,7 @@ -- Minute formatCharacter 'M' = Just $ padNum True 2 '0' todMin -- Second- formatCharacter 'S' = Just $ padNum True 2 '0' $ (truncate . todSec :: TimeOfDay -> Int)+ formatCharacter 'S' = Just $ padNum True 2 '0' $ (floor . todSec :: TimeOfDay -> Int) formatCharacter 'q' = Just $ padGeneral True True 12 '0' $ \_ pado -> showPaddedFixedFraction pado . todSec formatCharacter 'Q' = Just $ padGeneral True False 12 '0' $ \_ pado -> ('.':) . showPaddedFixedFraction pado . todSec
lib/Data/Time/Format/Parse.hs view
@@ -510,10 +510,10 @@ return $ TimeOfDay h m (fromInteger a) 'q' -> do a <- ra- return $ TimeOfDay h m (mkPico (truncate s) a)+ return $ TimeOfDay h m (mkPico (floor s) a) 'Q' -> if null x then Just t else do ps <- readMaybe $ take 12 $ rpad 12 '0' $ drop 1 x- return $ TimeOfDay h m (mkPico (truncate s) ps)+ return $ TimeOfDay h m (mkPico (floor s) ps) _ -> Just t in mfoldl f (Just midnight)
lib/Data/Time/LocalTime/Internal/TimeZone.hs view
@@ -96,13 +96,24 @@ return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name) )) +toCTime :: Int64 -> IO CTime+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"+ -- | Get the local time-zone for a given time (varying as per summertime adjustments). getTimeZoneSystem :: SystemTime -> IO TimeZone-getTimeZoneSystem = getTimeZoneCTime . CTime . systemSeconds+getTimeZoneSystem t = do+ ctime <- toCTime $ systemSeconds t+ getTimeZoneCTime ctime -- | Get the local time-zone for a given time (varying as per summertime adjustments). getTimeZone :: UTCTime -> IO TimeZone-getTimeZone = getTimeZoneCTime . fromInteger . floor . utcTimeToPOSIXSeconds+getTimeZone t = do+ ctime <- toCTime $ floor $ utcTimeToPOSIXSeconds t+ getTimeZoneCTime ctime -- | Get the current time-zone. getCurrentTimeZone :: IO TimeZone
test/main/Main.hs view
@@ -1,6 +1,5 @@ module Main where -import Foreign.C.Types import Test.Tasty import Test.Calendar.AddDays import Test.Calendar.Calendars@@ -45,8 +44,4 @@ ] main :: IO ()-main = do- if (toRational (1000000000000 :: CTime)) /= (1000000000000 :: Rational)- then putStrLn "WARNING: Some tests will incorrectly fail due to a 32-bit time_t C type."- else return ()- defaultMain tests+main = defaultMain tests
test/main/Test/Calendar/ClipDates.hs view
@@ -1,5 +1,3 @@-{-# Language TupleSections #-}- module Test.Calendar.ClipDates(clipDates) where import Data.Time.Calendar.OrdinalDate
test/main/Test/Calendar/Easter.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -Wall -Werror #-}- module Test.Calendar.Easter(testEaster) where import Data.Time.Calendar.Easter
test/main/Test/Format/ParseTime.hs view
@@ -1,6 +1,4 @@-{-# OPTIONS -fno-warn-type-defaults -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, ExistentialQuantification #-}-+{-# OPTIONS -fno-warn-orphans #-} module Test.Format.ParseTime(testParseTime,test_parse_format) where import Control.Monad@@ -82,7 +80,7 @@ readOtherTypesTest :: TestTree readOtherTypesTest = testGroup "read other types" [- readTestsParensSpaces 3 "3",+ readTestsParensSpaces (3 :: Integer) "3", readTestsParensSpaces "a" "\"a\"" ] @@ -244,11 +242,11 @@ instance Arbitrary DiffTime where arbitrary = oneof [intSecs, fracSecs] -- up to 1 leap second where intSecs = liftM secondsToDiffTime' $ choose (0, 86400)- fracSecs = liftM picosecondsToDiffTime' $ choose (0, 86400 * 10^12)+ fracSecs = liftM picosecondsToDiffTime' $ choose (0, 86400 * 10^(12::Int)) secondsToDiffTime' :: Integer -> DiffTime secondsToDiffTime' = fromInteger picosecondsToDiffTime' :: Integer -> DiffTime- picosecondsToDiffTime' x = fromRational (x % 10^12)+ picosecondsToDiffTime' x = fromRational (x % 10^(12::Int)) instance CoArbitrary DiffTime where coarbitrary t = coarbitrary (fromEnum t)@@ -263,7 +261,7 @@ arbitrary = liftM2 LocalTime arbitrary arbitrary instance CoArbitrary LocalTime where- coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds (localTimeToUTC utc t)) :: Integer)+ coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds (localTimeToUTC utc t)) :: Integer) instance Arbitrary TimeZone where arbitrary = liftM minutesToTimeZone $ choose (-720,720)@@ -275,13 +273,13 @@ arbitrary = liftM2 ZonedTime arbitrary arbitrary instance CoArbitrary ZonedTime where- coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds (zonedTimeToUTC t)) :: Integer)+ coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC t)) :: Integer) instance Arbitrary UTCTime where arbitrary = liftM2 UTCTime arbitrary arbitrary instance CoArbitrary UTCTime where- coarbitrary t = coarbitrary (truncate (utcTimeToPOSIXSeconds t) :: Integer)+ coarbitrary t = coarbitrary (floor (utcTimeToPOSIXSeconds t) :: Integer) instance Arbitrary UniversalTime where arbitrary = liftM (\n -> ModJulianDate $ n % k) $ choose (-313698 * k, 2973483 * k) where -- 1000-01-1 to 9999-12-31
test/main/Test/TestUtil.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS -fno-warn-overlapping-patterns #-} module Test.TestUtil where import Test.QuickCheck.Property
test/unix/Main.hs view
@@ -1,6 +1,5 @@ module Main where -import Foreign.C.Types import Test.Tasty import Test.Format.Format import Test.LocalTime.TimeZone@@ -17,8 +16,4 @@ ] main :: IO ()-main = do- if (toRational (1000000000000 :: CTime)) /= (1000000000000 :: Rational)- then putStrLn "WARNING: Some tests will incorrectly fail due to a 32-bit time_t C type."- else return ()- defaultMain tests+main = defaultMain tests
test/unix/Test/Format/Format.hs view
@@ -1,17 +1,18 @@-{-# LANGUAGE ForeignFunctionInterface #-}-+{-# OPTIONS -fno-warn-orphans #-} module Test.Format.Format(testFormat) where import Data.Time import Data.Time.Clock.POSIX import Data.Char-import Data.Fixed+import Data.Fixed as F import Foreign import Foreign.C+import System.Random import Test.QuickCheck hiding (Result) import Test.QuickCheck.Property import Test.Tasty import Test.Tasty.HUnit+import Test.Tasty.QuickCheck import Test.TestUtil import System.IO.Unsafe @@ -36,28 +37,57 @@ (if timeZoneSummerOnly zone then 1 else 0) (fromIntegral (timeZoneMinutes zone * 60)) pzonename- (fromInteger (truncate (utcTimeToPOSIXSeconds time)))+ (fromInteger (floor (utcTimeToPOSIXSeconds time))) ) )) locale :: TimeLocale locale = defaultTimeLocale {dateTimeFmt = "%a %b %e %H:%M:%S %Y"} -zones :: Gen TimeZone-zones = do- mins <- choose (-2000,2000)- dst <- arbitrary- hasName <- arbitrary- let- name = if hasName then "ZONE" else ""- return $ TimeZone mins dst name+instance Random (F.Fixed res) where+ randomR (MkFixed lo,MkFixed hi) oldgen = let+ (v,newgen) = randomR (lo,hi) oldgen+ in (MkFixed v,newgen)+ random oldgen = let+ (v,newgen) = random oldgen+ in (MkFixed v,newgen) -times :: Gen UTCTime-times = do- day <- choose (-25000,75000)- time <- return midnight- return $ localTimeToUTC utc $ LocalTime (ModifiedJulianDay day) time+instance Arbitrary TimeZone where+ arbitrary = do+ mins <- choose (-2000,2000)+ dst <- arbitrary+ hasName <- arbitrary+ let+ name = if hasName then "ZONE" else ""+ return $ TimeZone mins dst name +instance Arbitrary TimeOfDay where+ arbitrary = do+ h <- choose (0,23)+ m <- choose (0,59)+ s <- choose (0,59.999999999999) -- don't allow leap-seconds+ return $ TimeOfDay h m s++-- | The size of 'CTime' is platform-dependent.+secondsFitInCTime :: Integer -> Bool+secondsFitInCTime sec = let+ CTime ct = fromInteger sec+ sec' = toInteger ct+ in sec == sec'++instance Arbitrary UTCTime where+ arbitrary = do+ day <- choose (-25000,75000)+ time <- arbitrary+ let+ -- verify that the created time can fit in the local CTime+ localT = LocalTime (ModifiedJulianDay day) time+ utcT = localTimeToUTC utc localT+ secondsInteger = floor (utcTimeToPOSIXSeconds utcT)+ if secondsFitInCTime (secondsInteger + 2*86400) && secondsFitInCTime (secondsInteger - 2*86400) -- two days slop each way+ then return utcT+ else arbitrary+ padN :: Int -> Char -> String -> String padN n _ s | n <= (length s) = s padN n c s = (replicate (n - length s) c) ++ s@@ -84,7 +114,7 @@ haskellText = formatTime locale fmt ctime unixText = unixFormatTime fmt zone time expectedText = unixWorkarounds fmt (modUnix unixText)- in assertEqualQC "" expectedText haskellText+ in assertEqualQC (show time ++ " with " ++ show zone) expectedText haskellText -- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html -- plus FgGklz@@ -117,14 +147,14 @@ testCompareFormat :: [TestTree] testCompareFormat = tgroup formats $ \fmt -> do- time <- times- zone <- zones+ time <- arbitrary+ zone <- arbitrary return $ compareFormat id fmt zone time testCompareHashFormat :: [TestTree] testCompareHashFormat = tgroup hashformats $ \fmt -> do- time <- times- zone <- zones+ time <- arbitrary+ zone <- arbitrary return $ compareFormat (fmap toLower) fmt zone time formatUnitTest :: String -> Pico -> String -> TestTree@@ -187,4 +217,4 @@ ] testFormat :: TestTree-testFormat = testGroup "testFormat" $ testCompareFormat ++ testCompareHashFormat ++ testQs+testFormat = localOption (QuickCheckTests 10000) $ testGroup "testFormat" $ testCompareFormat ++ testCompareHashFormat ++ testQs
test/unix/Test/LocalTime/TimeZone.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -Wall -Werror #-}- module Test.LocalTime.TimeZone(testTimeZone) where import Data.Time@@ -9,7 +7,7 @@ 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"
test/unix/Test/TestUtil.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS -fno-warn-overlapping-patterns #-} module Test.TestUtil where import Test.QuickCheck.Property
time.cabal view
@@ -1,5 +1,5 @@ name: time-version: 1.8+version: 1.8.0.1 stability: stable license: BSD3 license-file: LICENSE@@ -124,6 +124,7 @@ FlexibleInstances UndecidableInstances ScopedTypeVariables+ TupleSections ghc-options: -Wall -fwarn-tabs build-depends: base,@@ -180,6 +181,7 @@ base, deepseq, time,+ random, QuickCheck, tasty, tasty-hunit,