1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00

Add another Scientific generator and test with it.

This commit is contained in:
Patrick Thomson 2019-08-08 13:55:23 -04:00
parent 1dee6ae93c
commit 95b7d5e065
2 changed files with 19 additions and 7 deletions

View File

@ -57,13 +57,14 @@ testTree = testGroup "Data.Scientific.Exts"
, testCase "Pathological input" $ do
isLeft (parseScientific ".") @? "Accepted period"
isLeft (parseScientific "") @? "Accepted empty string"
, testProperty "Scientific roundtripping" $ property $ do
, testProperty "Scientific roundtripping" . property $ do
let nrange = Range.linear (negate 500000) 20000000
drange = Range.exponential 1 100000000
sci <- forAll (Gen.rationalScientific nrange drange)
classify "negative" $ sci < 0
classify "small" $ (sci > 0 && sci <= 1)
classify "medium" $ (sci > 1 && sci <= 10000)
classify "large" $ sci > 10000
tripping sci (pack . show) parseScientific
fromRat <- forAll (Gen.rationalScientific nrange drange)
Gen.classifyScientific fromRat
tripping fromRat (pack . show) parseScientific
, testProperty "Double-based Scientific roundtripping" . property $ do
fromDbl <- forAll (Gen.floatingScientific (Range.linearFrac (negate 1) 3))
Gen.classifyScientific fromDbl
tripping fromDbl (pack . show) parseScientific
]

View File

@ -3,6 +3,8 @@ module Generators
( source
, integerScientific
, rationalScientific
, floatingScientific
, classifyScientific
) where
import Hedgehog
@ -32,3 +34,12 @@ rationalScientific nrange drange = do
Left (sci, _) -> pure sci
Right (sci, _) -> pure sci
floatingScientific :: MonadGen m => Hedgehog.Range Double -> m Scientific
floatingScientific = fmap Scientific.fromFloatDigits . Gen.double
classifyScientific :: MonadTest m => Scientific -> m ()
classifyScientific sci = do
classify "negative" $ sci < 0
classify "small" $ (sci > 0 && sci <= 1)
classify "medium" $ (sci > 1 && sci <= 10000)
classify "large" $ sci > 10000