Make parse/print test more stringent, tweak Float gen.

This commit is contained in:
Max New 2013-12-29 22:11:19 -06:00
parent d003062586
commit 37f5d9e1ea
2 changed files with 10 additions and 5 deletions

View file

@ -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

View file

@ -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