on bb7eb96 help sign in
elk/tests/Test/Compiler.hs
136 lines 3.7 kB history raw
1{-# OPTIONS_GHC -W #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3module Test.Compiler (compilerTests) where
5import Control.Exception (try, IOException)
7import qualified Data.Map as Map
8import Data.Traversable (traverse)
10import System.FilePath ((</>), joinPath, splitDirectories)
11import System.FilePath.Find (find, (==?), extension)
13import Test.Framework
14import Test.Framework.Providers.HUnit (testCase)
15import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
17import qualified Elm.Compiler as Compiler
18import qualified Elm.Package as Package
20compilerTests :: Test
21compilerTests =
22 buildTest $ do
23 goods <- testIf isSuccess =<< getElms "good"
24 bads <- testIf isFailure =<< getElms "bad"
25 expectedJsTests <- testMatchesExpected "good" "good-expected-js"
26 return $
27 testGroup "Compile Tests"
28 [ testGroup "Good Tests" goods
29 , testGroup "Bad Tests" bads
30 , testGroup "Expected JS Tests" expectedJsTests
31 ]
34-- GATHER ELM FILES
36getElms :: FilePath -> IO [FilePath]
37getElms filePath =
38 find
39 (return True)
40 (extension ==? ".elm")
41 (testsDir </> filePath)
44testsDir :: FilePath
45testsDir =
46 "tests" </> "test-files"
49-- RUN COMPILER
51compileString :: FilePath -> String -> Either String Compiler.Result
52compileString filePath source =
53 let context =
54 Compiler.Context Package.coreName True False []
55 (dealiaser, _warnings, result) =
56 Compiler.compile context source Map.empty
57 formatErrors errors =
58 concatMap (Compiler.errorToString dealiaser filePath source) errors
59 in
60 either (Left . formatErrors) Right result
63testIf
64 :: (Either String Compiler.Result -> Assertion)
65 -> [FilePath]
66 -> IO [Test]
67testIf handleResult filePaths =
68 traverse setupTest filePaths
69 where
70 setupTest filePath = do
71 source <- readFile filePath
72 let formattedResult = compileString filePath source
74 return $ testCase filePath (handleResult formattedResult)
77testMatchesExpected :: String -> String -> IO [Test]
78testMatchesExpected elmDir expectedJsDir =
79 traverse doTest =<< getElms elmDir
80 where
81 readFileOrErrorStr filePath = do
82 strOrExc <- try $ readFile filePath
83 case strOrExc of
84 Right s -> return s
85 Left (e :: IOException) -> return (show e)
87 doTest filePath = do
88 source <- readFile filePath
90 let expectedFilePath =
91 testsDir </> expectedJsDir </> joinPath (drop 3 (splitDirectories filePath)) ++ ".js"
92 expectedJs <- readFileOrErrorStr expectedFilePath
94 let formattedResult = compileString filePath source
95 assertion = matchesExpected expectedJs formattedResult
97 return $ testCase filePath assertion
100-- CHECK RESULTS
102isSuccess :: Either String a -> Assertion
103isSuccess result =
104 case result of
105 Right _ ->
106 assertBool "" True
108 Left errorMessages ->
109 assertFailure errorMessages
112isFailure :: Either a b -> Assertion
113isFailure result =
114 case result of
115 Right _ ->
116 assertFailure "Compilation succeeded but should have failed"
118 Left _ ->
119 assertBool "" True
122matchesExpected :: String -> Either String Compiler.Result -> Assertion
123matchesExpected expectedJs result =
124 case result of
125 Right (Compiler.Result _ _ js) ->
126 assertEqual matchFailureMessage expectedJs js
128 _ ->
129 assertFailure "compile failed; could not match expected output"
132matchFailureMessage :: String
133matchFailureMessage =
134 "Compiled JS did not match expected JS." ++
135 "\n If the change is intentional, rerun " ++
136 "the tests with environment variable: ELM_WRITE_NEW_EXPECTED=1"