[commit: base] master: Use CSUSeconds in getCPUTime and getCurrentTime. Fixes #4247. (f609bd5)

[Ian Lynagh]

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 <william.knop.nospam at gmail.com>
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)