diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 15985bfda..ac5909cf8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -135,7 +135,7 @@ jobs: githubToken: ${{ github.token }} install: | apt-get update -y - apt-get install -y curl ghc libghc-tasty-quickcheck-dev libghc-syb-dev + apt-get install -y curl ghc libghc-tasty-quickcheck-dev libghc-tasty-hunit-dev libghc-tasty-expected-failure-dev libghc-syb-dev run: | curl -s https://hackage.haskell.org/package/data-array-byte-0.1/data-array-byte-0.1.tar.gz | tar xz ghc --version diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs index 7f95a3e6f..6fba4ba71 100644 --- a/bench/BenchAll.hs +++ b/bench/BenchAll.hs @@ -7,8 +7,11 @@ -- Portability : tested on GHC only -- +{-# LANGUAGE ViewPatterns #-} + module Main (main) where +import Control.Exception (assert) import Data.Foldable (foldMap) import Data.Monoid import Data.Semigroup @@ -19,6 +22,8 @@ import Prelude hiding (words) import qualified Data.List as List import Control.DeepSeq import Control.Exception +import Numeric.IEEE +import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 @@ -55,6 +60,17 @@ countToZero :: Int -> Maybe (Int, Int) countToZero 0 = Nothing countToZero n = Just (n, n - 1) +castWord32ToFloat :: Word32 -> Float +castWord32ToFloat x = unsafePerformIO (with x (peek . castPtr)) + +castWord64ToDouble :: Word64 -> Double +castWord64ToDouble x = unsafePerformIO (with x (peek . castPtr)) + +castFloatToWord32 :: Float -> Word32 +castFloatToWord32 x = unsafePerformIO (with x (peek . castPtr)) + +castDoubleToWord64 :: Double -> Word64 +castDoubleToWord64 x = unsafePerformIO (with x (peek . castPtr)) ------------------------------------------------------------------------------ -- Benchmark @@ -79,14 +95,60 @@ smallIntegerData = map fromIntegral intData largeIntegerData :: [Integer] largeIntegerData = map (* (10 ^ (100 :: Integer))) smallIntegerData +{-# NOINLINE floatSubnormalData #-} +floatSubnormalData :: [Float] +floatSubnormalData = assert (increment > 0) $ map evenlyDistribute [1..nRepl] + where + evenlyDistribute x = castWord32ToFloat $ increment * fromIntegral x + increment = castFloatToWord32 maxSubnormal `div` fromIntegral nRepl + maxSubnormal = predIEEE minNormal -{-# NOINLINE floatData #-} -floatData :: [Float] -floatData = map (\x -> (3.14159 * fromIntegral x) ^ (3 :: Int)) intData +{-# NOINLINE floatNormalData #-} +floatNormalData :: [Float] +floatNormalData = assert (increment > 0) $ map evenlyDistribute [0..nRepl] + where + evenlyDistribute x = castWord32ToFloat $ increment * fromIntegral x + minimum + increment = (maximum - minimum) `div` fromIntegral nRepl + minimum = castFloatToWord32 minNormal + maximum = castFloatToWord32 maxFinite + +{-# NOINLINE floatSpecials #-} +floatSpecials :: [Float] +floatSpecials = take nRepl $ cycle specials + where + specials = [nan, infinity, negate infinity, 0 -0] -{-# NOINLINE doubleData #-} -doubleData :: [Double] -doubleData = map (\x -> (3.14159 * fromIntegral x) ^ (3 :: Int)) intData +{-# NOINLINE doubleSubnormalData #-} +doubleSubnormalData :: [Double] +doubleSubnormalData = assert (increment > 0) $ map evenlyDistribute [1..nRepl] + where + evenlyDistribute x = castWord64ToDouble $ increment * fromIntegral x + increment = castDoubleToWord64 maxSubnormal `div` fromIntegral nRepl + maxSubnormal = predIEEE minNormal + +{-# NOINLINE doubleSmallData #-} +doubleSmallData :: [Double] +doubleSmallData = assert (increment > 0) $ map evenlyDistribute [1..nRepl] + where + evenlyDistribute x = castWord64ToDouble $ increment * fromIntegral x + minimum + increment = (maximum - minimum) `div` fromIntegral nRepl + minimum = castDoubleToWord64 1.0 + maximum = castDoubleToWord64 $ 2 ^ 53 + +{-# NOINLINE doubleBigData #-} +doubleBigData :: [Double] +doubleBigData = assert (increment > 0) $ map evenlyDistribute [1..nRepl] + where + evenlyDistribute x = castWord64ToDouble $ increment * fromIntegral x + minimum + increment = (maximum - minimum) `div` fromIntegral nRepl + minimum = castDoubleToWord64 $ 2 ^ 53 + maximum = castDoubleToWord64 maxFinite + +{-# NOINLINE doubleSpecials #-} +doubleSpecials :: [Double] +doubleSpecials = take nRepl $ cycle specials + where + specials = [nan, infinity, negate infinity, 0 -0] {-# NOINLINE byteStringData #-} byteStringData :: S.ByteString @@ -353,12 +415,22 @@ main = do , bgroup "Non-bounded encodings" [ benchB "byteStringHex" byteStringData $ byteStringHex , benchB "lazyByteStringHex" lazyByteStringData $ lazyByteStringHex - , benchB "foldMap floatDec" floatData $ foldMap floatDec - , benchB "foldMap doubleDec" doubleData $ foldMap doubleDec -- Note that the small data corresponds to the intData pre-converted -- to Integer. , benchB "foldMap integerDec (small)" smallIntegerData $ foldMap integerDec , benchB "foldMap integerDec (large)" largeIntegerData $ foldMap integerDec + , bgroup "RealFloat" + [ bgroup "FGeneric" $ subAndNormalBench generic + , bgroup "FScientific"$ subAndNormalBench scientific + , bgroup "FStandard" + [ bgroup "Positive" $ fixedPrecision id id + , bgroup "Negative" $ fixedPrecision negate negate + , bgroup "Special" + [ benchB "Float Average" floatSpecials $ foldMap (formatFloat standardDefaultPrecision) + , benchB "Double Average" doubleSpecials $ foldMap (formatDouble standardDefaultPrecision) + ] + ] + ] ] ] @@ -581,3 +653,44 @@ main = do , benchReadInt , benchShort ] + +subAndNormalBench format = + [ bgroup "Positive" $ benchs id id + , bgroup "Negative" $ benchs negate negate + , bgroup "Special" + [ benchB "Float Average" floatSpecials $ foldMap (formatFloat format) + , benchB "Double Average" doubleSpecials $ foldMap (formatDouble format) + ] + ] + where + benchs f d = + [ bgroup "Float" + [ benchB "Subnormal" (map f floatSubnormalData) $ foldMap $ formatFloat format + , benchB "Normal" (map f floatNormalData) $ foldMap $ formatFloat format + ] + , bgroup "Double" + [ benchB "Subnormal" (map d doubleSubnormalData) $ foldMap $ formatDouble format + , benchB "Small" (map d doubleSmallData) $ foldMap $ formatDouble format + , benchB "Big" (map d doubleBigData) $ foldMap $ formatDouble format + ] + ] + +fixedPrecision f d = + [ bgroup "default precision" + [ bgroup "Float" + [ benchB "Subnormal" (map f floatSubnormalData) $ foldMap $ formatFloat standardDefaultPrecision + , benchB "Normal" (map f floatNormalData) $ foldMap $ formatFloat standardDefaultPrecision + ] + , bgroup "Double" + [ benchB "Subnormal" (map d doubleSubnormalData) $ foldMap $ formatDouble standardDefaultPrecision + , benchB "Small" (map d doubleSmallData) $ foldMap $ formatDouble standardDefaultPrecision + , benchB "Big" (map d doubleBigData) $ foldMap $ formatDouble standardDefaultPrecision + ] + ] + , bgroup "precision" + [ benchB "Float-Precision-1" (map f floatNormalData) $ foldMap $ formatFloat $ standard 1 + , benchB "Double-Precision-1" (map d doubleSmallData) $ foldMap $ formatDouble $ standard 1 + , benchB "Float-Precision-6" (map f floatNormalData) $ foldMap $ formatFloat $ standard 6 + , benchB "Double-Precision-6" (map d doubleSmallData) $ foldMap $ formatDouble $ standard 6 + ] + ] diff --git a/bytestring.cabal b/bytestring.cabal index 03f09c085..c30d68d88 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -214,6 +214,8 @@ test-suite bytestring-tests deepseq, QuickCheck, tasty, + tasty-expected-failure, + tasty-hunit, tasty-quickcheck >= 0.8.1, template-haskell, transformers >= 0.3, @@ -241,4 +243,5 @@ benchmark bytestring-bench bytestring, deepseq, tasty-bench, - random + random, + ieee754 diff --git a/tests/builder/Data/ByteString/Builder/Tests.hs b/tests/builder/Data/ByteString/Builder/Tests.hs index 224f27531..47d685330 100644 --- a/tests/builder/Data/ByteString/Builder/Tests.hs +++ b/tests/builder/Data/ByteString/Builder/Tests.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE) @@ -29,6 +32,7 @@ import Data.Word import qualified Data.ByteString as S import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as LC import qualified Data.ByteString.Short as Sh import Data.ByteString.Builder @@ -45,11 +49,13 @@ import Numeric (showFFloat) import System.Posix.Internals (c_unlink) import Test.Tasty (TestTree, TestName, testGroup) +import Test.Tasty.ExpectedFailure (expectFailBecause) +import Test.Tasty.HUnit (testCase, (@?=), Assertion) import Test.Tasty.QuickCheck ( Arbitrary(..), oneof, choose, listOf, elements , counterexample, ioProperty, Property, testProperty , (===), (.&&.), conjoin, forAll, forAllShrink - , UnicodeString(..), NonNegative(..), Positive(..) + , UnicodeString(..), NonNegative(..), Positive(..), NonZero(..) , mapSize, (==>) ) import QuickCheckUtils @@ -68,7 +74,7 @@ tests = testsEncodingToBuilder ++ testsBinary ++ testsASCII ++ - testsFloating ++ + testsFloating : testsChar8 ++ testsUtf8 ++ [testLaziness] @@ -635,333 +641,356 @@ testsASCII = where enlarge (n, e) = n ^ (abs (e `mod` (50 :: Integer))) -testsFloating :: [TestTree] -testsFloating = - [ testMatches "f2sBasic" floatDec show - [ ( 0.0 , "0.0" ) - , ( (-0.0) , "-0.0" ) - , ( 1.0 , "1.0" ) - , ( (-1.0) , "-1.0" ) - , ( (0/0) , "NaN" ) - , ( (1/0) , "Infinity" ) - , ( (-1/0) , "-Infinity" ) - ] - , testMatches "f2sSubnormal" floatDec show - [ ( 1.1754944e-38 , "1.1754944e-38" ) - ] - , testMatches "f2sMinAndMax" floatDec show - [ ( coerceWord32ToFloat 0x7f7fffff , "3.4028235e38" ) - , ( coerceWord32ToFloat 0x00000001 , "1.0e-45" ) - ] - , testMatches "f2sBoundaryRound" floatDec show - [ ( 3.355445e7 , "3.3554448e7" ) - , ( 8.999999e9 , "8.999999e9" ) - , ( 3.4366717e10 , "3.4366718e10" ) - ] - , testMatches "f2sExactValueRound" floatDec show - [ ( 3.0540412e5 , "305404.13" ) - , ( 8.0990312e3 , "8099.0313" ) - ] - , testMatches "f2sTrailingZeros" floatDec show - -- Pattern for the first test: 00111001100000000000000000000000 - [ ( 2.4414062e-4 , "2.4414063e-4" ) - , ( 2.4414062e-3 , "2.4414063e-3" ) - , ( 4.3945312e-3 , "4.3945313e-3" ) - , ( 6.3476562e-3 , "6.3476563e-3" ) - ] - , testMatches "f2sRegression" floatDec show - [ ( 4.7223665e21 , "4.7223665e21" ) - , ( 8388608.0 , "8388608.0" ) - , ( 1.6777216e7 , "1.6777216e7" ) - , ( 3.3554436e7 , "3.3554436e7" ) - , ( 6.7131496e7 , "6.7131496e7" ) - , ( 1.9310392e-38 , "1.9310392e-38" ) - , ( (-2.47e-43) , "-2.47e-43" ) - , ( 1.993244e-38 , "1.993244e-38" ) - , ( 4103.9003 , "4103.9004" ) - , ( 5.3399997e9 , "5.3399997e9" ) - , ( 6.0898e-39 , "6.0898e-39" ) - , ( 0.0010310042 , "1.0310042e-3" ) - , ( 2.8823261e17 , "2.882326e17" ) - , ( 7.0385309e-26 , "7.038531e-26" ) - , ( 9.2234038e17 , "9.223404e17" ) - , ( 6.7108872e7 , "6.710887e7" ) - , ( 1.0e-44 , "1.0e-44" ) - , ( 2.816025e14 , "2.816025e14" ) - , ( 9.223372e18 , "9.223372e18" ) - , ( 1.5846085e29 , "1.5846086e29" ) - , ( 1.1811161e19 , "1.1811161e19" ) - , ( 5.368709e18 , "5.368709e18" ) - , ( 4.6143165e18 , "4.6143166e18" ) - , ( 0.007812537 , "7.812537e-3" ) - , ( 1.4e-45 , "1.0e-45" ) - , ( 1.18697724e20 , "1.18697725e20" ) - , ( 1.00014165e-36 , "1.00014165e-36" ) - , ( 200.0 , "200.0" ) - , ( 3.3554432e7 , "3.3554432e7" ) - , ( 2.0019531 , "2.0019531" ) - , ( 2.001953 , "2.001953" ) - ] - , testExpected "f2sScientific" (formatFloat scientific) - [ ( 0.0 , "0.0e0" ) - , ( 8388608.0 , "8.388608e6" ) - , ( 1.6777216e7 , "1.6777216e7" ) - , ( 3.3554436e7 , "3.3554436e7" ) - , ( 6.7131496e7 , "6.7131496e7" ) - , ( 1.9310392e-38 , "1.9310392e-38" ) - , ( (-2.47e-43) , "-2.47e-43" ) - , ( 1.993244e-38 , "1.993244e-38" ) - , ( 4103.9003 , "4.1039004e3" ) - , ( 0.0010310042 , "1.0310042e-3" ) - , ( 0.007812537 , "7.812537e-3" ) - , ( 200.0 , "2.0e2" ) - , ( 2.0019531 , "2.0019531e0" ) - , ( 2.001953 , "2.001953e0" ) - ] - , testMatches "f2sLooksLikePowerOf5" floatDec show - [ ( coerceWord32ToFloat 0x5D1502F9 , "6.7108864e17" ) - , ( coerceWord32ToFloat 0x5D9502F9 , "1.3421773e18" ) - , ( coerceWord32ToFloat 0x5e1502F9 , "2.6843546e18" ) - ] - , testMatches "f2sOutputLength" floatDec show - [ ( 1.0 , "1.0" ) - , ( 1.2 , "1.2" ) - , ( 1.23 , "1.23" ) - , ( 1.234 , "1.234" ) - , ( 1.2345 , "1.2345" ) - , ( 1.23456 , "1.23456" ) - , ( 1.234567 , "1.234567" ) - , ( 1.2345678 , "1.2345678" ) - , ( 1.23456735e-36 , "1.23456735e-36" ) - ] - , testMatches "d2sBasic" doubleDec show - [ ( 0.0 , "0.0" ) - , ( (-0.0) , "-0.0" ) - , ( 1.0 , "1.0" ) - , ( (-1.0) , "-1.0" ) - , ( (0/0) , "NaN" ) - , ( (1/0) , "Infinity" ) - , ( (-1/0) , "-Infinity" ) - ] - , testMatches "d2sSubnormal" doubleDec show - [ ( 2.2250738585072014e-308 , "2.2250738585072014e-308" ) - ] - , testMatches "d2sMinAndMax" doubleDec show - [ ( (coerceWord64ToDouble 0x7fefffffffffffff) , "1.7976931348623157e308" ) - , ( (coerceWord64ToDouble 0x0000000000000001) , "5.0e-324" ) - ] - , testMatches "d2sTrailingZeros" doubleDec show - [ ( 2.98023223876953125e-8 , "2.9802322387695313e-8" ) - ] - , testMatches "d2sRegression" doubleDec show - [ ( (-2.109808898695963e16) , "-2.1098088986959632e16" ) - , ( 4.940656e-318 , "4.940656e-318" ) - , ( 1.18575755e-316 , "1.18575755e-316" ) - , ( 2.989102097996e-312 , "2.989102097996e-312" ) - , ( 9.0608011534336e15 , "9.0608011534336e15" ) - , ( 4.708356024711512e18 , "4.708356024711512e18" ) - , ( 9.409340012568248e18 , "9.409340012568248e18" ) - , ( 1.2345678 , "1.2345678" ) - , ( 1.9430376160308388e16 , "1.9430376160308388e16" ) - , ( (-6.9741824662760956e19), "-6.9741824662760956e19" ) - , ( 4.3816050601147837e18 , "4.3816050601147837e18" ) - ] - , testExpected "d2sScientific" (formatDouble scientific) - [ ( 0.0 , "0.0e0" ) - , ( 1.2345678 , "1.2345678e0" ) - , ( 4.294967294 , "4.294967294e0" ) - , ( 4.294967295 , "4.294967295e0" ) - ] - , testProperty "d2sStandard" $ conjoin - [ singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 12.345 , "12.34" ) - , singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 0.0050 , "0.00" ) - , singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 0.0051 , "0.01" ) - , singleMatches (formatDouble (standard 5)) (flip (showFFloat (Just 5)) []) ( 12.345 , "12.34500" ) - ] - , testMatches "d2sLooksLikePowerOf5" doubleDec show - [ ( (coerceWord64ToDouble 0x4830F0CF064DD592) , "5.764607523034235e39" ) - , ( (coerceWord64ToDouble 0x4840F0CF064DD592) , "1.152921504606847e40" ) - , ( (coerceWord64ToDouble 0x4850F0CF064DD592) , "2.305843009213694e40" ) - , ( (coerceWord64ToDouble 0x4400000000000004) , "3.689348814741914e19" ) - - -- here v- is a power of 5 but since we don't accept bounds there is no - -- interesting trailing behavior - , ( (coerceWord64ToDouble 0x440000000000301d) , "3.6893488147520004e19" ) - ] - , testMatches "d2sOutputLength" doubleDec show - [ ( 1 , "1.0" ) - , ( 1.2 , "1.2" ) - , ( 1.23 , "1.23" ) - , ( 1.234 , "1.234" ) - , ( 1.2345 , "1.2345" ) - , ( 1.23456 , "1.23456" ) - , ( 1.234567 , "1.234567" ) - , ( 1.2345678 , "1.2345678" ) - , ( 1.23456789 , "1.23456789" ) - , ( 1.234567895 , "1.234567895" ) - , ( 1.2345678901 , "1.2345678901" ) - , ( 1.23456789012 , "1.23456789012" ) - , ( 1.234567890123 , "1.234567890123" ) - , ( 1.2345678901234 , "1.2345678901234" ) - , ( 1.23456789012345 , "1.23456789012345" ) - , ( 1.234567890123456 , "1.234567890123456" ) - , ( 1.2345678901234567 , "1.2345678901234567" ) - - -- Test 32-bit chunking - , ( 4.294967294 , "4.294967294" ) - , ( 4.294967295 , "4.294967295" ) - , ( 4.294967296 , "4.294967296" ) - , ( 4.294967297 , "4.294967297" ) - , ( 4.294967298 , "4.294967298" ) - ] - , testMatches "d2sMinMaxShift" doubleDec show - [ ( (ieeeParts2Double False 4 0) , "1.7800590868057611e-307" ) - -- 32-bit opt-size=0: 49 <= dist <= 49 - -- 32-bit opt-size=1: 28 <= dist <= 49 - -- 64-bit opt-size=0: 50 <= dist <= 50 - -- 64-bit opt-size=1: 28 <= dist <= 50 - , ( (ieeeParts2Double False 6 maxMantissa) , "2.8480945388892175e-306" ) - -- 32-bit opt-size=0: 52 <= dist <= 53 - -- 32-bit opt-size=1: 2 <= dist <= 53 - -- 64-bit opt-size=0: 53 <= dist <= 53 - -- 64-bit opt-size=1: 2 <= dist <= 53 - , ( (ieeeParts2Double False 41 0) , "2.446494580089078e-296" ) - -- 32-bit opt-size=0: 52 <= dist <= 52 - -- 32-bit opt-size=1: 2 <= dist <= 52 - -- 64-bit opt-size=0: 53 <= dist <= 53 - -- 64-bit opt-size=1: 2 <= dist <= 53 - , ( (ieeeParts2Double False 40 maxMantissa) , "4.8929891601781557e-296" ) - -- 32-bit opt-size=0: 57 <= dist <= 58 - -- 32-bit opt-size=1: 57 <= dist <= 58 - -- 64-bit opt-size=0: 58 <= dist <= 58 - -- 64-bit opt-size=1: 58 <= dist <= 58 - , ( (ieeeParts2Double False 1077 0) , "1.8014398509481984e16" ) - -- 32-bit opt-size=0: 57 <= dist <= 57 - -- 32-bit opt-size=1: 57 <= dist <= 57 - -- 64-bit opt-size=0: 58 <= dist <= 58 - -- 64-bit opt-size=1: 58 <= dist <= 58 - , ( (ieeeParts2Double False 1076 maxMantissa) , "3.6028797018963964e16" ) - -- 32-bit opt-size=0: 51 <= dist <= 52 - -- 32-bit opt-size=1: 51 <= dist <= 59 - -- 64-bit opt-size=0: 52 <= dist <= 52 - -- 64-bit opt-size=1: 52 <= dist <= 59 - , ( (ieeeParts2Double False 307 0) , "2.900835519859558e-216" ) - -- 32-bit opt-size=0: 51 <= dist <= 51 - -- 32-bit opt-size=1: 51 <= dist <= 59 - -- 64-bit opt-size=0: 52 <= dist <= 52 - -- 64-bit opt-size=1: 52 <= dist <= 59 - , ( (ieeeParts2Double False 306 maxMantissa) , "5.801671039719115e-216" ) - -- 32-bit opt-size=0: 49 <= dist <= 49 - -- 32-bit opt-size=1: 44 <= dist <= 49 - -- 64-bit opt-size=0: 50 <= dist <= 50 - -- 64-bit opt-size=1: 44 <= dist <= 50 - , ( (ieeeParts2Double False 934 0x000FA7161A4D6e0C) , "3.196104012172126e-27" ) - ] - , testMatches "d2sSmallIntegers" doubleDec show - [ ( 9007199254740991.0 , "9.007199254740991e15" ) - , ( 9007199254740992.0 , "9.007199254740992e15" ) - - , ( 1.0e+0 , "1.0" ) - , ( 1.2e+1 , "12.0" ) - , ( 1.23e+2 , "123.0" ) - , ( 1.234e+3 , "1234.0" ) - , ( 1.2345e+4 , "12345.0" ) - , ( 1.23456e+5 , "123456.0" ) - , ( 1.234567e+6 , "1234567.0" ) - , ( 1.2345678e+7 , "1.2345678e7" ) - , ( 1.23456789e+8 , "1.23456789e8" ) - , ( 1.23456789e+9 , "1.23456789e9" ) - , ( 1.234567895e+9 , "1.234567895e9" ) - , ( 1.2345678901e+10 , "1.2345678901e10" ) - , ( 1.23456789012e+11 , "1.23456789012e11" ) - , ( 1.234567890123e+12 , "1.234567890123e12" ) - , ( 1.2345678901234e+13 , "1.2345678901234e13" ) - , ( 1.23456789012345e+14 , "1.23456789012345e14" ) - , ( 1.234567890123456e+15 , "1.234567890123456e15" ) - - -- 10^i - , ( 1.0e+0 , "1.0" ) - , ( 1.0e+1 , "10.0" ) - , ( 1.0e+2 , "100.0" ) - , ( 1.0e+3 , "1000.0" ) - , ( 1.0e+4 , "10000.0" ) - , ( 1.0e+5 , "100000.0" ) - , ( 1.0e+6 , "1000000.0" ) - , ( 1.0e+7 , "1.0e7" ) - , ( 1.0e+8 , "1.0e8" ) - , ( 1.0e+9 , "1.0e9" ) - , ( 1.0e+10 , "1.0e10" ) - , ( 1.0e+11 , "1.0e11" ) - , ( 1.0e+12 , "1.0e12" ) - , ( 1.0e+13 , "1.0e13" ) - , ( 1.0e+14 , "1.0e14" ) - , ( 1.0e+15 , "1.0e15" ) - - -- 10^15 + 10^i - , ( (1.0e+15 + 1.0e+0) , "1.000000000000001e15" ) - , ( (1.0e+15 + 1.0e+1) , "1.00000000000001e15" ) - , ( (1.0e+15 + 1.0e+2) , "1.0000000000001e15" ) - , ( (1.0e+15 + 1.0e+3) , "1.000000000001e15" ) - , ( (1.0e+15 + 1.0e+4) , "1.00000000001e15" ) - , ( (1.0e+15 + 1.0e+5) , "1.0000000001e15" ) - , ( (1.0e+15 + 1.0e+6) , "1.000000001e15" ) - , ( (1.0e+15 + 1.0e+7) , "1.00000001e15" ) - , ( (1.0e+15 + 1.0e+8) , "1.0000001e15" ) - , ( (1.0e+15 + 1.0e+9) , "1.000001e15" ) - , ( (1.0e+15 + 1.0e+10) , "1.00001e15" ) - , ( (1.0e+15 + 1.0e+11) , "1.0001e15" ) - , ( (1.0e+15 + 1.0e+12) , "1.001e15" ) - , ( (1.0e+15 + 1.0e+13) , "1.01e15" ) - , ( (1.0e+15 + 1.0e+14) , "1.1e15" ) - - -- Largest power of 2 <= 10^(i+1) - , ( 8.0 , "8.0" ) - , ( 64.0 , "64.0" ) - , ( 512.0 , "512.0" ) - , ( 8192.0 , "8192.0" ) - , ( 65536.0 , "65536.0" ) - , ( 524288.0 , "524288.0" ) - , ( 8388608.0 , "8388608.0" ) - , ( 67108864.0 , "6.7108864e7" ) - , ( 536870912.0 , "5.36870912e8" ) - , ( 8589934592.0 , "8.589934592e9" ) - , ( 68719476736.0 , "6.8719476736e10" ) - , ( 549755813888.0 , "5.49755813888e11" ) - , ( 8796093022208.0 , "8.796093022208e12" ) - , ( 70368744177664.0 , "7.0368744177664e13" ) - , ( 562949953421312.0 , "5.62949953421312e14" ) - , ( 9007199254740992.0 , "9.007199254740992e15" ) - - -- 1000 * (Largest power of 2 <= 10^(i+1)) - , ( 8.0e+3 , "8000.0" ) - , ( 64.0e+3 , "64000.0" ) - , ( 512.0e+3 , "512000.0" ) - , ( 8192.0e+3 , "8192000.0" ) - , ( 65536.0e+3 , "6.5536e7" ) - , ( 524288.0e+3 , "5.24288e8" ) - , ( 8388608.0e+3 , "8.388608e9" ) - , ( 67108864.0e+3 , "6.7108864e10" ) - , ( 536870912.0e+3 , "5.36870912e11" ) - , ( 8589934592.0e+3 , "8.589934592e12" ) - , ( 68719476736.0e+3 , "6.8719476736e13" ) - , ( 549755813888.0e+3 , "5.49755813888e14" ) - , ( 8796093022208.0e+3 , "8.796093022208e15" ) - ] - , testMatches "f2sPowersOf10" floatDec show $ - fmap asShowRef [read ("1.0e" ++ show x) :: Float | x <- [-46..39 :: Int]] - , testMatches "d2sPowersOf10" doubleDec show $ - fmap asShowRef [read ("1.0e" ++ show x) :: Double | x <- [-324..309 :: Int]] +testsFloating :: TestTree +testsFloating = testGroup "RealFloat" + [ testGroup "Float" + [ testMatches "f2sNonNumbersAndZero" floatDec show + [ ( 0.0 , "0.0" ) + , ( (-0.0) , "-0.0" ) + , ( (0/0) , "NaN" ) + , ( (1/0) , "Infinity" ) + , ( (-1/0) , "-Infinity" ) + ] + , testMatches "f2sBasic" floatDec show + [ ( 1.0 , "1.0" ) + , ( (-1.0) , "-1.0" ) + ] + , testMatches "f2sSubnormal" floatDec show + [ ( 1.1754944e-38 , "1.1754944e-38" ) + ] + , testMatches "f2sMinAndMax" floatDec show + [ ( coerceWord32ToFloat 0x7f7fffff , "3.4028235e38" ) + , ( coerceWord32ToFloat 0x00000001 , "1.0e-45" ) + ] + , testMatches "f2sBoundaryRound" floatDec show + [ ( 3.355445e7 , "3.3554448e7" ) + , ( 8.999999e9 , "8.999999e9" ) + , ( 3.4366717e10 , "3.4366718e10" ) + ] + , testMatches "f2sExactValueRound" floatDec show + [ ( 3.0540412e5 , "305404.13" ) + , ( 8.0990312e3 , "8099.0313" ) + ] + , testMatches "f2sTrailingZeros" floatDec show + -- Pattern for the first test: 00111001100000000000000000000000 + [ ( 2.4414062e-4 , "2.4414063e-4" ) + , ( 2.4414062e-3 , "2.4414063e-3" ) + , ( 4.3945312e-3 , "4.3945313e-3" ) + , ( 6.3476562e-3 , "6.3476563e-3" ) + ] + , testMatches "f2sRegression" floatDec show + [ ( 4.7223665e21 , "4.7223665e21" ) + , ( 8388608.0 , "8388608.0" ) + , ( 1.6777216e7 , "1.6777216e7" ) + , ( 3.3554436e7 , "3.3554436e7" ) + , ( 6.7131496e7 , "6.7131496e7" ) + , ( 1.9310392e-38 , "1.9310392e-38" ) + , ( (-2.47e-43) , "-2.47e-43" ) + , ( 1.993244e-38 , "1.993244e-38" ) + , ( 4103.9003 , "4103.9004" ) + , ( 5.3399997e9 , "5.3399997e9" ) + , ( 6.0898e-39 , "6.0898e-39" ) + , ( 0.0010310042 , "1.0310042e-3" ) + , ( 2.8823261e17 , "2.882326e17" ) + , ( 7.0385309e-26 , "7.038531e-26" ) + , ( 9.2234038e17 , "9.223404e17" ) + , ( 6.7108872e7 , "6.710887e7" ) + , ( 1.0e-44 , "1.0e-44" ) + , ( 2.816025e14 , "2.816025e14" ) + , ( 9.223372e18 , "9.223372e18" ) + , ( 1.5846085e29 , "1.5846086e29" ) + , ( 1.1811161e19 , "1.1811161e19" ) + , ( 5.368709e18 , "5.368709e18" ) + , ( 4.6143165e18 , "4.6143166e18" ) + , ( 0.007812537 , "7.812537e-3" ) + , ( 1.4e-45 , "1.0e-45" ) + , ( 1.18697724e20 , "1.18697725e20" ) + , ( 1.00014165e-36 , "1.00014165e-36" ) + , ( 200.0 , "200.0" ) + , ( 3.3554432e7 , "3.3554432e7" ) + , ( 2.0019531 , "2.0019531" ) + , ( 2.001953 , "2.001953" ) + ] + , testExpected "f2sScientific" (formatFloat scientific) + [ ( 0.0 , "0.0e0" ) + , ( 8388608.0 , "8.388608e6" ) + , ( 1.6777216e7 , "1.6777216e7" ) + , ( 3.3554436e7 , "3.3554436e7" ) + , ( 6.7131496e7 , "6.7131496e7" ) + , ( 1.9310392e-38 , "1.9310392e-38" ) + , ( (-2.47e-43) , "-2.47e-43" ) + , ( 1.993244e-38 , "1.993244e-38" ) + , ( 4103.9003 , "4.1039004e3" ) + , ( 0.0010310042 , "1.0310042e-3" ) + , ( 0.007812537 , "7.812537e-3" ) + , ( 200.0 , "2.0e2" ) + , ( 2.0019531 , "2.0019531e0" ) + , ( 2.001953 , "2.001953e0" ) + ] + , testMatches "f2sLooksLikePowerOf5" floatDec show + [ ( coerceWord32ToFloat 0x5D1502F9 , "6.7108864e17" ) + , ( coerceWord32ToFloat 0x5D9502F9 , "1.3421773e18" ) + , ( coerceWord32ToFloat 0x5e1502F9 , "2.6843546e18" ) + ] + , testMatches "f2sOutputLength" floatDec show + [ ( 1.0 , "1.0" ) + , ( 1.2 , "1.2" ) + , ( 1.23 , "1.23" ) + , ( 1.234 , "1.234" ) + , ( 1.2345 , "1.2345" ) + , ( 1.23456 , "1.23456" ) + , ( 1.234567 , "1.234567" ) + , ( 1.2345678 , "1.2345678" ) + , ( 1.23456735e-36 , "1.23456735e-36" ) + ] + , testMatches "f2sPowersOf10" floatDec show $ + fmap asShowRef [read ("1.0e" ++ show x) :: Float | x <- [-46..39 :: Int]] + ] + , testGroup "Double" + [ testMatches "d2sBasic" doubleDec show + [ ( 1.0 , "1.0" ) + , ( (-1.0) , "-1.0" ) + ] + , testMatches "d2sNonNumbersAndZero" doubleDec show + [ ( 0.0 , "0.0" ) + , ( (-0.0) , "-0.0" ) + , ( (0/0) , "NaN" ) + , ( (1/0) , "Infinity" ) + , ( (-1/0) , "-Infinity" ) + ] + , testMatches "d2sSubnormal" doubleDec show + [ ( 2.2250738585072014e-308 , "2.2250738585072014e-308" ) + ] + , testMatches "d2sMinAndMax" doubleDec show + [ ( (coerceWord64ToDouble 0x7fefffffffffffff) , "1.7976931348623157e308" ) + , ( (coerceWord64ToDouble 0x0000000000000001) , "5.0e-324" ) + ] + , testMatches "d2sTrailingZeros" doubleDec show + [ ( 2.98023223876953125e-8 , "2.9802322387695313e-8" ) + ] + , testMatches "d2sRegression" doubleDec show + [ ( (-2.109808898695963e16) , "-2.1098088986959632e16" ) + , ( 4.940656e-318 , "4.940656e-318" ) + , ( 1.18575755e-316 , "1.18575755e-316" ) + , ( 2.989102097996e-312 , "2.989102097996e-312" ) + , ( 9.0608011534336e15 , "9.0608011534336e15" ) + , ( 4.708356024711512e18 , "4.708356024711512e18" ) + , ( 9.409340012568248e18 , "9.409340012568248e18" ) + , ( 1.2345678 , "1.2345678" ) + , ( 1.9430376160308388e16 , "1.9430376160308388e16" ) + , ( (-6.9741824662760956e19), "-6.9741824662760956e19" ) + , ( 4.3816050601147837e18 , "4.3816050601147837e18" ) + ] + , testExpected "d2sScientific" (formatDouble scientific) + [ ( 0.0 , "0.0e0" ) + , ( 1.2345678 , "1.2345678e0" ) + , ( 4.294967294 , "4.294967294e0" ) + , ( 4.294967295 , "4.294967295e0" ) + ] + , testGroup "d2sStandard" + [ testCase "specific" $ do + singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 12.3 , "12.30" ) + singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 12.345 , "12.34" ) + singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 12.3451 , "12.35" ) + singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 0.0050 , "0.00" ) + singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 999.999 , "1000.00" ) + singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 999.199 , "999.20" ) + singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 0.999 , "1.00" ) + singleMatches (formatDouble (standard 2)) (flip (showFFloat (Just 2)) []) ( 0.0051 , "0.01" ) + singleMatches (formatDouble (standard 3)) (flip (showFFloat (Just 3)) []) ( 0.0056 , "0.006" ) + singleMatches (formatDouble (standard 3)) (flip (showFFloat (Just 3)) []) ( 0.0096 , "0.010" ) + singleMatches (formatDouble (standard 5)) (flip (showFFloat (Just 5)) []) ( 12.345 , "12.34500" ) + , expectFailBecause "incorrect implementation for the zero case" $ + testCase "specific zero" $ + singleMatches (formatDouble (standard 3)) (flip (showFFloat (Just 3)) []) ( 0.0 , "0.000" ) + -- NonZero should be removed when zero case fixed + , testProperty "standard N" $ \(NonNegative p, NonZero (d :: Double)) -> (LC.unpack . toLazyByteString) + (formatDouble (standard p) d) === showFFloat (Just p) d "" + ] + , testMatches "d2sLooksLikePowerOf5" doubleDec show + [ ( (coerceWord64ToDouble 0x4830F0CF064DD592) , "5.764607523034235e39" ) + , ( (coerceWord64ToDouble 0x4840F0CF064DD592) , "1.152921504606847e40" ) + , ( (coerceWord64ToDouble 0x4850F0CF064DD592) , "2.305843009213694e40" ) + , ( (coerceWord64ToDouble 0x4400000000000004) , "3.689348814741914e19" ) + + -- here v- is a power of 5 but since we don't accept bounds there is no + -- interesting trailing behavior + , ( (coerceWord64ToDouble 0x440000000000301d) , "3.6893488147520004e19" ) + ] + , testMatches "d2sOutputLength" doubleDec show + [ ( 1 , "1.0" ) + , ( 1.2 , "1.2" ) + , ( 1.23 , "1.23" ) + , ( 1.234 , "1.234" ) + , ( 1.2345 , "1.2345" ) + , ( 1.23456 , "1.23456" ) + , ( 1.234567 , "1.234567" ) + , ( 1.2345678 , "1.2345678" ) + , ( 1.23456789 , "1.23456789" ) + , ( 1.234567895 , "1.234567895" ) + , ( 1.2345678901 , "1.2345678901" ) + , ( 1.23456789012 , "1.23456789012" ) + , ( 1.234567890123 , "1.234567890123" ) + , ( 1.2345678901234 , "1.2345678901234" ) + , ( 1.23456789012345 , "1.23456789012345" ) + , ( 1.234567890123456 , "1.234567890123456" ) + , ( 1.2345678901234567 , "1.2345678901234567" ) + + -- Test 32-bit chunking + , ( 4.294967294 , "4.294967294" ) + , ( 4.294967295 , "4.294967295" ) + , ( 4.294967296 , "4.294967296" ) + , ( 4.294967297 , "4.294967297" ) + , ( 4.294967298 , "4.294967298" ) + ] + , testMatches "d2sMinMaxShift" doubleDec show + [ ( (ieeeParts2Double False 4 0) , "1.7800590868057611e-307" ) + -- 32-bit opt-size=0: 49 <= dist <= 49 + -- 32-bit opt-size=1: 28 <= dist <= 49 + -- 64-bit opt-size=0: 50 <= dist <= 50 + -- 64-bit opt-size=1: 28 <= dist <= 50 + , ( (ieeeParts2Double False 6 maxMantissa) , "2.8480945388892175e-306" ) + -- 32-bit opt-size=0: 52 <= dist <= 53 + -- 32-bit opt-size=1: 2 <= dist <= 53 + -- 64-bit opt-size=0: 53 <= dist <= 53 + -- 64-bit opt-size=1: 2 <= dist <= 53 + , ( (ieeeParts2Double False 41 0) , "2.446494580089078e-296" ) + -- 32-bit opt-size=0: 52 <= dist <= 52 + -- 32-bit opt-size=1: 2 <= dist <= 52 + -- 64-bit opt-size=0: 53 <= dist <= 53 + -- 64-bit opt-size=1: 2 <= dist <= 53 + , ( (ieeeParts2Double False 40 maxMantissa) , "4.8929891601781557e-296" ) + -- 32-bit opt-size=0: 57 <= dist <= 58 + -- 32-bit opt-size=1: 57 <= dist <= 58 + -- 64-bit opt-size=0: 58 <= dist <= 58 + -- 64-bit opt-size=1: 58 <= dist <= 58 + , ( (ieeeParts2Double False 1077 0) , "1.8014398509481984e16" ) + -- 32-bit opt-size=0: 57 <= dist <= 57 + -- 32-bit opt-size=1: 57 <= dist <= 57 + -- 64-bit opt-size=0: 58 <= dist <= 58 + -- 64-bit opt-size=1: 58 <= dist <= 58 + , ( (ieeeParts2Double False 1076 maxMantissa) , "3.6028797018963964e16" ) + -- 32-bit opt-size=0: 51 <= dist <= 52 + -- 32-bit opt-size=1: 51 <= dist <= 59 + -- 64-bit opt-size=0: 52 <= dist <= 52 + -- 64-bit opt-size=1: 52 <= dist <= 59 + , ( (ieeeParts2Double False 307 0) , "2.900835519859558e-216" ) + -- 32-bit opt-size=0: 51 <= dist <= 51 + -- 32-bit opt-size=1: 51 <= dist <= 59 + -- 64-bit opt-size=0: 52 <= dist <= 52 + -- 64-bit opt-size=1: 52 <= dist <= 59 + , ( (ieeeParts2Double False 306 maxMantissa) , "5.801671039719115e-216" ) + -- 32-bit opt-size=0: 49 <= dist <= 49 + -- 32-bit opt-size=1: 44 <= dist <= 49 + -- 64-bit opt-size=0: 50 <= dist <= 50 + -- 64-bit opt-size=1: 44 <= dist <= 50 + , ( (ieeeParts2Double False 934 0x000FA7161A4D6e0C) , "3.196104012172126e-27" ) + ] + , testMatches "d2sSmallIntegers" doubleDec show + [ ( 9007199254740991.0 , "9.007199254740991e15" ) + , ( 9007199254740992.0 , "9.007199254740992e15" ) + + , ( 1.0e+0 , "1.0" ) + , ( 1.2e+1 , "12.0" ) + , ( 1.23e+2 , "123.0" ) + , ( 1.234e+3 , "1234.0" ) + , ( 1.2345e+4 , "12345.0" ) + , ( 1.23456e+5 , "123456.0" ) + , ( 1.234567e+6 , "1234567.0" ) + , ( 1.2345678e+7 , "1.2345678e7" ) + , ( 1.23456789e+8 , "1.23456789e8" ) + , ( 1.23456789e+9 , "1.23456789e9" ) + , ( 1.234567895e+9 , "1.234567895e9" ) + , ( 1.2345678901e+10 , "1.2345678901e10" ) + , ( 1.23456789012e+11 , "1.23456789012e11" ) + , ( 1.234567890123e+12 , "1.234567890123e12" ) + , ( 1.2345678901234e+13 , "1.2345678901234e13" ) + , ( 1.23456789012345e+14 , "1.23456789012345e14" ) + , ( 1.234567890123456e+15 , "1.234567890123456e15" ) + + -- 10^i + , ( 1.0e+0 , "1.0" ) + , ( 1.0e+1 , "10.0" ) + , ( 1.0e+2 , "100.0" ) + , ( 1.0e+3 , "1000.0" ) + , ( 1.0e+4 , "10000.0" ) + , ( 1.0e+5 , "100000.0" ) + , ( 1.0e+6 , "1000000.0" ) + , ( 1.0e+7 , "1.0e7" ) + , ( 1.0e+8 , "1.0e8" ) + , ( 1.0e+9 , "1.0e9" ) + , ( 1.0e+10 , "1.0e10" ) + , ( 1.0e+11 , "1.0e11" ) + , ( 1.0e+12 , "1.0e12" ) + , ( 1.0e+13 , "1.0e13" ) + , ( 1.0e+14 , "1.0e14" ) + , ( 1.0e+15 , "1.0e15" ) + + -- 10^15 + 10^i + , ( (1.0e+15 + 1.0e+0) , "1.000000000000001e15" ) + , ( (1.0e+15 + 1.0e+1) , "1.00000000000001e15" ) + , ( (1.0e+15 + 1.0e+2) , "1.0000000000001e15" ) + , ( (1.0e+15 + 1.0e+3) , "1.000000000001e15" ) + , ( (1.0e+15 + 1.0e+4) , "1.00000000001e15" ) + , ( (1.0e+15 + 1.0e+5) , "1.0000000001e15" ) + , ( (1.0e+15 + 1.0e+6) , "1.000000001e15" ) + , ( (1.0e+15 + 1.0e+7) , "1.00000001e15" ) + , ( (1.0e+15 + 1.0e+8) , "1.0000001e15" ) + , ( (1.0e+15 + 1.0e+9) , "1.000001e15" ) + , ( (1.0e+15 + 1.0e+10) , "1.00001e15" ) + , ( (1.0e+15 + 1.0e+11) , "1.0001e15" ) + , ( (1.0e+15 + 1.0e+12) , "1.001e15" ) + , ( (1.0e+15 + 1.0e+13) , "1.01e15" ) + , ( (1.0e+15 + 1.0e+14) , "1.1e15" ) + + -- Largest power of 2 <= 10^(i+1) + , ( 8.0 , "8.0" ) + , ( 64.0 , "64.0" ) + , ( 512.0 , "512.0" ) + , ( 8192.0 , "8192.0" ) + , ( 65536.0 , "65536.0" ) + , ( 524288.0 , "524288.0" ) + , ( 8388608.0 , "8388608.0" ) + , ( 67108864.0 , "6.7108864e7" ) + , ( 536870912.0 , "5.36870912e8" ) + , ( 8589934592.0 , "8.589934592e9" ) + , ( 68719476736.0 , "6.8719476736e10" ) + , ( 549755813888.0 , "5.49755813888e11" ) + , ( 8796093022208.0 , "8.796093022208e12" ) + , ( 70368744177664.0 , "7.0368744177664e13" ) + , ( 562949953421312.0 , "5.62949953421312e14" ) + , ( 9007199254740992.0 , "9.007199254740992e15" ) + + -- 1000 * (Largest power of 2 <= 10^(i+1)) + , ( 8.0e+3 , "8000.0" ) + , ( 64.0e+3 , "64000.0" ) + , ( 512.0e+3 , "512000.0" ) + , ( 8192.0e+3 , "8192000.0" ) + , ( 65536.0e+3 , "6.5536e7" ) + , ( 524288.0e+3 , "5.24288e8" ) + , ( 8388608.0e+3 , "8.388608e9" ) + , ( 67108864.0e+3 , "6.7108864e10" ) + , ( 536870912.0e+3 , "5.36870912e11" ) + , ( 8589934592.0e+3 , "8.589934592e12" ) + , ( 68719476736.0e+3 , "6.8719476736e13" ) + , ( 549755813888.0e+3 , "5.49755813888e14" ) + , ( 8796093022208.0e+3 , "8.796093022208e15" ) + ] + , testMatches "d2sPowersOf10" doubleDec show $ + fmap asShowRef [read ("1.0e" ++ show x) :: Double | x <- [-324..309 :: Int]] + ] ] where testExpected :: TestName -> (a -> Builder) -> [(a, String)] -> TestTree - testExpected name dec lst = testProperty name . conjoin $ - fmap (\(x, ref) -> L.unpack (toLazyByteString (dec x)) === encodeASCII ref) lst + testExpected name dec = testCase name . traverse_ (\(x, ref) -> LC.unpack (toLazyByteString (dec x)) @?= ref) - singleMatches :: (a -> Builder) -> (a -> String) -> (a, String) -> Property - singleMatches dec refdec (x, ref) = L.unpack (toLazyByteString (dec x)) === encodeASCII (refdec x) .&&. refdec x === ref + singleMatches :: (a -> Builder) -> (a -> String) -> (a, String) -> Assertion + singleMatches dec refdec (x, ref) = do + LC.unpack (toLazyByteString (dec x)) @?= refdec x + refdec x @?= ref testMatches :: TestName -> (a -> Builder) -> (a -> String) -> [(a, String)] -> TestTree - testMatches name dec refdec lst = testProperty name . conjoin $ fmap (singleMatches dec refdec) lst + testMatches name dec refdec = testCase name . traverse_ (singleMatches dec refdec) maxMantissa = (1 `shiftL` 53) - 1 :: Word64