[commit: packages/time] ghc, master: Use floor instead of truncate (2060aed)
git at git.haskell.org
git at git.haskell.org
Fri Apr 21 16:57:47 UTC 2017
Repository : ssh://git@git.haskell.org/time
On branches: ghc,master
Link : http://git.haskell.org/packages/time.git/commitdiff/2060aed5608eeee73efa7691df2dfc7e2a4d4e3c
>---------------------------------------------------------------
commit 2060aed5608eeee73efa7691df2dfc7e2a4d4e3c
Author: Ashley Yakeley <ashley at yakeley.org>
Date: Sat Mar 11 11:39:17 2017 -0800
Use floor instead of truncate
>---------------------------------------------------------------
2060aed5608eeee73efa7691df2dfc7e2a4d4e3c
lib/Data/Time/Format.hs | 2 +-
lib/Data/Time/Format/Parse.hs | 4 +-
test/main/Test/Format/ParseTime.hs | 6 +--
test/unix/Test/Format/Format.hs | 75 +++++++++++++++++++++++---------------
time.cabal | 1 +
5 files changed, 53 insertions(+), 35 deletions(-)
diff --git a/lib/Data/Time/Format.hs b/lib/Data/Time/Format.hs
index 7cea584..bb03e24 100644
--- a/lib/Data/Time/Format.hs
+++ b/lib/Data/Time/Format.hs
@@ -273,7 +273,7 @@ instance FormatTime TimeOfDay where
-- 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
diff --git a/lib/Data/Time/Format/Parse.hs b/lib/Data/Time/Format/Parse.hs
index d12291b..2c47d2b 100644
--- a/lib/Data/Time/Format/Parse.hs
+++ b/lib/Data/Time/Format/Parse.hs
@@ -510,10 +510,10 @@ instance ParseTime TimeOfDay where
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)
diff --git a/test/main/Test/Format/ParseTime.hs b/test/main/Test/Format/ParseTime.hs
index 340f319..4ba383d 100644
--- a/test/main/Test/Format/ParseTime.hs
+++ b/test/main/Test/Format/ParseTime.hs
@@ -261,7 +261,7 @@ instance Arbitrary LocalTime where
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)
@@ -273,13 +273,13 @@ instance Arbitrary ZonedTime where
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
diff --git a/test/unix/Test/Format/Format.hs b/test/unix/Test/Format/Format.hs
index a6ea8a5..49ea218 100644
--- a/test/unix/Test/Format/Format.hs
+++ b/test/unix/Test/Format/Format.hs
@@ -1,11 +1,13 @@
+{-# 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
@@ -34,36 +36,51 @@ unixFormatTime fmt zone time = unsafePerformIO $ withCString fmt (\pfmt -> withC
(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
-
-times :: Gen UTCTime
-times = do
- day <- choose (-25000,75000)
- time <- return midnight
- let
- -- verify that the created time can fit in the local CTime
- localT = LocalTime (ModifiedJulianDay day) time
- utcT = localTimeToUTC utc localT
- secondsInteger = truncate (utcTimeToPOSIXSeconds utcT)
- CTime secondsCTime = fromInteger secondsInteger
- secondsInteger' = toInteger secondsCTime
- if secondsInteger == secondsInteger'
- then return utcT
- else times
+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)
+
+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
+
+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)
+ CTime secondsCTime = fromInteger secondsInteger
+ secondsInteger' = toInteger secondsCTime
+ if secondsInteger == secondsInteger'
+ then return utcT
+ else arbitrary
padN :: Int -> Char -> String -> String
padN n _ s | n <= (length s) = s
@@ -124,14 +141,14 @@ hashformats = do
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
diff --git a/time.cabal b/time.cabal
index ae82f16..e93c857 100644
--- a/time.cabal
+++ b/time.cabal
@@ -181,6 +181,7 @@ test-suite test-unix
base,
deepseq,
time,
+ random,
QuickCheck,
tasty,
tasty-hunit,
More information about the ghc-commits
mailing list