git.iko.soy/elk
on master help sign in
added some guards. todo turn this into correct Gen. still one failcase
c616557John P Mayer Jr
tests/Tests/Property.hs+5−3
compare with master
unifiedsplit
@@ -13,16 +13,18 @@ import SourceSyntax.Pattern as Pat
13import SourceSyntax.PrettyPrint (Pretty, pretty)
13import SourceSyntax.PrettyPrint (Pretty, pretty)
14import Parse.Helpers (IParser, iParse)
14import Parse.Helpers (IParser, iParse)
15import Parse.Literal (literal)
15import Parse.Literal (literal)
16−import Parse.Pattern (expr)
16+import qualified Parse.Pattern as Pat (expr)
17+import qualified Parse.Type as Type (expr)
17import Tests.Property.Arbitrary
18import Tests.Property.Arbitrary
18
19
19propertyTests :: Test
20propertyTests :: Test
20propertyTests =
21propertyTests =
21 testGroup "Parse/Print Agreement Tests"
22 testGroup "Parse/Print Agreement Tests"
22 [
23 [
23− testCase "Long Pattern test" $ assert (prop_parse_print expr longPat)
24+ testCase "Long Pattern test" $ assert (prop_parse_print Pat.expr longPat)
24 , testProperty "Literal test" $ prop_parse_print literal
25 , testProperty "Literal test" $ prop_parse_print literal
25− , testProperty "Pattern test" $ prop_parse_print expr
26+ , testProperty "Pattern test" $ prop_parse_print Pat.expr
27+ , testProperty "Type test" $ prop_parse_print Type.expr
26 ]
28 ]
27
29
28 where
30 where
tests/Tests/Property/Arbitrary.hs+18−6
@@ -56,22 +56,31 @@ instance Arbitrary Pattern where
56 PData s ps -> ps ++ (PData <$> shrinkWHead s <*> shrink ps)
56 PData s ps -> ps ++ (PData <$> shrinkWHead s <*> shrink ps)
57 where shrinkWHead (x:xs) = (x:) <$> shrink xs
57 where shrinkWHead (x:xs) = (x:) <$> shrink xs
58
58
59+isValidType :: Type -> Bool
60+isValidType (Lambda s t) = isValidType s && isValidType t
61+isValidType (Record [] (Just _)) = False
62+isValidType (Record (("",_):_) _) = False
63+isValidType (Record fs _) = all isValidType $ map snd fs
64+isValidType (Data _ []) = False
65+isValidType (Data _ ts) = all isValidType ts
66+isValidType _ = True
67+
59instance Arbitrary Type where
68instance Arbitrary Type where
60− arbitrary = sized tipe
69+ arbitrary = sized tipe `suchThat` isValidType
61 where tipe :: Int -> Gen Type
70 where tipe :: Int -> Gen Type
62 tipe n = oneof [ Lambda <$> depthTipe <*> depthTipe
71 tipe n = oneof [ Lambda <$> depthTipe <*> depthTipe
63− , Var <$> arbitrary
72+ , Var <$> lowVar
64− , Data <$> arbitrary <*> listOf1 depthTipe
73+ , Data <$> capVar <*> listOf1 depthTipe
65− , Record <$> listOf ((,) <$> arbitrary <*> depthTipe) <*> arbitrary
74+ , Record <$> listOf ((,) <$> lowVar <*> depthTipe) <*> maybeOf lowVar
66 ]
75 ]
67 where depthTipe :: Gen Type
76 where depthTipe :: Gen Type
68 depthTipe = choose (0,n) >>= tipe
77 depthTipe = choose (0,n) >>= tipe
69
78
70− shrink tipe = case tipe of
79+ shrink tipe = filter isValidType $ case tipe of
71 Lambda s t -> Lambda <$> shrink s <*> shrink t
80 Lambda s t -> Lambda <$> shrink s <*> shrink t
72 Var _ -> []
81 Var _ -> []
73 Data n ts -> Data n <$> shrink ts
82 Data n ts -> Data n <$> shrink ts
74− Record fs t -> Record <$> shrink fs <*> pure t
83+ Record fs t -> Record <$> shrink fs <*> pure t
75
84
76lowVar :: Gen String
85lowVar :: Gen String
77lowVar = notReserved $ (:) <$> lower <*> listOf varLetter
86lowVar = notReserved $ (:) <$> lower <*> listOf varLetter
@@ -84,6 +93,9 @@ capVar = notReserved $ (:) <$> upper <*> listOf varLetter
84varLetter :: Gen Char
93varLetter :: Gen Char
85varLetter = elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['\'', '_']
94varLetter = elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['\'', '_']
86
95
96+maybeOf :: Gen a -> Gen (Maybe a)
97+maybeOf g = oneof [ pure Nothing, Just <$> g ]
98+
87notReserved :: Gen String -> Gen String
99notReserved :: Gen String -> Gen String
88notReserved = flip exceptFor Parse.Helpers.reserveds
100notReserved = flip exceptFor Parse.Helpers.reserveds
89
101