git.iko.soy/elk
on master help sign in
better shrinking and not-infinite-dump generation results in passed tests!
853e63cJohn P Mayer Jr
compiler/SourceSyntax/Type.hs+1−1
compare with master
unifiedsplit
@@ -33,7 +33,7 @@ instance Show Type where
33instance Pretty Type where
33instance Pretty Type where
34 pretty tipe =
34 pretty tipe =
35 case tipe of
35 case tipe of
36− Lambda _ _ -> P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
36+ Lambda _ _ -> P.hsep [ t, P.hsep (map (P.text "->" <+>) ts) ]
37 where
37 where
38 t:ts = map prettyLambda (collectLambdas tipe)
38 t:ts = map prettyLambda (collectLambdas tipe)
39 prettyLambda t = case t of
39 prettyLambda t = case t of
tests/Tests/Property/Arbitrary.hs+19−13
@@ -44,8 +44,8 @@ instance Arbitrary Pattern where
44 ]
44 ]
45 where sizedPats = do
45 where sizedPats = do
46 len <- choose (0,n)
46 len <- choose (0,n)
47− let m = n `div` len in
47+ let m = n `div` (len + 1)
48− vectorOf len $ pat m
48+ vectorOf len $ pat m
49
49
50 shrink pat = case pat of
50 shrink pat = case pat of
51 PAnything -> []
51 PAnything -> []
@@ -64,22 +64,28 @@ instance Arbitrary Type where
64 where tipe :: Int -> Gen Type
64 where tipe :: Int -> Gen Type
65 tipe n = oneof [ Lambda <$> depthTipe <*> depthTipe
65 tipe n = oneof [ Lambda <$> depthTipe <*> depthTipe
66 , Var <$> lowVar
66 , Var <$> lowVar
67− --, Data <$> capVar <*> listOf depthTipe
67+ , Data <$> capVar <*> depthTipes
68+ , Record <$> fields <*> pure Nothing
68− --, Record <$> listOf1 field <*> (Just <$> lowVar)
69+ , Record <$> fields1 <*> (Just <$> lowVar)
69− --, Record <$> listOf field <*> pure Nothing
70 ]
70 ]
71− where depthTipe :: Gen Type
71+ where depthTipe = choose (0,n) >>= tipe
72− depthTipe = do
72+ depthTipes = do
73− m <- choose (0,n)
73+ len <- choose (0,n)
74− tipe m
74+ let m = n `div` (len + 1)
75− field :: Gen (String, Type)
75+ vectorOf len $ tipe m
76+
76 field = (,) <$> lowVar <*> depthTipe
77 field = (,) <$> lowVar <*> depthTipe
77−
78+ fields = do
79+ len <- choose (0,n)
80+ let m = n `div` (len + 1)
81+ vectorOf len $ (,) <$> lowVar <*> tipe m
82+ fields1 = (:) <$> field <*> fields
83+
78 shrink tipe = case tipe of
84 shrink tipe = case tipe of
79 Lambda s t -> s : t : (Lambda <$> shrink s <*> shrink t)
85 Lambda s t -> s : t : (Lambda <$> shrink s <*> shrink t)
80 Var _ -> []
86 Var _ -> []
81− Data n ts -> Data <$> shrinkWHead n <*> shrink ts
87+ Data n ts -> ts ++ (Data <$> shrinkWHead n <*> shrink ts)
82− Record fs t -> case t of
88+ Record fs t -> map snd fs ++ case t of
83 Nothing -> Record <$> shrinkList shrinkField fs <*> pure Nothing
89 Nothing -> Record <$> shrinkList shrinkField fs <*> pure Nothing
84 Just _ ->
90 Just _ ->
85 do
91 do