clock 0.4.6.0 → 0.5.0.0
raw patch · 3 files changed
+116/−19 lines, 3 filesdep +clockdep +tastydep +tasty-quickcheckdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: clock, tasty, tasty-quickcheck
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- System/Clock.hsc +38/−16
- clock.cabal +19/−3
- tests/test.hs +59/−0
System/Clock.hsc view
@@ -24,7 +24,7 @@ #if defined(_WIN32) # include "hs_clock_win32.c"-#elif defined(__MACH__)+#elif defined(__MACH__) && defined(__APPLE__) # include "hs_clock_darwin.c" #else # include <time.h>@@ -76,7 +76,7 @@ foreign import ccall hs_clock_win32_getres_realtime :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_getres_processtime :: Ptr TimeSpec -> IO () foreign import ccall hs_clock_win32_getres_threadtime :: Ptr TimeSpec -> IO ()-#elif defined(__MACH__)+#elif defined(__MACH__) && defined(__APPLE__) foreign import ccall hs_clock_darwin_gettime :: #{type clock_id_t} -> Ptr TimeSpec -> IO () foreign import ccall hs_clock_darwin_getres :: #{type clock_id_t} -> Ptr TimeSpec -> IO () #else@@ -85,7 +85,7 @@ #endif #if defined(_WIN32)-#elif defined(__MACH__)+#elif defined(__MACH__) && defined(__APPLE__) clockToConst :: Clock -> #{type clock_id_t} clockToConst Monotonic = #const SYSTEM_CLOCK clockToConst Realtime = #const CALENDAR_CLOCK@@ -116,7 +116,7 @@ getTime Realtime = allocaAndPeek hs_clock_win32_gettime_realtime getTime ProcessCPUTime = allocaAndPeek hs_clock_win32_gettime_processtime getTime ThreadCPUTime = allocaAndPeek hs_clock_win32_gettime_threadtime-#elif defined(__MACH__)+#elif defined(__MACH__) && defined(__APPLE__) getTime clk = allocaAndPeek $ hs_clock_darwin_gettime $ clockToConst clk #else getTime clk = allocaAndPeek $ clock_gettime $ clockToConst clk@@ -127,7 +127,7 @@ getRes Realtime = allocaAndPeek hs_clock_win32_getres_realtime getRes ProcessCPUTime = allocaAndPeek hs_clock_win32_getres_processtime getRes ThreadCPUTime = allocaAndPeek hs_clock_win32_getres_threadtime-#elif defined(__MACH__)+#elif defined(__MACH__) && defined(__APPLE__) getRes clk = allocaAndPeek $ hs_clock_darwin_getres $ clockToConst clk #else getRes clk = allocaAndPeek $ clock_getres $ clockToConst clk@@ -137,7 +137,7 @@ data TimeSpec = TimeSpec { sec :: {-# UNPACK #-} !Int64 -- ^ seconds , nsec :: {-# UNPACK #-} !Int64 -- ^ nanoseconds- } deriving (Eq, Generic, Read, Show, Typeable)+ } deriving (Generic, Read, Show, Typeable) #if defined(_WIN32) instance Storable TimeSpec where@@ -166,31 +166,53 @@ #endif normalize :: TimeSpec -> TimeSpec-normalize (TimeSpec xs xn) =+normalize (TimeSpec xs xn)+ | xn < 0 || xn >= 10^9 = let (q, r) = xn `divMod` (10^9) in TimeSpec (xs + q) r+ | otherwise = TimeSpec xs xn instance Num TimeSpec where (TimeSpec xs xn) + (TimeSpec ys yn) = normalize $ TimeSpec (xs + ys) (xn + yn) (TimeSpec xs xn) - (TimeSpec ys yn) = normalize $ TimeSpec (xs - ys) (xn - yn)- (TimeSpec xs xn) * (TimeSpec ys yn) =- normalize $ TimeSpec (xs * ys) (xn * yn)+ (normalize -> TimeSpec xs xn) * (normalize -> TimeSpec ys yn) =+ let+ -- convert to arbitraty Integer type to avoid int overflow+ xsi = toInteger xs+ xni = toInteger xn+ ysi = toInteger ys+ yni = toInteger yn+ in+ normalize $ TimeSpec+ -- seconds+ (fromInteger $ xsi * ysi)+ -- nanoseconds+ (fromInteger $ (xni * yni + (xni * ysi + xsi * yni) * (10^9)) + `div` (10^9)) negate (TimeSpec xs xn) = normalize $ TimeSpec (negate xs) (negate xn)- abs (TimeSpec xs xn) =- normalize $ TimeSpec (abs xs) (signum xs * xn)- signum (normalize -> TimeSpec xs yn)- | signum xs == 0 = TimeSpec 0 (signum yn)- | otherwise = TimeSpec 0 (signum xs)+ abs (normalize -> TimeSpec xs xn)+ | xs == 0 = normalize $ TimeSpec 0 xn+ | otherwise = normalize $ TimeSpec (abs xs) (signum xs * xn)+ signum (normalize -> TimeSpec xs xn)+ | xs == 0 = TimeSpec (signum xn) 0+ | otherwise = TimeSpec (signum xs) 0 fromInteger x = -- For range, compute div, mod over integers, not any bounded type. let (q, r) = x `divMod` (10^9) in TimeSpec (fromInteger q) (fromInteger r) +instance Eq TimeSpec where+ (normalize -> TimeSpec xs xn) == (normalize -> TimeSpec ys yn)+ | True == equality = xn == yn+ | otherwise = equality+ where+ equality = xs == ys+ instance Ord TimeSpec where- compare (TimeSpec xs xn) (TimeSpec ys yn)+ compare (normalize -> TimeSpec xs xn) (normalize -> TimeSpec ys yn) | EQ == ordering = compare xn yn | otherwise = ordering where@@ -202,4 +224,4 @@ -- | TimeSpec as nano seconds. timeSpecAsNanoSecs :: TimeSpec -> Integer-timeSpecAsNanoSecs t = toInteger (sec t) * 1000000000 + toInteger (nsec t)+timeSpecAsNanoSecs t = toInteger (sec t) * (10^9) + toInteger (nsec t)
clock.cabal view
@@ -1,5 +1,5 @@ name: clock-version: 0.4.6.0+version: 0.5.0.0 stability: stable synopsis: High-resolution clock functions: monotonic, realtime, cputime. description: A package for convenient access to high-resolution clock and@@ -23,7 +23,7 @@ . Imported Control.Applicative operators correctly for Haskell Platform on Windows on 2015-04-21. .- GNU/HURD build failure reported by Pino Toscano, patched by Joachim Breitner on 2015-05-07.+ Unit tests and instance fixes by Christian Burger on 2015-06-25. . [Version Scheme] Major-@/R/@-ewrite . New-@/F/@-unctionality . @/I/@-mprovementAndBugFixes . @/P/@-ackagingOnly@@ -39,7 +39,7 @@ bug-reports: https://github.com/corsis/clock/issues category: System build-type: Simple-cabal-version: >= 1.6+cabal-version: >= 1.8 source-repository head@@ -71,3 +71,19 @@ if flag(llvm) ghc-options: -fllvm -optlo-O3+++test-suite test+-- default-language:+-- Haskell2010+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ tests+ main-is:+ test.hs+ build-depends:+ base >= 4 && < 5+ , tasty >= 0.10+ , tasty-quickcheck+ , clock
+ tests/test.hs view
@@ -0,0 +1,59 @@+import Test.Tasty+import Test.Tasty.QuickCheck as QuickCheck+import Data.Fixed+import Data.List+-- import Test.Tasty.HUnit as HUnit+import System.Clock++instance Arbitrary TimeSpec where+ arbitrary = do+ sec <- arbitrarySizedIntegral+ nan <- arbitrarySizedIntegral+ return $ TimeSpec sec nan++main = defaultMain (adjustOption (QuickCheckTests 100000 +) $ tests)++tests :: TestTree+tests = testGroup "All tests" [numInstanceTests, eqOrdInstancesTests]++numInstanceTests = testGroup "Num class tests" [+ -- let's make at least 100,000 tests+ qcNumInstance+ ]++eqOrdInstancesTests = testGroup "Eq and Ord instance tests" [+ -- let's make at least 100,000 tests+ qcEqOrdInstance+ ]++qcNumInstance = testGroup "QuickCheck"+ [ + QuickCheck.testProperty "x = abs(x) * signum(x)" $+ \ x -> (x :: TimeSpec) == (abs x) * (signum x)+ , QuickCheck.testProperty "integer addition equals TimeSpec addition" $+ \ x y -> x + y == timeSpecAsNanoSecs (fromInteger x + fromInteger y)+ , QuickCheck.testProperty "integer substraction equals TimeSpec addition" $+ \ x y -> x - y == timeSpecAsNanoSecs (fromInteger x - fromInteger y)+ , QuickCheck.testProperty+ "rational multiplication equals TimeSpec multiplication" $+ \ x y ->+ let+ rationalMul = truncate ((x :: Nano) * (y :: Nano) * (10^9))+ timespecMul = timeSpecAsNanoSecs (+ fromInteger (truncate (x * 10^9))+ * fromInteger (truncate (y * 10^9)))+ in+ rationalMul == timespecMul+ , QuickCheck.testProperty "neg(neg(x)) = x" $+ \ x -> negate (negate x :: TimeSpec) == x+ ]++qcEqOrdInstance = testGroup "QuickCheck"+ [+ QuickCheck.testProperty+ "random list of TimeSpecs is sorted like equivalent list of integers" $+ \ x ->+ sort (x :: [TimeSpec])+ ==+ map (fromInteger) (sort (map timeSpecAsNanoSecs x))+ ]