Skip to content

Commit

Permalink
Make parse/print test more stringent, tweak Float gen.
Browse files Browse the repository at this point in the history
  • Loading branch information
maxsnew committed Dec 30, 2013
1 parent d003062 commit 37f5d9e
Show file tree
Hide file tree
Showing 2 changed files with 10 additions and 5 deletions.
4 changes: 3 additions & 1 deletion tests/Tests/Property.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
11 changes: 7 additions & 4 deletions tests/Tests/Property/Arbitrary.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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

0 comments on commit 37f5d9e

Please sign in to comment.