yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Pattern pretty printer prints syntactically correct code.

Browse source 
Include auto-generated test case that was previously broken.
This commit is contained in:
Max New 2013-12-29 20:19:21 -06:00
parent 24751a3d85
commit d003062586
2 changed files with 30 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
compiler/SourceSyntax/Pattern.hs
View file

@ -35,7 +35,7 @@ instance Pretty Pattern where
PData name ps -> PData name ps ->
if isTuple name then if isTuple name then
PP.parens . commaCat $ map pretty ps PP.parens . commaCat $ map pretty ps
else sep (PP.text name : map prettyParens ps) else hsep (PP.text name : map prettyParens ps)
prettyParens pattern = parensIf needsThem (pretty pattern) prettyParens pattern = parensIf needsThem (pretty pattern)
where where
@ -43,4 +43,4 @@ prettyParens pattern = parensIf needsThem (pretty pattern)
case pattern of case pattern of
PData name (_:_) | not (isTuple name) -> True PData name (_:_) | not (isTuple name) -> True
PAlias _ _ -> True PAlias _ _ -> True
_ -> False _ -> False

34
tests/Tests/Property.hs
View file

@ -1,24 +1,46 @@
module Tests.Property where module Tests.Property where
import Test.Framework import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2 import Test.Framework.Providers.QuickCheck2
import Test.HUnit (assert)
import Test.QuickCheck import Test.QuickCheck
import SourceSyntax.Literal (Literal) import SourceSyntax.Literal as Lit
import SourceSyntax.PrettyPrint (Pretty, pretty) import SourceSyntax.Pattern as Pat
import Parse.Helpers (IParser, iParse) import SourceSyntax.PrettyPrint (Pretty, pretty)
import Parse.Literal (literal) import Parse.Helpers (IParser, iParse)
import Parse.Pattern (expr) import Parse.Literal (literal)
import Parse.Pattern (expr)
import Tests.Property.Arbitrary import Tests.Property.Arbitrary
propertyTests :: Test propertyTests :: Test
propertyTests = propertyTests =
testGroup "Parse/Print Agreement Tests" testGroup "Parse/Print Agreement Tests"
[ [
testProperty "Literal test" $ prop_parse_print literal testCase "Long Pattern test" $ assert (prop_parse_print expr longPat)
, testProperty "Literal test" $ prop_parse_print literal
, testProperty "Pattern test" $ prop_parse_print expr , testProperty "Pattern test" $ prop_parse_print expr
] ]
where
-- This test was autogenerated from the Pattern test and should be
-- left in all its ugly glory.
longPat = Pat.PData "I" [ Pat.PLiteral (Lit.Chr '+')
, Pat.PRecord [
"q7yclkcm7k_ikstrczv_"
, "wQRv6gKsvvkjw4b5F"
,"c9'eFfhk9FTvsMnwF_D"
,"yqxhEkHvRFwZ"
,"o"
,"nbUlCn3y3NnkVoxhW"
,"iJ0MNy3KZ_lrs"
,"ug"
,"sHHsX"
,"mRKs9d"
,"o2KiCX5'ZRzHJfRi8" ]
, Pat.PVar "su'BrrbPUK6I33Eq" ]
prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool
prop_parse_print p x = prop_parse_print p x =
either (const False) (== x) . parse_print p $ x either (const False) (== x) . parse_print p $ x