b0a856e · elk · git.iko.soy

.gitignore+1

compare with master

unifiedsplit

@@ -10,3 +10,4 @@ cabal-dev

10data

11*/ElmFiles/*

12.DS_Store

13+*~

Elm.cabal+37−2

@@ -228,6 +228,41 @@ Executable elm-doc

228

229Test-Suite test-elm

230 Type: exitcode-stdio-1.0

231− Hs-Source-Dirs: tests

231+ Hs-Source-Dirs: tests, compiler

232 Main-is: Main.hs

233+ other-modules: Tests.Compiler

234+ Tests.Property

235+ Tests.Property.Arbitrary

236+ SourceSyntax.Helpers

237+ SourceSyntax.Literal

238+ SourceSyntax.PrettyPrint

233− build-depends: base, directory, HTF

239+ build-depends: base,

240+ directory,

241+ Elm,

242+ test-framework,

243+ test-framework-hunit,

244+ test-framework-quickcheck2,

245+ HUnit,

246+ pretty,

247+ QuickCheck >= 2 && < 3,

248+ filemanip,

249+ aeson,

250+ base >=4.2 && <5,

251+ binary >= 0.6.4.0,

252+ blaze-html == 0.5.* || == 0.6.*,

253+ blaze-markup == 0.5.1.*,

254+ bytestring,

255+ cmdargs,

256+ containers >= 0.3,

257+ directory,

258+ filepath,

259+ indents,

260+ language-ecmascript >=0.15 && < 1.0,

261+ mtl >= 2,

262+ pandoc >= 1.10,

263+ parsec >= 3.1.1,

264+ pretty,

265+ text,

266+ transformers >= 0.2,

267+ union-find,

268+ unordered-containers

compiler/SourceSyntax/Literal.hs+2−2

@@ -8,7 +8,7 @@ data Literal = IntNum Int

8 | Chr Char

9 | Str String

10 | Boolean Bool

11− deriving (Eq, Ord, Show)

11+ deriving (Eq, Ord, Show)

12

13instance Pretty Literal where

14 pretty literal =

@@ -17,4 +17,4 @@ instance Pretty Literal where

17 FloatNum n -> PP.double n

18 Chr c -> PP.quotes (PP.char c)

19 Str s -> PP.text (show s)

20− Boolean bool -> PP.text (show bool)

20+ Boolean bool -> PP.text (show bool)

compiler/SourceSyntax/Pattern.hs+2−2

@@ -35,7 +35,7 @@ instance Pretty Pattern where

35 PData name ps ->

36 if isTuple name then

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

40prettyParens pattern = parensIf needsThem (pretty pattern)

41 where

@@ -43,4 +43,4 @@ prettyParens pattern = parensIf needsThem (pretty pattern)

43 case pattern of

44 PData name (_:_) | not (isTuple name) -> True

45 PAlias _ _ -> True

46− _ -> False

46+ _ -> False

tests/Main.hs+7−18

@@ -1,22 +1,11 @@

1module Main where

2

3−import System.Directory

4−import System.Exit (exitWith)

5−import System.Environment (getArgs)

6−import Test.Framework.TestManager

7−import Test.Framework.BlackBoxTest

3+import Test.Framework

8

4

9−main :: IO ()

5+import Tests.Compiler

10−main = do

6+import Tests.Property

11− args <- getArgs

12− tests <- blackBoxTests "tests" "dist/build/elm/elm" ".elm" bbtArgs

13− code <- runTestWithArgs args tests

14− removeDirectoryRecursive "cache"

15− removeDirectoryRecursive "build"

16− exitWith code

17−

18−bbtArgs = defaultBBTArgs { bbtArgs_stdoutDiff = ignoreDiff

19− , bbtArgs_stderrDiff = ignoreDiff }

20

7

21−ignoreDiff :: Diff

8+main :: IO ()

22−ignoreDiff _ _ = return Nothing

9+main = defaultMain [ compilerTests

10+ , propertyTests

11+ ]

tests/Tests/Compiler.hsnew file+38

@@ -0,0 +1,38 @@

1+module Tests.Compiler (compilerTests)

2+ where

3+

4+import Data.Functor ((<$>))

5+import Data.Traversable (traverse)

6+import System.FilePath ((</>))

7+import System.FilePath.Find (find, (==?), extension)

8+import Test.Framework

9+import Test.Framework.Providers.HUnit (testCase)

10+import Test.HUnit ((@=?), Assertion)

11+

12+import Elm.Internal.Utils as Elm

13+

14+compilerTests :: Test

15+compilerTests = buildTest $ do

16+ goods <- mkTests True =<< getElms "good"

17+ bads <- mkTests False =<< getElms "bad"

18+ return $ testGroup "Compile Tests"

19+ [

20+ testGroup "Good Tests" goods

21+ , testGroup "Bad Tests" bads

22+ ]

23+

24+ where getElms :: FilePath -> IO [FilePath]

25+ getElms fname = find (return True) (extension ==? ".elm") (testsDir </> fname)

26+

27+ mkTests :: Bool -> [FilePath] -> IO [Test]

28+ mkTests b = traverse setupTest

29+ where setupTest f = testCase f . mkCompileTest b <$> readFile f

30+

31+ testsDir = "tests" </> "data"

32+

33+mkCompileTest :: Bool -- ^ Expect success?

34+ -> String -- ^ File Contents

35+ -> Assertion

36+mkCompileTest succ modul = noCompileErr @=? succ

37+ where noCompileErr = either (const False) (const True) . Elm.compile $ modul

38+ expectation = "Compile " ++ if succ then "Success" else "Error"

tests/Tests/Property.hsnew file+51

@@ -0,0 +1,51 @@

1+module Tests.Property where

2+

3+import Control.Applicative ((<*))

4+import Test.Framework

5+import Test.Framework.Providers.HUnit

6+import Test.Framework.Providers.QuickCheck2

7+import Test.HUnit (assert)

8+import Test.QuickCheck

9+import Text.Parsec.Combinator (eof)

10+

11+import SourceSyntax.Literal as Lit

12+import SourceSyntax.Pattern as Pat

13+import SourceSyntax.PrettyPrint (Pretty, pretty)

14+import Parse.Helpers (IParser, iParse)

15+import Parse.Literal (literal)

16+import Parse.Pattern (expr)

17+import Tests.Property.Arbitrary

18+

19+propertyTests :: Test

20+propertyTests =

21+ testGroup "Parse/Print Agreement Tests"

22+ [

23+ testCase "Long Pattern test" $ assert (prop_parse_print expr longPat)

24+ , testProperty "Literal test" $ prop_parse_print literal

25+ , testProperty "Pattern test" $ prop_parse_print expr

26+ ]

27+

28+ where

29+ -- This test was autogenerated from the Pattern test and should be

30+ -- left in all its ugly glory.

31+ longPat = Pat.PData "I" [ Pat.PLiteral (Lit.Chr '+')

32+ , Pat.PRecord [

33+ "q7yclkcm7k_ikstrczv_"

34+ , "wQRv6gKsvvkjw4b5F"

35+ ,"c9'eFfhk9FTvsMnwF_D"

36+ ,"yqxhEkHvRFwZ"

37+ ,"o"

38+ ,"nbUlCn3y3NnkVoxhW"

39+ ,"iJ0MNy3KZ_lrs"

40+ ,"ug"

41+ ,"sHHsX"

42+ ,"mRKs9d"

43+ ,"o2KiCX5'ZRzHJfRi8" ]

44+ , Pat.PVar "su'BrrbPUK6I33Eq" ]

45+

46+prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool

47+prop_parse_print p x =

48+ either (const False) (== x) . parse_print p $ x

49+

50+parse_print :: (Pretty a) => IParser a -> a -> Either String a

51+parse_print p = either (Left . show) (Right) . iParse (p <* eof) . show . pretty

tests/Tests/Property/Arbitrary.hsnew file+75

@@ -0,0 +1,75 @@

1+{-# OPTIONS_GHC -fno-warn-orphans #-}

2+module Tests.Property.Arbitrary where

3+

4+import Control.Applicative ((<$>), (<*>), pure)

5+import Test.QuickCheck.Arbitrary

6+import Test.QuickCheck.Gen

7+

8+import qualified Data.Set as Set

9+import qualified Parse.Helpers (reserveds)

10+

11+import SourceSyntax.Literal

12+import SourceSyntax.Pattern

13+

14+instance Arbitrary Literal where

15+ arbitrary = oneof [ IntNum <$> arbitrary

16+ , FloatNum <$> (arbitrary `suchThat` noE)

17+ , Chr <$> arbitrary

18+ -- This is too permissive

19+ , Str <$> arbitrary

20+ -- Booleans aren't actually source syntax

21+ -- , Boolean <$> arbitrary

22+ ]

23+ shrink l = case l of

24+ IntNum n -> IntNum <$> shrink n

25+ FloatNum f -> FloatNum <$> (filter noE . shrink $ f)

26+ Chr c -> Chr <$> shrink c

27+ Str s -> Str <$> shrink s

28+ Boolean b -> Boolean <$> shrink b

29+

30+noE :: Double -> Bool

31+noE = notElem 'e' . show

32+

33+

34+instance Arbitrary Pattern where

35+ arbitrary = sized pat

36+ where pat :: Int -> Gen Pattern

37+ pat n = oneof [ pure PAnything

38+ , PVar <$> lowVar

39+ , PRecord <$> (listOf1 lowVar)

40+ , PLiteral <$> arbitrary

41+ , PAlias <$> lowVar <*> pat (n-1)

42+ , PData <$> capVar <*> sizedPats

43+ ]

44+ where sizedPats = do

45+ len <- choose (0,n)

46+ let m = n `div` len in

47+ vectorOf len $ pat m

48+

49+ shrink pat = case pat of

50+ PAnything -> []

51+ PVar v -> PVar <$> shrinkWHead v

52+ PRecord fs -> PRecord <$> (filter (all $ not . null) . filter (not . null) $ shrink fs)

53+ PLiteral l -> PLiteral <$> shrink l

54+ PAlias s p -> p : (PAlias <$> shrinkWHead s <*> shrink p)

55+ PData s ps -> ps ++ (PData <$> shrinkWHead s <*> shrink ps)

56+ where shrinkWHead (x:xs) = (x:) <$> shrink xs

57+

58+lowVar :: Gen String

59+lowVar = notReserved $ (:) <$> lower <*> listOf varLetter

60+ where lower = elements ['a'..'z']

61+

62+capVar :: Gen String

63+capVar = notReserved $ (:) <$> upper <*> listOf varLetter

64+ where upper = elements ['A'..'Z']

65+

66+varLetter :: Gen Char

67+varLetter = elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['\'', '_']

68+

69+notReserved :: Gen String -> Gen String

70+notReserved = flip exceptFor Parse.Helpers.reserveds

71+

72+exceptFor :: (Ord a) => Gen a -> [a] -> Gen a

73+exceptFor g xs = g `suchThat` notAnX

74+ where notAnX = flip Set.notMember xset

75+ xset = Set.fromList xs

tests/bad/BBTArgs → tests/data/bad/BBTArgsrenamed

The content is the same.

tests/bad/InfiniteType.elm → tests/data/bad/InfiniteType.elmrenamed

The content is the same.

tests/bad/NonElementMain.elm → tests/data/bad/NonElementMain.elmrenamed

The content is the same.

tests/good/AliasSubstitution.elm → tests/data/good/AliasSubstitution.elmrenamed

The content is the same.

tests/good/NoExpressions.elm → tests/data/good/NoExpressions.elmrenamed

The content is the same.

tests/good/Otherwise.elm → tests/data/good/Otherwise.elmrenamed

The content is the same.

tests/good/QuotesAndComments.elm → tests/data/good/QuotesAndComments.elmrenamed

The content is the same.

tests/good/Soundness/Apply.elm → tests/data/good/Soundness/Apply.elmrenamed

The content is the same.

tests/good/Soundness/ApplyAnnotated.elm → tests/data/good/Soundness/ApplyAnnotated.elmrenamed

The content is the same.

tests/good/Soundness/Id.elm → tests/data/good/Soundness/Id.elmrenamed

The content is the same.

tests/good/Soundness/IdAnnotated.elm → tests/data/good/Soundness/IdAnnotated.elmrenamed

The content is the same.

tests/good/Soundness/TrickyId.elm → tests/data/good/Soundness/TrickyId.elmrenamed

The content is the same.

tests/good/Soundness/TrickyIdAnnotated.elm → tests/data/good/Soundness/TrickyIdAnnotated.elmrenamed

The content is the same.

tests/good/Unify/LockedVars.elm → tests/data/good/Unify/LockedVars.elmrenamed

The content is the same.

tests/good/Unify/NonHomogeneousRecords.elm → tests/data/good/Unify/NonHomogeneousRecords.elmrenamed

The content is the same.