git.iko.soy/elk
on master help sign in
Get tests working again
a3f5817Evan Czaplicki
tests/compiler/Tests/Compiler.hs+40−29
compare with master
unifiedsplit
@@ -1,62 +1,73 @@
1{-# OPTIONS_GHC -W #-}
1{-# OPTIONS_GHC -W #-}
2module Tests.Compiler (compilerTests) where
2module Tests.Compiler (compilerTests) where
3
3
4+import qualified Data.Map as Map
4import Data.Traversable (traverse)
5import Data.Traversable (traverse)
5
6
6−import System.Exit
7import System.FilePath ((</>))
7import System.FilePath ((</>))
8import System.FilePath.Find (find, (==?), extension)
8import System.FilePath.Find (find, (==?), extension)
9−import System.Process (readProcessWithExitCode)
10
9
11import Test.Framework
10import Test.Framework
12import Test.Framework.Providers.HUnit (testCase)
11import Test.Framework.Providers.HUnit (testCase)
13import Test.HUnit (Assertion, assertFailure, assertBool)
12import Test.HUnit (Assertion, assertFailure, assertBool)
14
13
14+import qualified Elm.Compiler as Compiler
15+import qualified Elm.Compiler.Module as Module
16+
17+
15compilerTests :: Test
18compilerTests :: Test
16compilerTests =
19compilerTests =
17 buildTest $ do
20 buildTest $ do
18 goods <- testIf isSuccess =<< getElms "good"
21 goods <- testIf isSuccess =<< getElms "good"
19 bads <- testIf isFailure =<< getElms "bad"
22 bads <- testIf isFailure =<< getElms "bad"
23+ return $
20− return $ testGroup "Compile Tests"
24+ testGroup "Compile Tests"
21− [ testGroup "Good Tests" goods
25+ [ testGroup "Good Tests" goods
22− , testGroup "Bad Tests" bads
26+ , testGroup "Bad Tests" bads
23− ]
27+ ]
24
28
25−-- COLLECT FILES
29+
30+-- GATHER ELM FILES
26
31
27getElms :: FilePath -> IO [FilePath]
32getElms :: FilePath -> IO [FilePath]
28getElms filePath =
33getElms filePath =
34+ find
35+ (return True)
36+ (extension ==? ".elm")
29− find (return True) (extension ==? ".elm") (testsDir </> filePath)
37+ (testsDir </> filePath)
38+
30
39
31testsDir :: FilePath
40testsDir :: FilePath
41+testsDir =
32−testsDir = "tests" </> "compiler" </> "test-files"
42+ "tests" </> "compiler" </> "test-files"
33
43
34
44
35-- RUN COMPILER
45-- RUN COMPILER
36
46
37−testIf :: (ExitCode -> String -> Assertion) -> [FilePath] -> IO [Test]
47+testIf
48+ :: (Either String (Module.Interface, String) -> Assertion)
49+ -> [FilePath]
50+ -> IO [Test]
38−testIf handler filePaths =
51+testIf handleResult filePaths =
39 traverse setupTest filePaths
52 traverse setupTest filePaths
40 where
53 where
41− setupTest filePath = do
54+ setupTest filePath =
42− let args = [ "--make", "--src-dir=" ++ testsDir, filePath ]
55+ do source <- readFile filePath
43− (exitCode, stdout, stderr) <- readProcessWithExitCode compiler args ""
56+ let result = Compiler.compile "elm-lang" "core" source Map.empty
44− return (testCase filePath (handler exitCode (stdout ++ stderr)))
57+ return (testCase filePath (handleResult result))
45−
46−compiler :: FilePath
47−compiler = "dist" </> "build" </> "elm" </> "elm"
48
58
49
59
50-- CHECK RESULTS
60-- CHECK RESULTS
51
61
52−isSuccess :: ExitCode -> String -> Assertion
62+isSuccess :: Either String a -> Assertion
53−isSuccess exitCode stderr =
63+isSuccess result =
54− case exitCode of
64+ case result of
55− ExitSuccess -> assertBool "" True
65+ Right _ -> assertBool "" True
56− ExitFailure _ -> assertFailure stderr
66+ Left msg -> assertFailure msg
57−
67+
68+
58−isFailure :: ExitCode -> String -> Assertion
69+isFailure :: Either a b -> Assertion
59−isFailure exitCode _stderr =
70+isFailure result =
60− case exitCode of
71+ case result of
61− ExitSuccess -> assertFailure "Compilation succeeded but should have failed"
72+ Left _ -> assertFailure "Compilation succeeded but should have failed"
62− ExitFailure _ -> assertBool "" True
73+ Right _ -> assertBool "" True