git.iko.soy/elk
on cbbbf51 help sign in
elk/tests/Test/Compiler.hs
183 lines 5.6 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.Maybe (isJust)
9import Data.Traversable (traverse)
11import System.Directory (createDirectoryIfMissing)
12import System.Environment (lookupEnv)
13import System.FilePath ((</>), (<.>), dropFileName, joinPath, splitDirectories)
14import System.FilePath.Find (find, (==?), extension)
16import Test.Framework
17import Test.Framework.Providers.HUnit (testCase)
18import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
20import qualified Elm.Compiler as Compiler
21import qualified Elm.Package as Package
23writeExpectedJsEnvVarName :: String
24writeExpectedJsEnvVarName =
25 "ELM_WRITE_NEW_EXPECTED"
28compilerTests :: Test
29compilerTests =
30 buildTest $
31 do goods <- testIf isSuccess =<< getElms "good"
32 bads <- testIf isFailure =<< getElms "bad"
33 expectedJsTests <- testMatchesExpected "good" "good-expected-js"
34 return $
35 testGroup "Compile Tests"
36 [ testGroup "Good Tests" goods
37 , testGroup "Bad Tests" bads
38 , testGroup "Expected JS Tests" expectedJsTests
39 ]
42-- GATHER FILES
44getElms :: FilePath -> IO [FilePath]
45getElms filePath =
46 find
47 (return True)
48 (extension ==? ".elm")
49 (testsDir </> filePath)
52testsDir :: FilePath
53testsDir =
54 "tests" </> "test-files"
56convertToExpectedJsFilePath :: String -> FilePath -> FilePath
57convertToExpectedJsFilePath expectedJsDir filePath =
58 testsDir
59 </> expectedJsDir
60 </> joinPath (drop 3 (splitDirectories filePath))
61 <.> ".js"
64-- TEST HELPERS
66compileString :: FilePath -> String -> Either String Compiler.Result
67compileString filePath source =
68 let context =
69 Compiler.Context Package.coreName True False []
70 (dealiaser, _warnings, result) =
71 Compiler.compile context source Map.empty
72 formatErrors errors =
73 concatMap (Compiler.errorToString dealiaser filePath source) errors
74 in
75 either (Left . formatErrors) Right result
78readFileOrErrorStr :: FilePath -> IO String
79readFileOrErrorStr filePath =
80 do strOrExc <- try $ readFile filePath
81 case strOrExc of
82 Right s ->
83 return s
85 Left (e :: IOException) ->
86 return (show e)
89-- RUN TESTS
91testIf
92 :: (Either String Compiler.Result -> Assertion)
93 -> [FilePath]
94 -> IO [Test]
95testIf handleResult filePaths =
96 let doTest filePath =
97 do source <- readFile filePath
98 let formattedResult = compileString filePath source
99 return $ testCase filePath (handleResult formattedResult)
100 in
101 traverse doTest filePaths
104doMatchesExpectedTest :: String -> FilePath -> IO Test
105doMatchesExpectedTest expectedJsDir filePath =
106 do source <- readFile filePath
107 expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
109 let formattedResult = compileString filePath source
110 let assertion = matchesExpected expectedJs formattedResult
112 return $ testCase filePath assertion
115doWriteNewExpectedTest :: String -> FilePath -> IO Test
116doWriteNewExpectedTest expectedJsDir filePath =
117 do source <- readFile filePath
118 let formattedResult = compileString filePath source
119 let expectedFilePath = convertToExpectedJsFilePath expectedJsDir filePath
120 let assertion =
121 case formattedResult of
122 Right (Compiler.Result _ _ js) ->
123 do createDirectoryIfMissing True (dropFileName expectedFilePath)
124 -- Force the evaluation of `js` before `writeFile`
125 -- so that if an error is raised we do not unintentionally write an empty file.
126 -- NB: `js` can be an empty string in the case of NoExpressions.elm
127 assertBool "" (length js >= 0)
128 writeFile expectedFilePath js
129 assertFailure ("Wrote new expected js: " ++ expectedFilePath)
131 _ ->
132 assertFailure "Compile failed. Could not write new expected js."
133 return $ testCase filePath assertion
136testMatchesExpected :: String -> String -> IO [Test]
137testMatchesExpected elmDir expectedJsDir =
138 do elmFiles <- getElms elmDir
139 envVar <- lookupEnv writeExpectedJsEnvVarName
140 if isJust envVar
141 then
142 traverse (doWriteNewExpectedTest expectedJsDir) elmFiles
143 else
144 traverse (doMatchesExpectedTest expectedJsDir) elmFiles
147-- CHECK RESULTS
149isSuccess :: Either String a -> Assertion
150isSuccess result =
151 case result of
152 Right _ ->
153 assertBool "" True
155 Left errorMessages ->
156 assertFailure errorMessages
159isFailure :: Either a b -> Assertion
160isFailure result =
161 case result of
162 Right _ ->
163 assertFailure "Compilation succeeded but should have failed"
165 Left _ ->
166 assertBool "" True
169matchesExpected :: String -> Either String Compiler.Result -> Assertion
170matchesExpected expectedJs result =
171 case result of
172 Right (Compiler.Result _ _ js) ->
173 assertEqual matchFailureMessage expectedJs js
175 Left errorMessages ->
176 assertFailure $ "Compile failed:\n" ++ errorMessages
179matchFailureMessage :: String
180matchFailureMessage =
181 "Compiled JS did not match expected JS." ++
182 "\n If the change is intentional, rerun " ++
183 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"