Add a (failing) QuickCheck test for formatRealFloat (gh-105)
authorBryan O'Sullivan <bos@serpentine.com>
Fri, 12 Dec 2014 21:06:23 +0000 (13:06 -0800)
committerBryan O'Sullivan <bos@serpentine.com>
Fri, 12 Dec 2014 21:06:23 +0000 (13:06 -0800)
tests/Tests/Properties.hs
tests/Tests/QuickCheckUtils.hs

index af3aefc..1649420 100644 (file)
@@ -24,7 +24,7 @@ import Data.Text.Internal.Search (indices)
 import Data.Text.Lazy.Read as TL
 import Data.Text.Read as T
 import Data.Word (Word, Word8, Word16, Word32, Word64)
-import Numeric (showHex)
+import Numeric (showGFloat, showHex)
 import Prelude hiding (replicate)
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -779,6 +779,15 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)
 tb_realfloat_float (a::Float) = tb_realfloat a
 tb_realfloat_double (a::Double) = tb_realfloat a
 
+tb_formatRealFloat_G :: (RealFloat a, Show a) => a -> Precision a -> Property
+tb_formatRealFloat_G a prec =
+    TB.formatRealFloat TB.Generic p a ===
+    TB.fromString (showGFloat p a "")
+  where p = precision a prec
+
+tb_formatRealFloat_G_float (a::Float) = tb_formatRealFloat_G a
+tb_formatRealFloat_G_double (a::Double) = tb_formatRealFloat_G a
+
 -- Reading.
 
 t_decimal (n::Int) s =
@@ -1284,7 +1293,9 @@ tests =
       ],
       testGroup "realfloat" [
         testProperty "tb_realfloat_double" tb_realfloat_double,
-        testProperty "tb_realfloat_float" tb_realfloat_float
+        testProperty "tb_realfloat_float" tb_realfloat_float,
+        testProperty "tb_formatRealFloat_G_float" tb_formatRealFloat_G_float,
+        testProperty "tb_formatRealFloat_G_double" tb_formatRealFloat_G_double
       ],
       testProperty "tb_fromText" tb_fromText,
       testProperty "tb_singleton" tb_singleton
index d7f43a6..e184878 100644 (file)
@@ -17,6 +17,9 @@ module Tests.QuickCheckUtils
     , Small (..)
     , small
 
+    , Precision(..)
+    , precision
+
     , integralRandomR
 
     , DecodeErr (..)
@@ -263,6 +266,27 @@ eqP f g s w  = eql "orig" (f s) (g t) &&
             | a =^= b   = True
             | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
 
+newtype Precision a = Precision (Maybe Int)
+                    deriving (Eq, Show)
+
+precision :: a -> Precision a -> Maybe Int
+precision _ (Precision prec) = prec
+
+arbitraryPrecision :: Int -> Gen (Precision a)
+arbitraryPrecision maxDigits = Precision <$> do
+  n <- choose (-1,maxDigits)
+  return $ if n == -1
+           then Nothing
+           else Just n
+
+instance Arbitrary (Precision Float) where
+    arbitrary = arbitraryPrecision 11
+    shrink    = map Precision . shrink . precision undefined
+
+instance Arbitrary (Precision Double) where
+    arbitrary = arbitraryPrecision 22
+    shrink    = map Precision . shrink . precision undefined
+
 -- Work around lack of Show instance for TextEncoding.
 data Encoding = E String IO.TextEncoding