Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f609bd59e86db07089c01a28205ea2f0d31cf317 >--------------------------------------------------------------- commit f609bd59e86db07089c01a28205ea2f0d31cf317 Author: William Knop <[email protected]> Date: Mon Apr 4 21:01:39 2011 -0400 Use CSUSeconds in getCPUTime and getCurrentTime. Fixes #4247. The tv_usec field of struct timeval was incorrectly used as C type time_t; the actual C type is suseconds_t. On OS X, time_t is longer than suseconds_t, which caused garbage bits to be copied as reported in trace #4247 and #4970. This is patch 3 of 4 to fix those tickets. >--------------------------------------------------------------- GHC/Event/Clock.hsc | 8 ++++---- System/CPUTime.hsc | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/GHC/Event/Clock.hsc b/GHC/Event/Clock.hsc index 98758a3..998794b 100644 --- a/GHC/Event/Clock.hsc +++ b/GHC/Event/Clock.hsc @@ -6,7 +6,7 @@ module GHC.Event.Clock (getCurrentTime) where import Foreign (Ptr, Storable(..), nullPtr, with) import Foreign.C.Error (throwErrnoIfMinus1_) -import Foreign.C.Types (CInt, CLong) +import Foreign.C.Types (CInt, CLong, CTime, CSUSeconds) import GHC.Base import GHC.Err import GHC.Num @@ -20,15 +20,15 @@ getCurrentTime = do tv <- with (CTimeval 0 0) $ \tvptr -> do throwErrnoIfMinus1_ "gettimeofday" (gettimeofday tvptr nullPtr) peek tvptr - let !t = fromIntegral (sec tv) + fromIntegral (usec tv) / 1000000.0 + let !t = realToFrac (sec tv) + realToFrac (usec tv) / 1000000.0 return t ------------------------------------------------------------------------ -- FFI binding data CTimeval = CTimeval - { sec :: {-# UNPACK #-} !CLong - , usec :: {-# UNPACK #-} !CLong + { sec :: {-# UNPACK #-} !CTime + , usec :: {-# UNPACK #-} !CSUSeconds } instance Storable CTimeval where diff --git a/System/CPUTime.hsc b/System/CPUTime.hsc index a25c750..90ff1e9 100644 --- a/System/CPUTime.hsc +++ b/System/CPUTime.hsc @@ -101,9 +101,9 @@ getCPUTime = do let ru_utime = (#ptr struct rusage, ru_utime) p_rusage let ru_stime = (#ptr struct rusage, ru_stime) p_rusage u_sec <- (#peek struct timeval,tv_sec) ru_utime :: IO CTime - u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CTime + u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CSUSeconds s_sec <- (#peek struct timeval,tv_sec) ru_stime :: IO CTime - s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CTime + s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CSUSeconds return ((realToInteger u_sec * 1000000 + realToInteger u_usec + realToInteger s_sec * 1000000 + realToInteger s_usec) * 1000000) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
