git.iko.soy/elk
on master help sign in
Pattern pretty printer prints syntactically correct code.
d003062Max New
compiler/SourceSyntax/Pattern.hs+2−2
compare with master
unifiedsplit
@@ -35,7 +35,7 @@ instance Pretty Pattern where
35 PData name ps ->
35 PData name ps ->
36 if isTuple name then
36 if isTuple name then
37 PP.parens . commaCat $ map pretty ps
37 PP.parens . commaCat $ map pretty ps
38− else sep (PP.text name : map prettyParens ps)
38+ else hsep (PP.text name : map prettyParens ps)
39
39
40prettyParens pattern = parensIf needsThem (pretty pattern)
40prettyParens pattern = parensIf needsThem (pretty pattern)
41 where
41 where
@@ -43,4 +43,4 @@ prettyParens pattern = parensIf needsThem (pretty pattern)
43 case pattern of
43 case pattern of
44 PData name (_:_) | not (isTuple name) -> True
44 PData name (_:_) | not (isTuple name) -> True
45 PAlias _ _ -> True
45 PAlias _ _ -> True
46− _ -> False
46+ _ -> False
tests/Tests/Property.hs+28−6
@@ -1,24 +1,46 @@
1module Tests.Property where
1module Tests.Property where
2
2
3import Test.Framework
3import Test.Framework
4+import Test.Framework.Providers.HUnit
4import Test.Framework.Providers.QuickCheck2
5import Test.Framework.Providers.QuickCheck2
6+import Test.HUnit (assert)
5import Test.QuickCheck
7import Test.QuickCheck
6
8
7−import SourceSyntax.Literal (Literal)
9+import SourceSyntax.Literal as Lit
10+import SourceSyntax.Pattern as Pat
8−import SourceSyntax.PrettyPrint (Pretty, pretty)
11+import SourceSyntax.PrettyPrint (Pretty, pretty)
9−import Parse.Helpers (IParser, iParse)
12+import Parse.Helpers (IParser, iParse)
10−import Parse.Literal (literal)
13+import Parse.Literal (literal)
11−import Parse.Pattern (expr)
14+import Parse.Pattern (expr)
12import Tests.Property.Arbitrary
15import Tests.Property.Arbitrary
13
16
14propertyTests :: Test
17propertyTests :: Test
15propertyTests =
18propertyTests =
16 testGroup "Parse/Print Agreement Tests"
19 testGroup "Parse/Print Agreement Tests"
17 [
20 [
21+ testCase "Long Pattern test" $ assert (prop_parse_print expr longPat)
18− testProperty "Literal test" $ prop_parse_print literal
22+ , testProperty "Literal test" $ prop_parse_print literal
19 , testProperty "Pattern test" $ prop_parse_print expr
23 , testProperty "Pattern test" $ prop_parse_print expr
20 ]
24 ]
21
25
26+ where
27+ -- This test was autogenerated from the Pattern test and should be
28+ -- left in all its ugly glory.
29+ longPat = Pat.PData "I" [ Pat.PLiteral (Lit.Chr '+')
30+ , Pat.PRecord [
31+ "q7yclkcm7k_ikstrczv_"
32+ , "wQRv6gKsvvkjw4b5F"
33+ ,"c9'eFfhk9FTvsMnwF_D"
34+ ,"yqxhEkHvRFwZ"
35+ ,"o"
36+ ,"nbUlCn3y3NnkVoxhW"
37+ ,"iJ0MNy3KZ_lrs"
38+ ,"ug"
39+ ,"sHHsX"
40+ ,"mRKs9d"
41+ ,"o2KiCX5'ZRzHJfRi8" ]
42+ , Pat.PVar "su'BrrbPUK6I33Eq" ]
43+
22prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool
44prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool
23prop_parse_print p x =
45prop_parse_print p x =
24 either (const False) (== x) . parse_print p $ x
46 either (const False) (== x) . parse_print p $ x