Make parse/print test more stringent, tweak Float gen.
This commit is contained in:
parent
d003062586
commit
37f5d9e1ea
2 changed files with 10 additions and 5 deletions
|
@ -1,10 +1,12 @@
|
|||
module Tests.Property where
|
||||
|
||||
import Control.Applicative ((<*))
|
||||
import Test.Framework
|
||||
import Test.Framework.Providers.HUnit
|
||||
import Test.Framework.Providers.QuickCheck2
|
||||
import Test.HUnit (assert)
|
||||
import Test.QuickCheck
|
||||
import Text.Parsec.Combinator (eof)
|
||||
|
||||
import SourceSyntax.Literal as Lit
|
||||
import SourceSyntax.Pattern as Pat
|
||||
|
@ -46,4 +48,4 @@ prop_parse_print p x =
|
|||
either (const False) (== x) . parse_print p $ x
|
||||
|
||||
parse_print :: (Pretty a) => IParser a -> a -> Either String a
|
||||
parse_print p = either (Left . show) (Right) . iParse p . show . pretty
|
||||
parse_print p = either (Left . show) (Right) . iParse (p <* eof) . show . pretty
|
||||
|
|
|
@ -13,7 +13,7 @@ import SourceSyntax.Pattern
|
|||
|
||||
instance Arbitrary Literal where
|
||||
arbitrary = oneof [ IntNum <$> arbitrary
|
||||
, FloatNum <$> arbitrary
|
||||
, FloatNum <$> (arbitrary `suchThat` noE)
|
||||
, Chr <$> arbitrary
|
||||
-- This is too permissive
|
||||
, Str <$> arbitrary
|
||||
|
@ -22,11 +22,15 @@ instance Arbitrary Literal where
|
|||
]
|
||||
shrink l = case l of
|
||||
IntNum n -> IntNum <$> shrink n
|
||||
FloatNum f -> FloatNum <$> shrink f
|
||||
FloatNum f -> FloatNum <$> (filter noE . shrink $ f)
|
||||
Chr c -> Chr <$> shrink c
|
||||
Str s -> Str <$> shrink s
|
||||
Boolean b -> Boolean <$> shrink b
|
||||
|
||||
noE :: Double -> Bool
|
||||
noE = notElem 'e' . show
|
||||
|
||||
|
||||
instance Arbitrary Pattern where
|
||||
arbitrary = sized pat
|
||||
where pat :: Int -> Gen Pattern
|
||||
|
@ -66,7 +70,6 @@ notReserved :: Gen String -> Gen String
|
|||
notReserved = flip exceptFor Parse.Helpers.reserveds
|
||||
|
||||
exceptFor :: (Ord a) => Gen a -> [a] -> Gen a
|
||||
exceptFor g xs = suchThat g notAnX
|
||||
exceptFor g xs = g `suchThat` notAnX
|
||||
where notAnX = flip Set.notMember xset
|
||||
xset = Set.fromList xs
|
||||
|
||||
|
|
Loading…
Reference in a new issue