[commit: packages/time] format-widths, improve-leapseconds, master, posix-perf, tasty, wip/travis: Fixed loss of accuracy in timeOfDayToDayFraction. (2677235)

git at git.haskell.org git at git.haskell.org
Mon Feb 20 21:14:17 UTC 2017


Repository : ssh://git@git.haskell.org/time

On branches: format-widths,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/2677235d39a575502782af06898f3b80ee8a460c

>---------------------------------------------------------------

commit 2677235d39a575502782af06898f3b80ee8a460c
Author: Bjorn Buckwalter <bjorn at buckwalter.se>
Date:   Mon Jun 21 01:04:47 2010 -0700

    Fixed loss of accuracy in timeOfDayToDayFraction.
    
    Ignore-this: 4ba8be01f14c2838bede8c16866ad134
    
    darcs-hash:20100621080447-6cbaf-00ccf839cf4be9821b7c2456a4d96e29ec5753ea


>---------------------------------------------------------------

2677235d39a575502782af06898f3b80ee8a460c
 Data/Time/LocalTime/TimeOfDay.hs |  2 +-
 test/TestTime.hs                 | 10 ++++++++++
 test/TestTime.ref                |  5 +++++
 3 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/Data/Time/LocalTime/TimeOfDay.hs b/Data/Time/LocalTime/TimeOfDay.hs
index e7618e4..37b2079 100644
--- a/Data/Time/LocalTime/TimeOfDay.hs
+++ b/Data/Time/LocalTime/TimeOfDay.hs
@@ -93,4 +93,4 @@ dayFractionToTimeOfDay df = timeToTimeOfDay (realToFrac (df * 86400))
 
 -- | Get the fraction of a day since midnight given a TimeOfDay.
 timeOfDayToDayFraction :: TimeOfDay -> Rational
-timeOfDayToDayFraction tod = realToFrac (timeOfDayToTime tod / posixDayLength)
+timeOfDayToDayFraction tod = realToFrac (timeOfDayToTime tod) / realToFrac posixDayLength
diff --git a/test/TestTime.hs b/test/TestTime.hs
index 159d001..5fb35c2 100644
--- a/test/TestTime.hs
+++ b/test/TestTime.hs
@@ -80,8 +80,18 @@ testUT1 = do
 	putStrLn (show (ut1ToLocalTime poslong (ModJulianDate 51604.0)))
 	putStrLn (show (ut1ToLocalTime poslong (ModJulianDate 51604.5)))
 
+testTimeOfDayToDayFraction :: IO ()
+testTimeOfDayToDayFraction = do
+	putStrLn ""
+	let f = dayFractionToTimeOfDay . timeOfDayToDayFraction
+	putStrLn (show (f (TimeOfDay 12 34 56.789)))
+	putStrLn (show (f (TimeOfDay 12 34 56.789123)))
+	putStrLn (show (f (TimeOfDay 12 34 56.789123456)))
+	putStrLn (show (f (TimeOfDay 12 34 56.789123456789)))
+
 main :: IO ()
 main = do
 	testCal
 	testUTC
 	testUT1
+	testTimeOfDayToDayFraction
diff --git a/test/TestTime.ref b/test/TestTime.ref
index 00cb151..9f8dd39 100644
--- a/test/TestTime.ref
+++ b/test/TestTime.ref
@@ -867,3 +867,8 @@
 2000-03-01 04:00:00
 2000-03-01 08:00:00
 2000-03-01 20:00:00
+
+12:34:56.789
+12:34:56.789123
+12:34:56.789123456
+12:34:56.789123456789



More information about the ghc-commits mailing list