From d03429e1913b6babd3b59d0bfdd7d3904b1b6f0b Mon Sep 17 00:00:00 2001
From: Ashley Yakeley <ashley@localhost.localdomain>
Date: Sat, 11 Mar 2017 12:45:30 -0800
Subject: [PATCH] Fix tests on 32 bit
---
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
--
GitLab