git.iko.soy/streamly
on master help sign in
Add benchmarks and property test for double Parser
efe0be3Ranjeet Kumar Ranjan
test/Streamly/Test/Unicode/Parser.hs+83−9
compare with master
unifiedsplit
@@ -4,17 +4,81 @@ module Streamly.Test.Unicode.Parser
4 (main)
4 (main)
5where
5where
6
6
7+import Control.Monad.Identity (Identity(runIdentity))
8+import Debug.Trace (trace)
7import Streamly.Internal.Data.Parser (ParseError (..))
9import Streamly.Internal.Data.Parser (ParseError (..))
10+import Streamly.Test.Common (chooseDouble)
8import Test.Hspec.QuickCheck (prop)
11import Test.Hspec.QuickCheck (prop)
9−import Test.QuickCheck (Property)
12+import Test.QuickCheck
13+ (forAll, Property, property)
10−import Test.QuickCheck.Monadic (run, monadicIO, assert)
14+import Test.QuickCheck.Monadic (monadicIO, assert, run)
11
15
16+import qualified Data.Scientific as Scientific
12import qualified Streamly.Data.Stream as Stream
17import qualified Streamly.Data.Stream as Stream
13− ( fromList, parse )
14−import qualified Streamly.Internal.Data.Stream as Stream (parseBreak, toList)
18+import qualified Streamly.Internal.Data.Stream as Stream (parseBreak)
15import qualified Streamly.Unicode.Parser as Unicode
19import qualified Streamly.Unicode.Parser as Unicode
20+import qualified Streamly.Internal.Unicode.Parser as Parser
16import qualified Test.Hspec as H
21import qualified Test.Hspec as H
17−import Debug.Trace (trace)
22+
23+-- Scientific notation
24+scientificExpFP :: Property
25+scientificExpFP =
26+ forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls ->
27+ case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of
28+ Right val -> if val == show ls
29+ then property (val == show ls)
30+ else trace
31+ ("Expected = " ++ show ls ++ " Got = " ++ val)
32+ property (val == show ls)
33+ Left _ -> property False
34+
35+ where
36+
37+ formatter = Scientific.formatScientific Scientific.Exponent Nothing
38+ toScientific (c, m) = Scientific.scientific c m
39+ parser = formatter . toScientific <$> Parser.number
40+
41+-- Standard decimal notation.
42+scientificFixFP :: Property
43+scientificFixFP =
44+ forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->
45+ case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of
46+ Right val -> if val == show ls
47+ then property (val == show ls)
48+ else trace
49+ ("Expected = " ++ show ls ++ " Got = " ++ val)
50+ property (val == show ls)
51+ Left _ -> property False
52+
53+ where
54+
55+ formatter = Scientific.formatScientific Scientific.Fixed Nothing
56+ toScientific (c, m) = Scientific.scientific c m
57+ parser = formatter . toScientific <$> Parser.number
58+
59+doubleExpFP :: Property
60+doubleExpFP =
61+ forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls -> do
62+ let sls = show ls
63+ case runIdentity $ Stream.parse Parser.double (Stream.fromList sls) of
64+ Right val -> if val == ls
65+ then property (val == ls)
66+ else trace
67+ ("Read = "++ show (read sls :: Double) ++ " Expected = " ++ sls ++ " Got = " ++ show val)
68+ property (val == ls)
69+ Left _ -> property False
70+
71+-- Standard decimal notation.
72+doubleFixFP :: Property
73+doubleFixFP =
74+ forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->
75+ case runIdentity $ Stream.parse Parser.double (Stream.fromList (show ls)) of
76+ Right val -> if val == ls
77+ then property (val == ls)
78+ else trace
79+ ("Expected = " ++ show ls ++ " Got = " ++ show val)
80+ property (val == ls)
81+ Left _ -> property False
18
82
19doubleParser :: String -> IO (Either ParseError Double)
83doubleParser :: String -> IO (Either ParseError Double)
20doubleParser = Stream.parse Unicode.double . Stream.fromList
84doubleParser = Stream.parse Unicode.double . Stream.fromList
@@ -23,15 +87,19 @@ double :: String -> Double -> Property
23double s d = monadicIO $ do
87double s d = monadicIO $ do
24 x <- run $ doubleParser s
88 x <- run $ doubleParser s
25 case x of
89 case x of
90+ Right val -> if val == d
91+ then assert (val == d)
26− Right val -> trace ("parsed " ++ show val) (assert (val == d))
92+ else trace ("Expectedc = " ++ show d ++ " Got = "++ show val) (assert (val == d))
27− Left (ParseError _) -> assert (False)
93+ Left (ParseError _) -> assert False
28
94
29doubleErr :: String -> String -> Property
95doubleErr :: String -> String -> Property
30doubleErr s msg = monadicIO $ do
96doubleErr s msg = monadicIO $ do
31 x <- run $ doubleParser s
97 x <- run $ doubleParser s
32 case x of
98 case x of
33− Right _ -> assert (False)
99+ Right _ -> assert False
100+ Left (ParseError err) -> if err == msg
101+ then assert (err == msg)
34− Left (ParseError err) -> trace err (assert (err == msg))
102+ else trace err (assert (err == msg))
35
103
36remainingStream :: String -> [String]
104remainingStream :: String -> [String]
37remainingStream x =
105remainingStream x =
@@ -118,3 +186,9 @@ main = do
118 prop "afterParse \"..\" \"..\"" $ afterParse ".." ".."
186 prop "afterParse \"..\" \"..\"" $ afterParse ".." ".."
119 prop "afterParse \"+\" \"+\"" $ afterParse "+" "+"
187 prop "afterParse \"+\" \"+\"" $ afterParse "+" "+"
120 prop "afterParse \"++\" \"++\"" $ afterParse "++" "++"
188 prop "afterParse \"++\" \"++\"" $ afterParse "++" "++"
189+ H.describe "Scientific parser property test" $ do
190+ prop "Exponent format" scientificExpFP
191+ prop "Decimal format" scientificFixFP
192+ H.describe "double parser property test" $ do
193+ prop "Exponent format" doubleExpFP
194+ prop "Decimal format" doubleFixFP
test/lib/Streamly/Test/Common.hs+4
@@ -12,6 +12,7 @@ module Streamly.Test.Common
12 , listEquals
12 , listEquals
13 , checkListEqual
13 , checkListEqual
14 , chooseInt
14 , chooseInt
15+ , chooseDouble
15 ) where
16 ) where
16
17
17import Control.Monad (when)
18import Control.Monad (when)
@@ -60,3 +61,6 @@ checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)
60
61
61chooseInt :: (Int, Int) -> Gen Int
62chooseInt :: (Int, Int) -> Gen Int
62chooseInt = choose
63chooseInt = choose
64+
65+chooseDouble :: (Double, Double) -> Gen Double
66+chooseDouble = choose
test/streamly-tests.cabal+1
@@ -158,6 +158,7 @@ common test-dependencies
158 , filepath >= 1.4.1 && < 1.5
158 , filepath >= 1.4.1 && < 1.5
159 , temporary >= 1.3 && < 1.4
159 , temporary >= 1.3 && < 1.4
160 , network >= 3.1 && < 3.2
160 , network >= 3.1 && < 3.2
161+ , scientific >= 0.0 && < 0.4
161
162
162 if !flag(use-streamly-core)
163 if !flag(use-streamly-core)
163 build-depends: streamly
164 build-depends: streamly