add withFile and withBinaryFile (#966)

[haskell-directory.git] / System / Time.hsc

diff --git a/System/Time.hsc b/System/Time.hsc
index b4a623e..f230e97 100644 (file)
--- a/System/Time.hsc
+++ b/System/Time.hsc
@@ -104,7 +104,7 @@ module System.Time
 
 #ifdef __NHC__
 #include <time.h>
-#  ifdef __sun
+#  if defined(__sun) || defined(__CYGWIN32__)
 #    define HAVE_TZNAME 1
 #  else
 #    define HAVE_TM_ZONE 1
@@ -270,8 +270,8 @@ addToClockTime (TimeDiff year mon day hour min sec psec)
                      60 * toInteger min +
                      3600 * toInteger hour +
                      24 * 3600 * toInteger day
-         cal      = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec))
-                                                       -- FIXME! ^^^^
+          (d_sec, d_psec) = (c_psec + psec) `quotRem` 1000000000000
+          cal      = toUTCTime (TOD (c_sec + sec_diff + d_sec) d_psec)
           new_mon  = fromEnum (ctMonth cal) + r_mon 
          month' = fst tmp
          yr_diff = snd tmp
@@ -316,12 +316,12 @@ normalizeTimeDiff :: TimeDiff -> TimeDiff
 -- errors
 normalizeTimeDiff td =
   let
-      rest0 = tdSec td 
-               + 60 * (tdMin td 
-                    + 60 * (tdHour td 
-                         + 24 * (tdDay td 
-                              + 30 * (tdMonth td 
-                                   + 365 * tdYear td))))
+      rest0 = toInteger (tdSec td)
+               + 60 * (toInteger (tdMin td)
+                    + 60 * (toInteger (tdHour td)
+                         + 24 * (toInteger (tdDay td)
+                              + 30 * toInteger (tdMonth td)
+                              + 365 * toInteger (tdYear td))))
 
       (diffYears,  rest1)    = rest0 `quotRem` (365 * 24 * 3600)
       (diffMonths, rest2)    = rest1 `quotRem` (30 * 24 * 3600)
@@ -329,12 +329,12 @@ normalizeTimeDiff td =
       (diffHours,  rest4)    = rest3 `quotRem` 3600
       (diffMins,   diffSecs) = rest4 `quotRem` 60
   in
-      td{ tdYear = diffYears
-        , tdMonth = diffMonths
-        , tdDay   = diffDays
-        , tdHour  = diffHours
-        , tdMin   = diffMins
-        , tdSec   = diffSecs
+      td{ tdYear  = fromInteger diffYears
+        , tdMonth = fromInteger diffMonths
+        , tdDay   = fromInteger diffDays
+        , tdHour  = fromInteger diffHours
+        , tdMin   = fromInteger diffMins
+        , tdSec   = fromInteger diffSecs
         }
 
 #ifndef __HUGS__
@@ -455,13 +455,16 @@ throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm))
                        -> (Ptr CTime -> Ptr CTm -> IO (       ))
 throwAwayReturnPointer fun x y = fun x y >> return ()
 
+#if !HAVE_LOCALTIME_R || !HAVE_GMTIME_R
 clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime
         -> IO CalendarTime
 clockToCalendarTime_static fun is_utc (TOD secs psec) = do
   with (fromIntegral secs :: CTime)  $ \ p_timer -> do
     p_tm <- fun p_timer        -- can't fail, according to POSIX
     clockToCalendarTime_aux is_utc p_tm psec
+#endif
 
+#if HAVE_LOCALTIME_R || HAVE_GMTIME_R
 clockToCalendarTime_reentrant :: (Ptr CTime -> Ptr CTm -> IO ()) -> Bool -> ClockTime
         -> IO CalendarTime
 clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = do
@@ -469,6 +472,7 @@ clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = do
     allocaBytes (#const sizeof(struct tm)) $ \ p_tm -> do
       fun p_timer p_tm
       clockToCalendarTime_aux is_utc p_tm psec
+#endif
 
 clockToCalendarTime_aux :: Bool -> Ptr CTm -> Integer -> IO CalendarTime
 clockToCalendarTime_aux is_utc p_tm psec = do
@@ -733,21 +737,19 @@ foreign import ccall unsafe "time.h gmtime"
 #endif
 foreign import ccall unsafe "time.h mktime"
     mktime      :: Ptr CTm   -> IO CTime
-foreign import ccall unsafe "time.h time"
-    time        :: Ptr CTime -> IO CTime
 
 #if HAVE_GETTIMEOFDAY
 type CTimeVal = ()
 foreign import ccall unsafe "time.h gettimeofday"
     gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt
-#endif
-
-#if HAVE_FTIME
+#elif HAVE_FTIME
 type CTimeB = ()
 #ifndef mingw32_HOST_OS
 foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO CInt
 #else
 foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO ()
 #endif
+#else
+foreign import ccall unsafe "time.h time" time :: Ptr CTime -> IO CTime
 #endif
 #endif /* ! __HUGS__ */