Hi all! I took a look (or maybe some more) at the well-known, totally buggy Time module... I think, I sorted out the main problems and fixed them: * toClockTime couldn't deal properly with anything but local TZ-encoded CalendarTime's (i.e. not with UTC-encoded CT's for example) * as a result, addToClockTime did weird things * diffClockTimes, in some situations, gave strange results, i.e. "1 day, -22 hours" instead of "2 hours" * timeDiffToString always returned "c", regardless of its parameters [this one was really hard to find ;-)] For the tedious details, refer to the comments in the patch for [Time.lhs,Locale.lhs,toClockSec.c]. There's also a BUGS/TODO list with some open issues... comments welcome! I tested on Linux, so if someone could try the patch on a Solaris version of GHC, it would be of greater help. Besides normal testing and debugging, I recompiled the time001 test and it still produced the same output, which made me wonder. So I recompiled it with the old (broken) version of Time and tested again. Result: running the old time001 like (Bashism ahead) $ env TZ=<foo> ./time001 and <foo> `elem` [CET,EST,PST8,PST8PDT,...] yields different results, which is clearly wrong, since we're using UTC encoding. Did somebody ever try to run time001 with a TZ /= UTC or friends? :-) Anyway, the modified version always yields the same result, regardless of the TZ setting, which is IMHO The Right Behaviour(tm)... Oh, BTW: 2 remarks 1) *ahem* Hereby I state, that I really doubt, that anyone has been using the Time-module for longer than a couple of compilation runs, ever... ;-) 2) Does anybody know a mail address of the inventor(s) of the Unix Time Handling Functions (K&R, maybe?)? I'd like to "thank" them for this great stuff... I thought about a source+binary release of ghc-4.07, tar'ed, uuencoded and piped through hexdump, and of course, split into 1k-pieces, just to be sure, it gets through... >:-) Cheers, Michael -- () ASCII ribbon campaign | Chair for Computer Science II | GPG: F65C68CD /\ against HTML mail | RWTH Aachen, Germany | PGP: 1D0DD0B9 Ninety percent of the time things will turn out worse than you expect. The other 10 percent of the time you had no right to expect so much.
diff -bur ghc4-4.07.20000615.orig/ghc/lib/std/Locale.lhs ghc4-4.07.20000615/ghc/lib/std/Locale.lhs --- ghc4-4.07.20000615.orig/ghc/lib/std/Locale.lhs Thu Jan 14 19:12:51 1999 +++ ghc4-4.07.20000615/ghc/lib/std/Locale.lhs Sat Jun 17 13:49:35 2000 @@ -5,13 +5,21 @@ \begin{code} -module Locale(TimeLocale(..), defaultTimeLocale) where +module Locale + ( TimeLocale(..) + , defaultTimeLocale + + , iso8601DateFormat + , rfc822DateFormat + ) +where import Prelude -- so as to force recompilations when reqd. data TimeLocale = TimeLocale { wDays :: [(String, String)], -- full and abbreviated week days months :: [(String, String)], -- full and abbreviated months + intervals :: [(String, String)], amPm :: (String, String), -- AM/PM symbols dateTimeFmt, dateFmt, -- formatting strings timeFmt, time12Fmt :: String @@ -31,6 +39,15 @@ ("September", "Sep"), ("October", "Oct"), ("November", "Nov"), ("December", "Dec")], + intervals = [ ("year","years") + , ("month", "months") + , ("day","days") + , ("hour","hours") + , ("min","mins") + , ("sec","secs") + , ("usec","usecs") + ], + amPm = ("AM", "PM"), dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y", dateFmt = "%m/%d/%y", @@ -38,4 +55,14 @@ time12Fmt = "%I:%M:%S %p" } + +iso8601DateFormat :: Maybe String -> String +iso8601DateFormat timeFmt = + "%Y-%m-%d" ++ case timeFmt of + Nothing -> "" -- normally, ISO-8601 just defines YYYY-MM-DD + Just fmt -> ' ' : fmt -- but we can add a time spec + + +rfc822DateFormat :: String +rfc822DateFormat = "%a, %_d %b %Y %H:%M:%S %Z" \end{code} diff -bur ghc4-4.07.20000615.orig/ghc/lib/std/Time.lhs ghc4-4.07.20000615/ghc/lib/std/Time.lhs --- ghc4-4.07.20000615.orig/ghc/lib/std/Time.lhs Thu May 4 19:03:16 2000 +++ ghc4-4.07.20000615/ghc/lib/std/Time.lhs Sat Jun 17 16:23:19 2000 @@ -8,6 +8,109 @@ "time.h", adapted to the Haskell environment), It follows RFC 1129 in its use of Coordinated Universal Time (UTC). +CHANGES: +2000/06/17 <[EMAIL PROTECTED]>: + * `toClockTime' previously didn't honor the `tz' field of a + `CalendarTime', which led to time warping when applying + + => (toUTCTime (toClockTime ... (toUTCTime (toClockTime someTime) ... ))) + + continuously. + + Now it accepts at least <local>- and UTC-encoded `CalendarTime's + (TODO: test, whether all timezones work) and converts them + correctly to <secs from epoch>-format (which is always UTC, as one + might have guessed). + + * `addToClockTime' now works. + + Previously, `tz' seconds were added(!) when used like: + + => addToClockTime noTimeDiff someTime + + which is clearly wrong. + Now, the following (hopefully) always holds + + => someTime == (addToClockTime noTimeDiff someTime) + + * `diffClockTimes' works correctly, and is the dual to + `addToClockTime', i.e. + + => diff == ((addToClockTime diff someTime) `diffClockTimes` someTime) + + should now hold for all diff, someTime + + Previously, it reports ugly diffs at {min,hour,day,...}-breaks, + for example: + + => "2000/06/18 01:00 UTC" + `diffClockTimes` "2000/06/17 23:00 UTC" == 1 day, -22 hours + + whereas now it emits "7200 secs". This number can be converted + with `normalizeTimeDiff' to "2 hours". + + * added `normalizeTimeDiff', which calculates year, month, days, + etc. out of an unnormalized `TimeDiff' (generated by + `diffClockTimes', for example) + + * `formatTimeDiff': added the missing "%c" case. The + format is proprietary, though... Is there a nicer one? + + +RESTRICTIONS: + * min./max. time diff currently is restricted to + [minBound::Int, maxBound::Int] + + * surely other restrictions wrt. min/max bounds + + +NOTES: + * printing times + + `showTime' (used in `instance Show ClockTime') always prints time + converted to the local timezone (even if it is taken from + `(toClockTime . toUTCTime)'), whereas `calendarTimeToString' + honors the tzone & tz fields and prints UTC or whatever timezone + is stored inside CalendarTime. + + Maybe `showTime' should be changed to use UTC, since it would + better correspond to the actual representation of `ClockTime' + (can be done by replacing localtime(3) by gmtime(3)). + + +BUGS: + * obvious bugs now should be fixed, but there are surely more (and + less obvious one's) lurking around :-} + + * gettimeofday(2) returns secs and _microsecs_, not pico-secs! + this should be changed accordingly (also means updating the H98 + report) + + * add proper handling of microsecs, currently, they're mostly + ignored + + * `formatFOO' case of `%s' is currently broken... + + +TODO: + * check for unusual date cases, like 1970/1/1 00:00h, and conversions + between different timezone's etc. + + * check, what needs to be in the IO monad, the current situation + seems to be a bit inconsistent to me + + * sync #ifdef'ed __HUGS__ parts with current changes (only few) + + * check whether `isDst = -1' works as expected on other arch's + (Solaris anyone?) + + * add functions to parse strings to `CalendarTime' (some day...) + + * implement padding capabilities ("%_", "%-") in `formatFOO' + + * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO' + + \begin{code} {-# OPTIONS -#include "cbits/timezone.h" -#include "cbits/stgio.h" #-} module Time @@ -23,6 +126,7 @@ , diffClockTimes , addToClockTime + , normalizeTimeDiff -- non-standard , timeDiffToString -- non-standard , formatTimeDiff -- non-standard @@ -255,7 +359,7 @@ let sec_diff = fromInt sec + 60 * fromInt min + 3600 * fromInt hour + 24 * 3600 * fromInt day cal = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec)) - + -- FIXME! ^^^^ new_mon = fromEnum (ctMonth cal) + r_mon (month', yr_diff) | new_mon < 0 = (toEnum (12 + new_mon), (-1)) @@ -269,18 +373,51 @@ toClockTime cal{ctMonth=month', ctYear=year'} diffClockTimes :: ClockTime -> ClockTime -> TimeDiff -diffClockTimes tod_a tod_b = +-- diffClockTimes is meant to be the dual to `addToClockTime'. +-- If you want to have the TimeDiff properly splitted, use +-- `normalizeTimeDiff' on this function's result +-- +-- CAVEAT: see comment of normalizeTimeDiff +diffClockTimes (TOD sa pa) (TOD sb pb) = + noTimeDiff{ tdSec = fromIntegral (sa - sb) + -- FIXME: can handle just 68 years... + , tdPicosec = pa - pb + } + + +normalizeTimeDiff :: TimeDiff -> TimeDiff +-- FIXME: handle psecs properly +-- FIXME: ?should be called by formatTimeDiff automagically? +-- +-- when applied to something coming out of `diffClockTimes', you loose +-- the duality to `addToClockTime', since a year does not always have +-- 365 days, etc. +-- +-- apply this function as late as possible to prevent those "rounding" +-- errors +normalizeTimeDiff td = let - CalendarTime year_a mon_a day_a hour_a min_a sec_a psec_a _ _ _ _ _ = toUTCTime tod_a - CalendarTime year_b mon_b day_b hour_b min_b sec_b psec_b _ _ _ _ _ = toUTCTime tod_b + rest0 = tdSec td + + 60 * (tdMin td + + 60 * (tdHour td + + 24 * (tdDay td + + 30 * (tdMonth td + + 365 * tdYear td)))) + + (diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600) + (diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600) + (diffDays, rest3) = rest2 `quotRem` (24 * 3600) + (diffHours, rest4) = rest3 `quotRem` 3600 + (diffMins, diffSecs) = rest4 `quotRem` 60 in - TimeDiff (year_a - year_b) - (fromEnum mon_a - fromEnum mon_b) - (day_a - day_b) - (hour_a - hour_b) - (min_a - min_b) - (sec_a - sec_b) - (psec_a - psec_b) + td{ tdYear = diffYears + , tdMonth = diffMonths + , tdDay = diffDays + , tdHour = diffHours + , tdMin = diffMins + , tdSec = diffSecs + } + \end{code} @toCalendarTime@ {\em t} converts {\em t} to a local time, modified by @@ -354,6 +491,7 @@ ) where isDst = if isdst then (1::Int) else 0 + #else toCalendarTime :: ClockTime -> IO CalendarTime toCalendarTime (TOD (S# i) psec) @@ -421,7 +559,7 @@ else unsafePerformIO ( do res <- malloc1 - rc <- toClockSec year (fromEnum mon) mday hour min sec isDst res + rc <- toClockSec year (fromEnum mon) mday hour min sec tz isDst res if rc /= 0 then do i <- cvtUnsigned res @@ -429,7 +567,12 @@ else error "Time.toClockTime: can't perform conversion" ) where - isDst = if isdst then (1::Int) else 0 + -- `isDst' causes the date to be wrong by one hour... + -- FIXME: check, whether this works on other arch's than Linux, too... + -- + -- so we set it to (-1) (means `unknown') and let `mktime' determine + -- the real value... + isDst = -1 -- if isdst then (1::Int) else 0 #endif @@ -468,7 +611,9 @@ formatCalendarTime l fmt (CalendarTime year mon day hour min sec _ wday yday tzname _ _) = doFmt fmt - where doFmt ('%':c:cs) = decode c ++ doFmt cs + where doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented + doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented + doFmt ('%':c:cs) = decode c ++ doFmt cs doFmt (c:cs) = c : doFmt cs doFmt "" = "" @@ -539,10 +684,12 @@ timeDiffToString = formatTimeDiff defaultTimeLocale "%c" formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String -formatTimeDiff l fmt (TimeDiff year month day hour min sec _) +formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _) = doFmt fmt where doFmt "" = "" + doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented + doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented doFmt ('%':c:cs) = decode c ++ doFmt cs doFmt (c:cs) = c : doFmt cs @@ -551,6 +698,7 @@ 'B' -> fst (months l !! fromEnum month) 'b' -> snd (months l !! fromEnum month) 'h' -> snd (months l !! fromEnum month) + 'c' -> defaultTimeDiffFmt td 'C' -> show2 (year `quot` 100) 'D' -> doFmt "%m/%d/%y" 'd' -> show2 day @@ -576,6 +724,17 @@ '%' -> "%" c -> [c] + defaultTimeDiffFmt (TimeDiff year month day hour min sec _) = + foldr (\ (v,s) rest -> + (if v /= 0 + then show v ++ ' ':(addS v s) + ++ if null rest then "" else ", " + else "") ++ rest + ) + "" + (zip [year, month, day, hour, min, sec] (intervals l)) + + addS v s = if abs v == 1 then fst s else snd s \end{code} \begin{code} @@ -619,7 +778,7 @@ foreign import "libHS_cbits" "toClockSec" unsafe toClockSec :: Int -> Int -> Int -> Int -> Int - -> Int -> Int -> MBytes -> IO Int + -> Int -> Int -> Int -> MBytes -> IO Int foreign import "libHS_cbits" "getClockTime" unsafe primGetClockTime :: MutableByteArray RealWorld Int diff -bur ghc4-4.07.20000615.orig/ghc/lib/std/cbits/stgio.h ghc4-4.07.20000615/ghc/lib/std/cbits/stgio.h --- ghc4-4.07.20000615.orig/ghc/lib/std/cbits/stgio.h Thu Jun 15 20:54:27 2000 +++ ghc4-4.07.20000615/ghc/lib/std/cbits/stgio.h Sat Jun 17 01:49:54 2000 @@ -224,7 +224,7 @@ StgInt prim_toUTCTime ( StgInt64,StgByteArray ); /* toClockSec.c */ -StgInt toClockSec (StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgByteArray); +StgInt toClockSec (StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, StgInt, +StgByteArray); /* writeError.c */ StgAddr addrOf_ErrorHdrHook(void); diff -bur ghc4-4.07.20000615.orig/ghc/lib/std/cbits/toClockSec.c ghc4-4.07.20000615/ghc/lib/std/cbits/toClockSec.c --- ghc4-4.07.20000615.orig/ghc/lib/std/cbits/toClockSec.c Mon Dec 6 22:34:02 1999 +++ ghc4-4.07.20000615/ghc/lib/std/cbits/toClockSec.c Sat Jun 17 13:09:36 2000 @@ -11,7 +11,7 @@ #include "timezone.h" StgInt -toClockSec(I_ year, I_ mon, I_ mday, I_ hour, I_ min, I_ sec, I_ isdst, StgByteArray res) +toClockSec(I_ year, I_ mon, I_ mday, I_ hour, I_ min, I_ sec, I_ tz, I_ isdst, +StgByteArray res) { struct tm tm; time_t t; @@ -33,7 +33,18 @@ #endif if (t == (time_t) -1) return 0; - - *(time_t *)res = t; + /* + * mktime expects its argument to be in the local timezone, but + * toUTCTime makes UTC-encoded CalendarTime's ... + * + * Since there is no any_tz_struct_tm-to-time_t conversion + * function, we have to fake one... :-) If not in all, it works in + * most cases (before, it was the other way round...) + * + * Luckily, mktime tells us, what it *thinks* the timezone is, so, + * to compensate, we add the timezone difference to mktime's + * result. + */ + *(time_t *)res = t + tz - GMTOFF(&tm); return 1; }