X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FTime.hsc;h=a2c6b5b2494740591f40facf2ca16c79508cd304;hb=74bc2d04fdbae494bcf4839c4ec5e6ec1d0bf600;hp=d884e879ec62f3ddd67a1e81ccdcb0facca519e7;hpb=099287255140d04e46d3403e3528d7a050dc0121;p=haskell-directory.git

diff --git a/System/Time.hsc b/System/Time.hsc
index d884e87..a2c6b5b 100644
--- 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__
@@ -353,14 +353,14 @@ gmtoff x    = (#peek struct tm,tm_gmtoff) x
 
 #else /* ! HAVE_TM_ZONE */
 # if HAVE_TZNAME || defined(_WIN32)
-#  if cygwin32_TARGET_OS
+#  if cygwin32_HOST_OS
 #   define tzname _tzname
 #  endif
-#  ifndef mingw32_TARGET_OS
-foreign import ccall unsafe "time.h &tzname" tzname :: Ptr (Ptr CChar)
+#  ifndef mingw32_HOST_OS
+foreign import ccall unsafe "time.h &tzname" tzname :: Ptr CString
 #  else
 foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong
-foreign import ccall unsafe "__hscore_tzname"   tzname :: Ptr (Ptr CChar)
+foreign import ccall unsafe "__hscore_tzname"   tzname :: Ptr CString
 #  endif
 zone x = do 
   dst <- (#peek struct tm,tm_isdst) x
@@ -381,7 +381,7 @@ gmtoff x = do
   return (-fromIntegral (realToInteger tz))
 # else /* ! HAVE_DECL_ALTZONE */
 
-#if !defined(mingw32_TARGET_OS)
+#if !defined(mingw32_HOST_OS)
 foreign import ccall "time.h &timezone" timezone :: Ptr CLong
 #endif
 
@@ -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,20 @@ 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 = ()
+type CTimeZone = ()
 foreign import ccall unsafe "time.h gettimeofday"
-    gettimeofday :: Ptr CTimeVal -> Ptr () -> IO CInt
-#endif
-
-#if HAVE_FTIME
+    gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt
+#elif HAVE_FTIME
 type CTimeB = ()
-#ifndef mingw32_TARGET_OS
+#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__ */