git.iko.soy/elk
on master help sign in
Get tests compiling again
commit8895172bfef2b042ad403e3d5c92197b80c02a3c authorEvan Czaplicki <info@elm-lang.org> dateTue 27 May 2014, 13:36 (12 years ago) parent975fd28
2 files changed+32−26
compare with master
unifiedsplit
tests/compiler/Tests/Property.hs+18−17 tests/compiler/Tests/Property/Arbitrary.hs+14−9
tests/compiler/Tests/Property.hs+18−17
@@ -11,6 +11,7 @@ import Text.PrettyPrint as P
1111
1212import AST.Literal as Lit
1313import qualified AST.Pattern as P
14+import qualified AST.Variable as V
1415import AST.PrettyPrint (Pretty, pretty)
1516import Parse.Helpers (IParser, iParse)
1617import Parse.Literal (literal)
@@ -21,8 +22,7 @@ import Tests.Property.Arbitrary
2122propertyTests :: Test
2223propertyTests =
2324 testGroup "Parse/Print Agreement Tests"
24− [
25− testCase "Long Pattern test" $ assert (prop_parse_print Pat.expr longPat)
25+ [ testCase "Long Pattern test" $ assert (prop_parse_print Pat.expr longPat)
2626 , testProperty "Literal test" $ prop_parse_print literal
2727 , testProperty "Pattern test" $ prop_parse_print Pat.expr
2828 , testProperty "Type test" $ prop_parse_print Type.expr
@@ -31,21 +31,22 @@ propertyTests =
3131 where
3232 -- This test was autogenerated from the Pattern test and should be
3333 -- left in all its ugly glory.
34− longPat = P.Data "I" [ P.Literal (Lit.Chr '+')
35− , P.Record
36− [ "q7yclkcm7k_ikstrczv_"
37− , "wQRv6gKsvvkjw4b5F"
38− ,"c9'eFfhk9FTvsMnwF_D"
39− ,"yqxhEkHvRFwZ"
40− ,"o"
41− ,"nbUlCn3y3NnkVoxhW"
42− ,"iJ0MNy3KZ_lrs"
43− ,"ug"
44− ,"sHHsX"
45− ,"mRKs9d"
46− ,"o2KiCX5'ZRzHJfRi8" ]
47− , P.Var "su'BrrbPUK6I33Eq"
48− ]
34+ longPat = P.Data (V.Raw "I")
35+ [ P.Literal (Lit.Chr '+')
36+ , P.Record
37+ [ "q7yclkcm7k_ikstrczv_"
38+ , "wQRv6gKsvvkjw4b5F"
39+ ,"c9'eFfhk9FTvsMnwF_D"
40+ ,"yqxhEkHvRFwZ"
41+ ,"o"
42+ ,"nbUlCn3y3NnkVoxhW"
43+ ,"iJ0MNy3KZ_lrs"
44+ ,"ug"
45+ ,"sHHsX"
46+ ,"mRKs9d"
47+ ,"o2KiCX5'ZRzHJfRi8" ]
48+ , P.Var "su'BrrbPUK6I33Eq"
49+ ]
4950
5051prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool
5152prop_parse_print p x =
tests/compiler/Tests/Property/Arbitrary.hs+14−9
@@ -11,6 +11,11 @@ import qualified Parse.Helpers (reserveds)
1111import qualified AST.Literal as L
1212import qualified AST.Pattern as P
1313import qualified AST.Type as T
14+import qualified AST.Variable as V
15+
16+instance Arbitrary V.Raw where
17+ arbitrary = V.Raw <$> arbitrary
18+ shrink (V.Raw v) = V.Raw <$> shrink v
1419
1520instance Arbitrary L.Literal where
1621 arbitrary =
@@ -41,10 +46,10 @@ genVector n generator = do
4146 let m = n `div` (len + 1)
4247 vectorOf len $ generator m
4348
44−instance Arbitrary P.Pattern where
49+instance Arbitrary v => Arbitrary (P.Pattern v) where
4550 arbitrary = sized pat
4651 where
47− pat :: Int -> Gen P.Pattern
52+ pat :: (Arbitrary v) => Int -> Gen (P.Pattern v)
4853 pat n =
4954 oneof
5055 [ pure P.Anything
@@ -52,7 +57,7 @@ instance Arbitrary P.Pattern where
5257 , P.Record <$> (listOf1 lowVar)
5358 , P.Literal <$> arbitrary
5459 , P.Alias <$> lowVar <*> pat (n-1)
55− , P.Data <$> capVar <*> genVector n pat
60+ , P.Data <$> arbitrary <*> genVector n pat
5661 ]
5762
5863 shrink pat =
@@ -61,7 +66,7 @@ instance Arbitrary P.Pattern where
6166 P.Var v -> P.Var <$> shrinkWHead v
6267 P.Literal l -> P.Literal <$> shrink l
6368 P.Alias s p -> p : (P.Alias <$> shrinkWHead s <*> shrink p)
64− P.Data s ps -> ps ++ (P.Data <$> shrinkWHead s <*> shrink ps)
69+ P.Data s ps -> ps ++ (P.Data <$> shrink s <*> shrink ps)
6570 P.Record fs ->
6671 P.Record <$> filter (all notNull) (filter notNull (shrink fs))
6772 where
@@ -71,10 +76,10 @@ shrinkWHead :: Arbitrary a => [a] -> [[a]]
7176shrinkWHead [] = error "Should be nonempty"
7277shrinkWHead (x:xs) = (x:) <$> shrink xs
7378
74−instance Arbitrary T.Type where
79+instance Arbitrary v => Arbitrary (T.Type v) where
7580 arbitrary = sized tipe
7681 where
77− tipe :: Int -> Gen T.Type
82+ tipe :: Arbitrary v => Int -> Gen (T.Type v)
7883 tipe n =
7984 let depthTipe = tipe =<< choose (0,n)
8085 field = (,) <$> lowVar <*> depthTipe
@@ -84,16 +89,16 @@ instance Arbitrary T.Type where
8489 oneof
8590 [ T.Lambda <$> depthTipe <*> depthTipe
8691 , T.Var <$> lowVar
87− , T.Data <$> capVar <*> genVector n tipe
92+ , T.Data <$> arbitrary <*> genVector n tipe
8893 , T.Record <$> fields <*> pure Nothing
89− , T.Record <$> fields1 <*> (Just <$> lowVar)
94+ , T.Record <$> fields1 <*> (Just . T.Var <$> lowVar)
9095 ]
9196
9297 shrink tipe =
9398 case tipe of
9499 T.Lambda s t -> s : t : (T.Lambda <$> shrink s <*> shrink t)
95100 T.Var _ -> []
96− T.Data n ts -> ts ++ (T.Data <$> shrinkWHead n <*> shrink ts)
101+ T.Data n ts -> ts ++ (T.Data <$> shrink n <*> shrink ts)
97102 T.Record fs t -> map snd fs ++ record
98103 where
99104 record =