[commit: packages/time] ghc,master: Fix tests on 32 bit (d03429e)

git at git.haskell.org git at git.haskell.org
Fri Apr 21 16:57:49 UTC 2017


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

On branches: ghc,master
Link       : http://git.haskell.org/packages/time.git/commitdiff/d03429e1913b6babd3b59d0bfdd7d3904b1b6f0b

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

commit d03429e1913b6babd3b59d0bfdd7d3904b1b6f0b
Author: Ashley Yakeley <ashley at localhost.localdomain>
Date:   Sat Mar 11 12:45:30 2017 -0800

    Fix tests on 32 bit


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

d03429e1913b6babd3b59d0bfdd7d3904b1b6f0b
 Checklist                       |  1 -
 test/unix/Test/Format/Format.hs | 16 +++++++++++-----
 2 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/Checklist b/Checklist
index 9f3d6a1..8fef7e8 100644
--- a/Checklist
+++ b/Checklist
@@ -49,7 +49,6 @@ Before release:
 
     git pull
     stack build --pedantic --test --haddock && echo OK
-        (ignore errors)
 
 11. Build and test on Windows
 
diff --git a/test/unix/Test/Format/Format.hs b/test/unix/Test/Format/Format.hs
index 49ea218..fa7d5b8 100644
--- a/test/unix/Test/Format/Format.hs
+++ b/test/unix/Test/Format/Format.hs
@@ -12,6 +12,7 @@ import Test.QuickCheck hiding (Result)
 import Test.QuickCheck.Property
 import Test.Tasty
 import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
 import Test.TestUtil
 import System.IO.Unsafe
 
@@ -67,6 +68,13 @@ instance Arbitrary TimeOfDay where
         s <- choose (0,59.999999999999) -- don't allow leap-seconds
         return $ TimeOfDay h m s
 
+-- | The size of 'CTime' is platform-dependent.
+secondsFitInCTime :: Integer -> Bool
+secondsFitInCTime sec = let
+    CTime ct = fromInteger sec
+    sec' = toInteger ct
+    in sec == sec'
+
 instance Arbitrary UTCTime where
     arbitrary = do
         day <- choose (-25000,75000)
@@ -76,9 +84,7 @@ instance Arbitrary UTCTime where
             localT = LocalTime (ModifiedJulianDay day) time
             utcT = localTimeToUTC utc localT
             secondsInteger = floor (utcTimeToPOSIXSeconds utcT)
-            CTime secondsCTime = fromInteger secondsInteger
-            secondsInteger' = toInteger secondsCTime
-        if secondsInteger == secondsInteger'
+        if secondsFitInCTime (secondsInteger + 2*86400) && secondsFitInCTime (secondsInteger - 2*86400) -- two days slop each way
           then return utcT
           else arbitrary
 
@@ -108,7 +114,7 @@ compareFormat modUnix fmt zone time = let
     haskellText = formatTime locale fmt ctime
     unixText = unixFormatTime fmt zone time
     expectedText = unixWorkarounds fmt (modUnix unixText)
-    in assertEqualQC "" expectedText haskellText
+    in assertEqualQC (show time ++ " with " ++ show zone) expectedText haskellText
 
 -- as found in http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html
 -- plus FgGklz
@@ -211,4 +217,4 @@ testQs = [
     ]
 
 testFormat :: TestTree
-testFormat = testGroup "testFormat" $ testCompareFormat ++ testCompareHashFormat ++ testQs
+testFormat = localOption (QuickCheckTests 10000) $ testGroup "testFormat" $ testCompareFormat ++ testCompareHashFormat ++ testQs



More information about the ghc-commits mailing list