diff --git a/test/Streamly/Test/Unicode/Parser.hs b/test/Streamly/Test/Unicode/Parser.hs index 0c44c502..ceb1b1bf 100644 --- a/test/Streamly/Test/Unicode/Parser.hs +++ b/test/Streamly/Test/Unicode/Parser.hs @@ -4,17 +4,81 @@ module Streamly.Test.Unicode.Parser (main) where -import Streamly.Internal.Data.Parser (ParseError (..)) -import Test.Hspec.QuickCheck (prop) -import Test.QuickCheck (Property) -import Test.QuickCheck.Monadic (run, monadicIO, assert) - -import qualified Streamly.Data.Stream as Stream - ( fromList, parse ) -import qualified Streamly.Internal.Data.Stream as Stream (parseBreak, toList) -import qualified Streamly.Unicode.Parser as Unicode -import qualified Test.Hspec as H +import Control.Monad.Identity (Identity(runIdentity)) import Debug.Trace (trace) +import Streamly.Internal.Data.Parser (ParseError (..)) +import Streamly.Test.Common (chooseDouble) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck + (forAll, Property, property) +import Test.QuickCheck.Monadic (monadicIO, assert, run) + +import qualified Data.Scientific as Scientific +import qualified Streamly.Data.Stream as Stream +import qualified Streamly.Internal.Data.Stream as Stream (parseBreak) +import qualified Streamly.Unicode.Parser as Unicode +import qualified Streamly.Internal.Unicode.Parser as Parser +import qualified Test.Hspec as H + +-- Scientific notation +scientificExpFP :: Property +scientificExpFP = + forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls -> + case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of + Right val -> if val == show ls + then property (val == show ls) + else trace + ("Expected = " ++ show ls ++ " Got = " ++ val) + property (val == show ls) + Left _ -> property False + + where + + formatter = Scientific.formatScientific Scientific.Exponent Nothing + toScientific (c, m) = Scientific.scientific c m + parser = formatter . toScientific <$> Parser.number + +-- Standard decimal notation. +scientificFixFP :: Property +scientificFixFP = + forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls -> + case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of + Right val -> if val == show ls + then property (val == show ls) + else trace + ("Expected = " ++ show ls ++ " Got = " ++ val) + property (val == show ls) + Left _ -> property False + + where + + formatter = Scientific.formatScientific Scientific.Fixed Nothing + toScientific (c, m) = Scientific.scientific c m + parser = formatter . toScientific <$> Parser.number + +doubleExpFP :: Property +doubleExpFP = + forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls -> do + let sls = show ls + case runIdentity $ Stream.parse Parser.double (Stream.fromList sls) of + Right val -> if val == ls + then property (val == ls) + else trace + ("Read = "++ show (read sls :: Double) ++ " Expected = " ++ sls ++ " Got = " ++ show val) + property (val == ls) + Left _ -> property False + +-- Standard decimal notation. +doubleFixFP :: Property +doubleFixFP = + forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls -> + case runIdentity $ Stream.parse Parser.double (Stream.fromList (show ls)) of + Right val -> if val == ls + then property (val == ls) + else trace + ("Expected = " ++ show ls ++ " Got = " ++ show val) + property (val == ls) + Left _ -> property False doubleParser :: String -> IO (Either ParseError Double) doubleParser = Stream.parse Unicode.double . Stream.fromList @@ -23,15 +87,19 @@ double :: String -> Double -> Property double s d = monadicIO $ do x <- run $ doubleParser s case x of - Right val -> trace ("parsed " ++ show val) (assert (val == d)) - Left (ParseError _) -> assert (False) + Right val -> if val == d + then assert (val == d) + else trace ("Expectedc = " ++ show d ++ " Got = "++ show val) (assert (val == d)) + Left (ParseError _) -> assert False doubleErr :: String -> String -> Property doubleErr s msg = monadicIO $ do x <- run $ doubleParser s case x of - Right _ -> assert (False) - Left (ParseError err) -> trace err (assert (err == msg)) + Right _ -> assert False + Left (ParseError err) -> if err == msg + then assert (err == msg) + else trace err (assert (err == msg)) remainingStream :: String -> [String] remainingStream x = @@ -118,3 +186,9 @@ main = do prop "afterParse \"..\" \"..\"" $ afterParse ".." ".." prop "afterParse \"+\" \"+\"" $ afterParse "+" "+" prop "afterParse \"++\" \"++\"" $ afterParse "++" "++" + H.describe "Scientific parser property test" $ do + prop "Exponent format" scientificExpFP + prop "Decimal format" scientificFixFP + H.describe "double parser property test" $ do + prop "Exponent format" doubleExpFP + prop "Decimal format" doubleFixFP diff --git a/test/lib/Streamly/Test/Common.hs b/test/lib/Streamly/Test/Common.hs index 114fdca9..b79cec6c 100644 --- a/test/lib/Streamly/Test/Common.hs +++ b/test/lib/Streamly/Test/Common.hs @@ -12,6 +12,7 @@ module Streamly.Test.Common , listEquals , checkListEqual , chooseInt + , chooseDouble ) where import Control.Monad (when) @@ -60,3 +61,6 @@ checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2) chooseInt :: (Int, Int) -> Gen Int chooseInt = choose + +chooseDouble :: (Double, Double) -> Gen Double +chooseDouble = choose diff --git a/test/streamly-tests.cabal b/test/streamly-tests.cabal index 000f0ba6..fe6370ca 100644 --- a/test/streamly-tests.cabal +++ b/test/streamly-tests.cabal @@ -158,6 +158,7 @@ common test-dependencies , filepath >= 1.4.1 && < 1.5 , temporary >= 1.3 && < 1.4 , network >= 3.1 && < 3.2 + , scientific >= 0.0 && < 0.4 if !flag(use-streamly-core) build-depends: streamly