on master help sign in
Style tweaks and use cross-platform file name construction.
dcac0e0Max New
tests/Tests/Compiler.hs+6−4
@@ -3,6 +3,7 @@ module Tests.Compiler (compilerTests)
3
3
4import Data.Functor ((<$>))
4import Data.Functor ((<$>))
5import Data.Traversable (traverse)
5import Data.Traversable (traverse)
6+import System.FilePath ((</>))
6import System.FilePath.Find (find, (==?), extension)
7import System.FilePath.Find (find, (==?), extension)
7import Test.Framework
8import Test.Framework
8import Test.Framework.Providers.HUnit (testCase)
9import Test.Framework.Providers.HUnit (testCase)
@@ -12,9 +13,8 @@ import Elm.Internal.Utils as Elm
12
13
13compilerTests :: Test
14compilerTests :: Test
14compilerTests = buildTest $ do
15compilerTests = buildTest $ do
15− goods <- getElms "tests/data/good" >>= mkTests True
16+ goods <- mkTests True =<< getElms "good"
16− bads <- getElms "tests/data/bad" >>= mkTests False
17+ bads <- mkTests False =<< getElms "bad"
17−
18 return $ testGroup "Compile Tests"
18 return $ testGroup "Compile Tests"
19 [
19 [
20 testGroup "Good Tests" goods
20 testGroup "Good Tests" goods
@@ -22,12 +22,14 @@ compilerTests = buildTest $ do
22 ]
22 ]
23
23
24 where getElms :: FilePath -> IO [FilePath]
24 where getElms :: FilePath -> IO [FilePath]
25− getElms = find (return True) (extension ==? ".elm")
25+ getElms fname = find (return True) (extension ==? ".elm") (testsDir </> fname)
26
26
27 mkTests :: Bool -> [FilePath] -> IO [Test]
27 mkTests :: Bool -> [FilePath] -> IO [Test]
28 mkTests b = traverse setupTest
28 mkTests b = traverse setupTest
29 where setupTest f = testCase f . mkCompileTest b <$> readFile f
29 where setupTest f = testCase f . mkCompileTest b <$> readFile f
30
30
31+ testsDir = "tests" </> "data"
32+
31mkCompileTest :: Bool -- ^ Expect success?
33mkCompileTest :: Bool -- ^ Expect success?
32 -> String -- ^ File Contents
34 -> String -- ^ File Contents
33 -> Assertion
35 -> Assertion
tests/Tests/Property/Arbitrary.hs+1−1
@@ -49,7 +49,7 @@ instance Arbitrary Pattern where
49 shrink pat = case pat of
49 shrink pat = case pat of
50 PAnything -> []
50 PAnything -> []
51 PVar v -> PVar <$> shrinkWHead v
51 PVar v -> PVar <$> shrinkWHead v
52− PRecord fs -> PRecord <$> (filter (all $ not.null) . filter (not.null) $ shrink fs)
52+ PRecord fs -> PRecord <$> (filter (all $ not . null) . filter (not . null) $ shrink fs)
53 PLiteral l -> PLiteral <$> shrink l
53 PLiteral l -> PLiteral <$> shrink l
54 PAlias s p -> p : (PAlias <$> shrinkWHead s <*> shrink p)
54 PAlias s p -> p : (PAlias <$> shrinkWHead s <*> shrink p)
55 PData s ps -> ps ++ (PData <$> shrinkWHead s <*> shrink ps)
55 PData s ps -> ps ++ (PData <$> shrinkWHead s <*> shrink ps)