clock 0.7.2 → 0.8.4
raw patch · 9 files changed
Files
- CHANGELOG.md +7/−0
- LICENSE +1/−2
- System/Clock.hsc +116/−72
- System/Clock/Seconds.hs +77/−0
- bench/benchmarks.hs +26/−0
- cbits/hs_clock_darwin.c +0/−29
- cbits/hs_clock_win32.c +12/−2
- clock.cabal +52/−15
- tests/test.hs +85/−35
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# 0.8.3++- Dropped support for GHC < 7.8.+- Tested with GHC 7.8 - 9.2.+- TODO: new module `System.Clock.Seconds`+- TODO: new functions+- TODO: other changes
LICENSE view
@@ -1,5 +1,4 @@-Copyright (c) 2009-2012, Cetin Sert-Copyright (c) 2010, Eugene Kirpichov+Copyright (c) 2009-2022, Clock Contributors All rights reserved.
System/Clock.hsc view
@@ -3,6 +3,7 @@ -- 1003.1-2008: <http://www.opengroup.org/onlinepubs/9699919799/>, -- <http://www.opengroup.org/onlinepubs/9699919799/functions/clock_getres.html#> +{-# LANGUAGE CApiFFI #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- To allow importing Data.Int and Data.Word indiscriminately on all platforms, -- since we can't systematically predict what typedef's expand to.@@ -17,12 +18,16 @@ , toNanoSecs , diffTimeSpec , timeSpecAsNanoSecs+ , normalize+ , s2ns ) where import Control.Applicative ((<$>), (<*>)) import Data.Int import Data.Word+import Data.Ratio import Data.Typeable (Typeable)+import Foreign.C import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc@@ -30,23 +35,26 @@ #if defined(_WIN32) # include "hs_clock_win32.c"-#elif defined(__MACH__) && defined(__APPLE__)-# include "hs_clock_darwin.c"+# define HS_CLOCK_HAVE_PROCESS_CPUTIME+# define HS_CLOCK_HAVE_THREAD_CPUTIME #else # include <time.h>--- Due to missing define in FreeBSD 9.0 and 9.1--- (http://lists.freebsd.org/pipermail/freebsd-stable/2013-September/075095.html).-# ifndef CLOCK_PROCESS_CPUTIME_ID-# define CLOCK_PROCESS_CPUTIME_ID 15+# ifdef CLOCK_PROCESS_CPUTIME_ID+# define HS_CLOCK_HAVE_PROCESS_CPUTIME # endif+# ifdef CLOCK_THREAD_CPUTIME_ID+# define HS_CLOCK_HAVE_THREAD_CPUTIME+# endif+import System.Posix.Types #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).--- All implementations shall support CLOCK_REALTIME. (The only suspend-aware--- monotonic is CLOCK_BOOTTIME on Linux.)+-- All implementations shall support 'Realtime'. data Clock -- | The identifier for the system-wide monotonic clock, which is defined as@@ -60,107 +68,135 @@ -- monotonic clock is meaningless (because its origin is arbitrary), and -- thus there is no need to set it. Furthermore, realtime applications can -- rely on the fact that the value of this clock is never set.+ -- (Identical to 'Boottime' since Linux 4.17, see https://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git/commit/?id=d6ed449afdb38f89a7b38ec50e367559e1b8f71f)+ -- @CLOCK_MONOTONIC@ (macOS - @SYSTEM_CLOCK@) = Monotonic -- | The identifier of the system-wide clock measuring real time. For this -- clock, the value returned by 'getTime' represents the amount of time (in -- seconds and nanoseconds) since the Epoch.+ -- @CLOCK_REALTIME@ (macOS - @CALENDAR_CLOCK@, Windows - @GetSystemTimeAsFileTime@) | Realtime +#ifdef HS_CLOCK_HAVE_PROCESS_CPUTIME -- | The identifier of the CPU-time clock associated with the calling -- process. For this clock, the value returned by 'getTime' represents the -- amount of execution time of the current process. | ProcessCPUTime+#endif +#ifdef HS_CLOCK_HAVE_THREAD_CPUTIME -- | The identifier of the CPU-time clock associated with the calling OS -- thread. For this clock, the value returned by 'getTime' represents the -- amount of execution time of the current OS thread. | ThreadCPUTime+#endif #if defined (CLOCK_MONOTONIC_RAW)- -- | (since Linux 2.6.28; Linux-specific)- -- Similar to CLOCK_MONOTONIC, but provides access to a+ -- | (since Linux 2.6.28, macOS 10.12)+ -- Similar to 'Monotonic', but provides access to a -- raw hardware-based time that is not subject to NTP -- adjustments or the incremental adjustments performed by -- adjtime(3).+ -- @CLOCK_MONOTONIC_RAW@ (Windows - @QueryPerformanceCounter@, @QueryPerformanceFrequency@) | MonotonicRaw #endif #if defined (CLOCK_BOOTTIME) -- | (since Linux 2.6.39; Linux-specific)- -- Identical to CLOCK_MONOTONIC, except it also includes- -- any time that the system is suspended. This allows+ -- Identical to `Monotonic`, except it also includes+ -- any time that the system is suspended. This allows -- applications to get a suspend-aware monotonic clock- -- without having to deal with the complications of- -- CLOCK_REALTIME, which may have discontinuities if the- -- time is changed using settimeofday(2).+ -- without having to deal with the complications of 'Realtime',+ -- which may have discontinuities if the time is changed+ -- using settimeofday(2).+ -- (since Linux 4.17; identical to 'Monotonic')+ -- @CLOCK_BOOTTIME@ | Boottime #endif #if defined (CLOCK_MONOTONIC_COARSE) -- | (since Linux 2.6.32; Linux-specific)- -- A faster but less precise version of CLOCK_MONOTONIC.+ -- A faster but less precise version of 'Monotonic'. -- Use when you need very fast, but not fine-grained timestamps.+ -- @CLOCK_MONOTONIC_COARSE@ | MonotonicCoarse #endif #if defined (CLOCK_REALTIME_COARSE) -- | (since Linux 2.6.32; Linux-specific)- -- A faster but less precise version of CLOCK_REALTIME.+ -- A faster but less precise version of 'Realtime'. -- Use when you need very fast, but not fine-grained timestamps.+ -- @CLOCK_REALTIME_COARSE@ | RealtimeCoarse #endif deriving (Eq, Enum, Generic, Read, Show, Typeable) #if defined(_WIN32)-foreign import ccall hs_clock_win32_gettime_monotonic :: Ptr TimeSpec -> IO ()-foreign import ccall hs_clock_win32_gettime_realtime :: Ptr TimeSpec -> IO ()-foreign import ccall hs_clock_win32_gettime_processtime :: Ptr TimeSpec -> IO ()-foreign import ccall hs_clock_win32_gettime_threadtime :: Ptr TimeSpec -> IO ()-foreign import ccall hs_clock_win32_getres_monotonic :: Ptr TimeSpec -> IO ()-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__) && 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 ()+foreign import ccall unsafe hs_clock_win32_gettime_monotonic :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe hs_clock_win32_gettime_realtime :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe hs_clock_win32_gettime_processtime :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe hs_clock_win32_gettime_threadtime :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe hs_clock_win32_getres_monotonic :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe hs_clock_win32_getres_realtime :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe hs_clock_win32_getres_processtime :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe hs_clock_win32_getres_threadtime :: 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 ()+#if MIN_VERSION_base(4,10,0)+type ClockId = CClockId+#else+type ClockId = #{type clockid_t} #endif -#if defined(_WIN32)-#elif defined(__MACH__) && defined(__APPLE__)-clockToConst :: Clock -> #{type clock_id_t}-clockToConst Monotonic = #const SYSTEM_CLOCK-clockToConst Realtime = #const CALENDAR_CLOCK-clockToConst ProcessCPUTime = #const SYSTEM_CLOCK-clockToConst ThreadCPUTime = #const SYSTEM_CLOCK-#else-clockToConst :: Clock -> #{type clockid_t}-clockToConst Monotonic = #const CLOCK_MONOTONIC-clockToConst Realtime = #const CLOCK_REALTIME-clockToConst ProcessCPUTime = #const CLOCK_PROCESS_CPUTIME_ID-clockToConst ThreadCPUTime = #const CLOCK_THREAD_CPUTIME_ID+foreign import ccall unsafe clock_gettime :: ClockId -> Ptr TimeSpec -> IO CInt+foreign import ccall unsafe clock_getres :: ClockId -> Ptr TimeSpec -> IO CInt +foreign import capi unsafe "time.h value CLOCK_MONOTONIC" clock_MONOTONIC :: ClockId+foreign import capi unsafe "time.h value CLOCK_REALTIME" clock_REALTIME :: ClockId+#if defined (CLOCK_PROCESS_CPUTIME_ID)+foreign import capi unsafe "time.h value CLOCK_PROCESS_CPUTIME_ID" clock_PROCESS_CPUTIME_ID :: ClockId+#endif+#if defined (CLOCK_THREAD_CPUTIME_ID)+foreign import capi unsafe "time.h value CLOCK_THREAD_CPUTIME_ID" clock_THREAD_CPUTIME_ID :: ClockId+#endif #if defined (CLOCK_MONOTONIC_RAW)-clockToConst MonotonicRaw = #const CLOCK_MONOTONIC_RAW+foreign import capi unsafe "time.h value CLOCK_MONOTONIC_RAW" clock_MONOTONIC_RAW :: ClockId #endif- #if defined (CLOCK_BOOTTIME)-clockToConst Boottime = #const CLOCK_BOOTTIME+foreign import capi unsafe "time.h value CLOCK_BOOTTIME" clock_BOOTTIME :: ClockId #endif- #if defined (CLOCK_MONOTONIC_COARSE)-clockToConst MonotonicCoarse = #const CLOCK_MONOTONIC_COARSE+foreign import capi unsafe "time.h value CLOCK_MONOTONIC_COARSE" clock_MONOTONIC_COARSE :: ClockId #endif- #if defined (CLOCK_REALTIME_COARSE)-clockToConst RealtimeCoarse = #const CLOCK_REALTIME_COARSE+foreign import capi unsafe "time.h value CLOCK_REALTIME_COARSE" clock_REALTIME_COARSE :: ClockId #endif+#endif +#if !defined(_WIN32)+clockToConst :: Clock -> ClockId+clockToConst Monotonic = clock_MONOTONIC+clockToConst Realtime = clock_REALTIME+#if defined (CLOCK_PROCESS_CPUTIME_ID)+clockToConst ProcessCPUTime = clock_PROCESS_CPUTIME_ID #endif+#if defined (CLOCK_THREAD_CPUTIME_ID)+clockToConst ThreadCPUTime = clock_THREAD_CPUTIME_ID+#endif+#if defined (CLOCK_MONOTONIC_RAW)+clockToConst MonotonicRaw = clock_MONOTONIC_RAW+#endif+#if defined (CLOCK_BOOTTIME)+clockToConst Boottime = clock_BOOTTIME+#endif+#if defined (CLOCK_MONOTONIC_COARSE)+clockToConst MonotonicCoarse = clock_MONOTONIC_COARSE+#endif+#if defined (CLOCK_REALTIME_COARSE)+clockToConst RealtimeCoarse = clock_REALTIME_COARSE+#endif+#endif allocaAndPeek :: Storable a => (Ptr a -> IO ()) -> IO a allocaAndPeek f = alloca $ \ptr -> f ptr >> peek ptr@@ -179,10 +215,8 @@ 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__) && defined(__APPLE__)-getTime clk = allocaAndPeek $! hs_clock_darwin_gettime $! clockToConst clk #else-getTime clk = allocaAndPeek $! clock_gettime $! clockToConst clk+getTime clk = allocaAndPeek $! throwErrnoIfMinus1_ "clock_gettime" . clock_gettime (clockToConst clk) #endif #if defined(_WIN32)@@ -190,10 +224,8 @@ 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__) && defined(__APPLE__)-getRes clk = allocaAndPeek $! hs_clock_darwin_getres $! clockToConst clk #else-getRes clk = allocaAndPeek $! clock_getres $! clockToConst clk+getRes clk = allocaAndPeek $! throwErrnoIfMinus1_ "clock_getres" . clock_getres (clockToConst clk) #endif -- | TimeSpec structure@@ -239,26 +271,34 @@ 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 (xsi_ysi) (xni_yni)- where xsi_ysi = fromInteger $! xsi*ysi - xni_yni = fromInteger $! (xni*yni + (xni*ysi + xsi*yni) * s2ns) `div` s2ns- xsi = toInteger xs- ysi = toInteger ys- xni = toInteger xn- yni = toInteger yn--- let xsi = toInteger xs -- convert to arbitraty Integer type to avoid int overflow--- xni = toInteger xn--- ysi = toInteger ys--- yni = toInteger yn -- seconds -- nanoseconds--- in normalize $! TimeSpec (fromInteger $! xsi * ysi) (fromInteger $! (xni * yni + (xni * ysi + xsi * yni) * s2ns) `div` s2ns)-+ (normalize -> TimeSpec xs xn) * (normalize -> TimeSpec ys yn) = normalize $! TimeSpec (s2ns*xs*ys+xs*yn+xn*ys) (xn*yn) negate (TimeSpec xs xn) = normalize $! TimeSpec (negate xs) (negate xn) 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+ signum (normalize -> TimeSpec xs xn) | xs == 0 = TimeSpec 0 (signum xn)+ | otherwise = TimeSpec 0 (signum xs) fromInteger x = TimeSpec (fromInteger q) (fromInteger r) where (q, r) = x `divMod` s2ns +instance Enum TimeSpec where+ succ x = x + 1+ pred x = x - 1+ toEnum x = normalize $ TimeSpec 0 (fromIntegral x)+ fromEnum = fromEnum . toInteger++instance Real TimeSpec where+ toRational x = toInteger x % 1++instance Integral TimeSpec where+ toInteger = toNanoSecs+ quot (toInteger-> t1) (toInteger-> t2) = fromInteger $! quot t1 t2+ rem (toInteger-> t1) (toInteger-> t2) = fromInteger $! rem t1 t2+ div (toInteger-> t1) (toInteger-> t2) = fromInteger $! div t1 t2+ mod (toInteger-> t1) (toInteger-> t2) = fromInteger $! mod t1 t2+ divMod (toInteger-> t1) (toInteger-> t2) =+ let (q,r)=divMod t1 t2 in (fromInteger $! q, fromInteger $! r)+ quotRem (toInteger-> t1) (toInteger-> t2) =+ let (q,r)=quotRem t1 t2 in (fromInteger $! q, fromInteger $! r)+ instance Eq TimeSpec where (normalize -> TimeSpec xs xn) == (normalize -> TimeSpec ys yn) | True == es = xn == yn | otherwise = es@@ -268,6 +308,10 @@ compare (normalize -> TimeSpec xs xn) (normalize -> TimeSpec ys yn) | EQ == os = compare xn yn | otherwise = os where os = compare xs ys++instance Bounded TimeSpec where+ minBound = TimeSpec minBound 0+ maxBound = TimeSpec maxBound (s2ns-1) -- | TimeSpec from nano seconds. fromNanoSecs :: Integer -> TimeSpec
+ System/Clock/Seconds.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module System.Clock.Seconds+ ( Clock(..)+ , Seconds(..)+ , getTime+ , getRes+ , fromNanoSecs+ , toNanoSecs+ , diffTimeSpec+ ) where++import Data.Coerce+import Data.Ratio+import Data.Typeable (Typeable)+import Foreign.Storable+import GHC.Generics (Generic)++import System.Clock(TimeSpec(..), Clock, s2ns, normalize)+import qualified System.Clock as C++newtype Seconds = Seconds { toTimeSpec :: TimeSpec }+ deriving (Generic, Read, Show, Typeable, Eq, Ord, Storable, Bounded)++instance Num Seconds where+ fromInteger n = Seconds $ TimeSpec (fromInteger n) 0+ Seconds (TimeSpec xs xn) * Seconds (TimeSpec ys yn) =+ Seconds $ normalize $! TimeSpec (xs*ys) (xs*yn+xn*ys+((xn*yn) `div` s2ns))+ (+) = coerce ((+) :: TimeSpec -> TimeSpec -> TimeSpec)+ (-) = coerce ((-) :: TimeSpec -> TimeSpec -> TimeSpec)+ negate = coerce (negate :: TimeSpec -> TimeSpec)+ abs = coerce (abs :: TimeSpec -> TimeSpec)+ signum (Seconds a) = case signum a of+ 1 -> 1+ (-1) -> (-1)+ _ -> 0++instance Enum Seconds where+ succ x = x + 1+ pred x = x - 1+ toEnum x = Seconds $ TimeSpec (fromIntegral x) 0+ fromEnum (Seconds (TimeSpec s _)) = fromEnum s++instance Real Seconds where+ toRational (Seconds x) = toInteger x % s2ns++instance Fractional Seconds where+ fromRational x = Seconds . fromInteger $ floor (x * s2ns)+ Seconds a / Seconds b = Seconds $ a * s2ns `div` b+ recip (Seconds a) = Seconds $ s2ns * s2ns `div` a++instance RealFrac Seconds where+ properFraction (Seconds (TimeSpec s ns))+ | s >= 0 = (fromIntegral s, Seconds $ TimeSpec 0 ns)+ | otherwise = (fromIntegral (s+1), Seconds $ TimeSpec (-1) ns)++-- | The 'getTime' function shall return the current value for the+-- specified clock.+getTime :: Clock -> IO Seconds+getTime = coerce C.getTime++-- | The 'getRes' function shall return the resolution of any clock.+-- Clock resolutions are implementation-defined and cannot be set+-- by a process.+getRes :: Clock -> IO Seconds+getRes = coerce C.getRes++-- | Seconds from nano seconds.+fromNanoSecs :: Integer -> Seconds+fromNanoSecs = coerce C.fromNanoSecs++-- | Seconds to nano seconds.+toNanoSecs :: Seconds -> Integer+toNanoSecs = coerce C.toNanoSecs++-- | Compute the absolute difference.+diffTimeSpec :: Seconds -> Seconds -> Seconds+diffTimeSpec = coerce C.diffTimeSpec
+ 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_darwin.c
@@ -1,29 +0,0 @@-#ifdef __MACH__-#include <time.h>-#include <mach/clock.h>-#include <mach/mach.h>--void hs_clock_darwin_gettime(clock_id_t clock, struct timespec *ts)-{- // OS X does not have clock_gettime, use clock_get_time- // see http://stackoverflow.com/questions/11680461/monotonic-clock-on-osx- clock_serv_t cclock;- mach_timespec_t mts;- host_get_clock_service(mach_host_self(), clock, &cclock);- clock_get_time(cclock, &mts);- mach_port_deallocate(mach_task_self(), cclock);- ts->tv_sec = mts.tv_sec;- ts->tv_nsec = mts.tv_nsec;-}--void hs_clock_darwin_getres(clock_id_t clock, struct timespec *ts)-{- clock_serv_t cclock;- int nsecs;- mach_msg_type_number_t count;- host_get_clock_service(mach_host_self(), clock, &cclock);- clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count);- mach_port_deallocate(mach_task_self(), cclock);-}--#endif /* __MACH__ */
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,6 @@+cabal-version: >= 1.10 name: clock-version: 0.7.2+version: 0.8.4 stability: stable synopsis: High-resolution clock functions: monotonic, realtime, cputime. description: A package for convenient access to high-resolution clock and@@ -33,26 +34,46 @@ . 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.+ .+ Refactoring for Windows, Mac implementation consistence by Alexander Vershilov on 2021-01-16.+ . [Version Scheme] Major-@/R/@-ewrite . New-@/F/@-unctionality . @/I/@-mprovementAndBugFixes . @/P/@-ackagingOnly . * @PackagingOnly@ changes are made for quality assurance reasons. -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+copyright: Copyright © Cetin Sert 2009-2023, 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, Alexander Vershilov 2021. 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@elefunc.com>, Elefunc, Inc.+maintainer: Cetin Sert <cetin@elefunc.com>, Elefunc, Inc. homepage: https://github.com/corsis/clock bug-reports: https://github.com/corsis/clock/issues category: System build-type: Simple-cabal-version: >= 1.8 +tested-with:+ GHC == 9.6.1+ GHC == 9.4.4+ GHC == 9.2.7+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2+ GHC == 7.10.3+ GHC == 7.8.4 +extra-source-files:+ CHANGELOG.md++ source-repository head type: git- location: git://github.com/corsis/clock.git+ location: https://github.com/corsis/clock.git flag llvm@@ -61,17 +82,18 @@ library- if impl (ghc < 7.6)- build-depends: base >= 4.4 && <= 5, ghc-prim- build-depends: base >= 2 && <= 5+ build-depends: base >= 4.7 && < 5+ exposed-modules: System.Clock- extensions: DeriveGeneric+ System.Clock.Seconds++ default-language: Haskell2010+ default-extensions: DeriveGeneric DeriveDataTypeable ForeignFunctionInterface ScopedTypeVariables ViewPatterns- if os(darwin)- c-sources: cbits/hs_clock_darwin.c+ GeneralizedNewtypeDeriving if os(windows) c-sources: cbits/hs_clock_win32.c include-dirs: cbits@@ -82,8 +104,10 @@ test-suite test--- default-language:--- Haskell2010+ default-language: Haskell2010+ default-extensions: ScopedTypeVariables+ GeneralizedNewtypeDeriving+ StandaloneDeriving type: exitcode-stdio-1.0 hs-source-dirs:@@ -91,7 +115,20 @@ main-is: test.hs build-depends:- base >= 4 && < 5+ base , tasty >= 0.10 , tasty-quickcheck+ , clock++benchmark benchmarks+ default-language: Haskell2010+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ bench+ main-is:+ benchmarks.hs+ build-depends:+ base+ , criterion , clock
tests/test.hs view
@@ -4,6 +4,7 @@ import Data.List -- import Test.Tasty.HUnit as HUnit import System.Clock+import System.Clock.Seconds as S instance Arbitrary TimeSpec where arbitrary = do@@ -11,49 +12,98 @@ nan <- arbitrarySizedIntegral return $ TimeSpec sec nan -main = defaultMain (adjustOption (QuickCheckTests 100000 +) $ tests)+deriving instance Arbitrary Seconds +main = defaultMain (localOption (QuickCheckTests 100000) $ tests)+ tests :: TestTree-tests = testGroup "All tests" [numInstanceTests, eqOrdInstancesTests]+tests = testGroup "All tests" [timeSpecTests, secondsTests] -numInstanceTests = testGroup "Num class tests" [- -- let's make at least 100,000 tests- qcNumInstance+timeSpecTests = testGroup "TimeSpec tests" [qcNumInstance (0 :: TimeSpec), qcRealInstance (0 :: TimeSpec), qcTimeSpec]+secondsTests = testGroup "Seconds tests" [qcNumInstance (0 :: S.Seconds), qcRealInstance (0 :: S.Seconds), qcSeconds]++qcNumInstance :: (Eq a, Num a, Arbitrary a, Show a) => a -> TestTree+qcNumInstance (s :: a) = testGroup "Num"+ [+ QuickCheck.testProperty "Associativity of (+)" $ \(x :: a) y z ->+ (x + y) + z == x + (y + z)+ , QuickCheck.testProperty "Commutativity of (+)" $ \(x :: a) y ->+ x + y == y + x+ , QuickCheck.testProperty "fromInteger 0 is the additive identity" $ \(x :: a) ->+ x + fromInteger 0 == x+ , QuickCheck.testProperty "negate gives the additive inverse" $ \(x :: a) ->+ x + negate x == fromInteger 0+ , QuickCheck.testProperty "fromInteger 1 is the multiplicative identity" $ \(x :: a) ->+ x * fromInteger 1 == x && fromInteger 1 * x == x+ , QuickCheck.testProperty "neg(neg(x)) = x" $ \(x :: a) ->+ negate (negate x) == x+ , QuickCheck.testProperty "x = abs(x) * signum(x)" $ \(x :: a) ->+ x == (abs x) * (signum x) ] -eqOrdInstancesTests = testGroup "Eq and Ord instance tests" [- -- let's make at least 100,000 tests- qcEqOrdInstance+qcRealInstance :: (Real a, Arbitrary a, Show a) => a -> TestTree+qcRealInstance (s :: a) = testGroup "Real"+ [+ QuickCheck.testProperty "integer addition is correct" $ \ x y ->+ toRational (x + y) == toRational (fromInteger x + fromInteger y :: a)+ , QuickCheck.testProperty "integer subtraction is correct" $ \ x y ->+ toRational (x - y) == toRational (fromInteger x - fromInteger y :: a)+ , QuickCheck.testProperty "integer multiplication is correct" $ \ x y ->+ toRational (x * y) == toRational (fromInteger x * fromInteger y :: a)+ , QuickCheck.testProperty "random list of TimeSpecs is sorted like equivalent list of rationals" $ \(x :: [a]) ->+ map toRational (sort x) == sort (map toRational x) ] -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+qcTimeSpec :: TestTree+qcTimeSpec = testGroup "TimeSpec-specific"+ [+ -- fails with Seconds on 0.000000001 * -1.000000002 * -2.000000001+ QuickCheck.testProperty "Associativity of (*)" $ \(x :: TimeSpec) y z ->+ (x * y) * z == x * (y * z)+ -- fails with Seconds on [-0.999999999,0.000000001,-1.000000001]+ , QuickCheck.testProperty "Distributivity of (*) with respect to (+)" $ \(a :: TimeSpec) b c ->+ a * (b + c) == (a * b) + (a * c) && (b + c) * a == (b * a) + (c * a)+ , QuickCheck.testProperty "TimeSpec Quot-rem division equality" $ \(x :: TimeSpec) y ->+ y == 0 || x == y * quot x y + rem x y+ , QuickCheck.testProperty "TimeSpec Rem is within bounds" $ \(x :: TimeSpec) y ->+ let r = rem x y in y == 0 || r == fromInteger 0 || abs r < abs y+ , QuickCheck.testProperty "TimeSpec quotRem agrees with quot and rem" $ \(x :: TimeSpec) y ->+ let (q,r) = quotRem x y in+ y == 0 || (q == quot x y && r == rem x y)+ , QuickCheck.testProperty "TimeSpec Div-mod division equality" $ \(x :: TimeSpec) y ->+ y == 0 || x == y * div x y + mod x y+ , QuickCheck.testProperty "TimeSpec Mod is within bounds" $ \(x :: TimeSpec) y ->+ let r = mod x y in y == 0 || (r == fromInteger 0 || abs r < abs y)+ , QuickCheck.testProperty "TimeSpec divMod agrees with div and mod" $ \(x :: TimeSpec) y ->+ let (q,r) = divMod x y in+ y == 0 || (q == div x y && r == mod x y)+ , QuickCheck.testProperty "TimeSpec toInteger . fromInteger is the identity" $ \x ->+ x == toInteger (fromInteger x :: TimeSpec)+ , QuickCheck.testProperty "TimeSpec fromInteger . toInteger is the identity" $ \(x :: TimeSpec) ->+ x == fromInteger (toInteger x)+ , QuickCheck.testProperty "TimeSpec division agrees with Integer" $ \(x :: TimeSpec) y ->+ y == 0 || toInteger (x `div` y) == toInteger x `div` toInteger y+ , QuickCheck.testProperty "TimeSpec quot agrees with Integer" $ \(x :: TimeSpec) y ->+ y == 0 || toInteger (x `quot` y) == toInteger x `quot` toInteger y ] -qcEqOrdInstance = testGroup "QuickCheck"+qcSeconds :: TestTree+qcSeconds = testGroup "Seconds-specific" [- 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 "Seconds multiplication is Nano multiplication" $ \x y ->+ let nano = toRational $ (x :: Nano) * (y :: Nano)+ seconds = toRational $ (realToFrac x) * (realToFrac y :: Seconds)+ in nano == seconds+ , QuickCheck.testProperty "Seconds truncate is Nano truncate" $ \(x :: Nano) ->+ let nano = truncate x :: Integer+ seconds = truncate (realToFrac x :: Seconds)+ in nano == seconds+ , QuickCheck.testProperty "Seconds / is Nano /" $ \(x :: Nano) (y :: Nano) ->+ let nano = toRational $ x / y+ seconds = toRational (realToFrac x / realToFrac y :: Seconds)+ in y == 0 || nano == seconds+ , QuickCheck.testProperty "Seconds recip is Nano recip" $ \(x :: Nano) ->+ let nano = toRational $ recip x+ seconds = toRational (recip $ realToFrac x :: Seconds)+ in x == 0 || nano == seconds ]