diff --git a/System/Clock.hsc b/System/Clock.hsc --- a/System/Clock.hsc +++ b/System/Clock.hsc @@ -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 @@ -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) diff --git a/clock.cabal b/clock.cabal --- a/clock.cabal +++ b/clock.cabal @@ -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 diff --git a/tests/test.hs b/tests/test.hs new file mode 100644 --- /dev/null +++ b/tests/test.hs @@ -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)) + ]