clock 0.7.2 → 0.8
raw patch · 5 files changed
+76/−48 lines, 5 filesdep +criteriondep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: criterion
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- System/Clock.hsc +8/−9
- bench/benchmarks.hs +26/−0
- cbits/hs_clock_win32.c +12/−2
- clock.cabal +17/−3
- tests/test.hs +13/−34
System/Clock.hsc view
@@ -41,7 +41,9 @@ # endif #endif -#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)+#if __GLASGOW_HASKELL__ < 800+# let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)+#endif -- | Clock types. A clock may be system-wide (that is, visible to all processes) -- or per-process (measuring time that is meaningful only within a process).@@ -126,12 +128,12 @@ 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-foreign import ccall clock_gettime :: #{type clockid_t} -> Ptr TimeSpec -> IO ()-foreign import ccall clock_getres :: #{type clockid_t} -> Ptr TimeSpec -> IO ()+foreign import ccall unsafe clock_gettime :: #{type clockid_t} -> Ptr TimeSpec -> IO ()+foreign import ccall unsafe clock_getres :: #{type clockid_t} -> Ptr TimeSpec -> IO () #endif -#if defined(_WIN32)-#elif defined(__MACH__) && defined(__APPLE__)+#if !defined(_WIN32)+#if defined(__MACH__) && defined(__APPLE__) clockToConst :: Clock -> #{type clock_id_t} clockToConst Monotonic = #const SYSTEM_CLOCK clockToConst Realtime = #const CALENDAR_CLOCK@@ -143,23 +145,20 @@ clockToConst Realtime = #const CLOCK_REALTIME clockToConst ProcessCPUTime = #const CLOCK_PROCESS_CPUTIME_ID clockToConst ThreadCPUTime = #const CLOCK_THREAD_CPUTIME_ID+#endif #if defined (CLOCK_MONOTONIC_RAW) clockToConst MonotonicRaw = #const CLOCK_MONOTONIC_RAW #endif- #if defined (CLOCK_BOOTTIME) clockToConst Boottime = #const CLOCK_BOOTTIME #endif- #if defined (CLOCK_MONOTONIC_COARSE) clockToConst MonotonicCoarse = #const CLOCK_MONOTONIC_COARSE #endif- #if defined (CLOCK_REALTIME_COARSE) clockToConst RealtimeCoarse = #const CLOCK_REALTIME_COARSE #endif- #endif allocaAndPeek :: Storable a => (Ptr a -> IO ()) -> IO a
+ bench/benchmarks.hs view
@@ -0,0 +1,26 @@+{-# language CPP #-}+module Main (main) where++import Criterion.Main+import System.Clock++#if MIN_VERSION_base(4,11,0)+import GHC.Clock+#endif++main :: IO ()+main = defaultMain [+ bgroup "getTime" [+ bench "Monotonic" $ whnfIO (getTime Monotonic)+ , bench "Realtime" $ whnfIO (getTime Realtime)+ , bench "ProcessCPUTime" $ whnfIO (getTime ProcessCPUTime)+ , bench "ThreadCPUTime" $ whnfIO (getTime ThreadCPUTime)+ , bench "MonotonicRaw" $ whnfIO (getTime MonotonicRaw)+ , bench "Boottime" $ whnfIO (getTime Boottime)+ , bench "MonotonicCoarse" $ whnfIO (getTime MonotonicCoarse)+ , bench "RealtimeCoarse" $ whnfIO (getTime RealtimeCoarse)+ ]+#if MIN_VERSION_base(4,11,0)+ , bench "GHC.Clock.getMonotonicTimeNSec" $ whnfIO getMonotonicTimeNSec+#endif+ ]
cbits/hs_clock_win32.c view
@@ -28,12 +28,22 @@ t[1] = 100*(long)(t_100ns % 10000000UL); } +/* See https://ghc.haskell.org/trac/ghc/ticket/15094 */+#if defined(_WIN32) && !defined(_WIN64)+__attribute__((optimize("-fno-expensive-optimizations")))+#endif void hs_clock_win32_gettime_monotonic(long long* t) { LARGE_INTEGER time;- LARGE_INTEGER frequency;+ static LARGE_INTEGER frequency;+ static int hasFreq = 0;+ QueryPerformanceCounter(&time);- QueryPerformanceFrequency(&frequency);+ if (!hasFreq)+ {+ hasFreq = 1;+ QueryPerformanceFrequency(&frequency);+ } // seconds t[0] = time.QuadPart / frequency.QuadPart; // nanos =
clock.cabal view
@@ -1,5 +1,5 @@ name: clock-version: 0.7.2+version: 0.8 stability: stable synopsis: High-resolution clock functions: monotonic, realtime, cputime. description: A package for convenient access to high-resolution clock and@@ -33,6 +33,8 @@ . Fixes for older Linux build failures introduced by new Linux-specific clocks by Mario Longobardi on 2016-04-18. .+ Refreshment release in 2019-04 after numerous contributions.+ . [Version Scheme] Major-@/R/@-ewrite . New-@/F/@-unctionality . @/I/@-mprovementAndBugFixes . @/P/@-ackagingOnly .@@ -41,8 +43,8 @@ copyright: Copyright © Cetin Sert 2009-2016, Eugene Kirpichov 2010, Finn Espen Gundersen 2013, Gerolf Seitz 2013, Mathieu Boespflug 2014 2015, Chris Done 2015, Dimitri Sabadie 2015, Christian Burger 2015, Mario Longobardi 2016 license: BSD3 license-file: LICENSE-author: Cetin Sert <cetin@corsis.eu>, Corsis Research-maintainer: Cetin Sert <cetin@corsis.eu>, Corsis Research+author: Cetin Sert <cetin@corsis.tech>, Corsis Research+maintainer: Cetin Sert <cetin@corsis.tech>, Corsis Research homepage: https://github.com/corsis/clock bug-reports: https://github.com/corsis/clock/issues category: System@@ -94,4 +96,16 @@ base >= 4 && < 5 , tasty >= 0.10 , tasty-quickcheck+ , clock++benchmark benchmarks+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ bench+ main-is:+ benchmarks.hs+ build-depends:+ base >= 4 && < 5+ , criterion , clock
tests/test.hs view
@@ -14,46 +14,25 @@ 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- ]+tests = testGroup "All tests" [numInstanceTests, ordInstanceTests] -eqOrdInstancesTests = testGroup "Eq and Ord instance tests" [- -- let's make at least 100,000 tests- qcEqOrdInstance- ]+numInstanceTests = testGroup "Num instance tests" [qcNumInstance]+ordInstanceTests = testGroup "Ord instance tests" [qcOrdInstance] 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" $+ 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 == toNanoSecs (fromInteger x + fromInteger y)+ , QuickCheck.testProperty "integer subtraction equals TimeSpec subtracttion" $ \ x y -> x - y == toNanoSecs (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+ let rationalMul = truncate ((x :: Nano) * (y :: Nano) * (10^9))+ timespecMul = toNanoSecs (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"+qcOrdInstance = 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))+ QuickCheck.testProperty "random list of TimeSpecs is sorted like equivalent list of integers" $ \ x -> sort (x :: [TimeSpec]) == map (fromInteger) (sort (map toNanoSecs x)) ]