git.iko.soy/elk
on bfb4f2d help sign in
elk/tests/Test/Compiler.hs
225 lines 6.5 kB history raw
1{-# OPTIONS_GHC -W #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3module Test.Compiler (compilerTests) where
5import Control.Exception (try, IOException)
7import qualified Data.Text.Lazy as Text
8import qualified Data.Text.Lazy.IO as Text
9import qualified Data.Map as Map
10import Data.Maybe (isJust)
12import System.Directory (createDirectoryIfMissing)
13import System.Environment (lookupEnv)
14import System.FilePath ((</>), (<.>), dropFileName, joinPath, splitDirectories)
15import System.FilePath.Find (find, (==?), extension)
17import Test.Framework
18import Test.Framework.Providers.HUnit (testCase)
19import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
21import qualified Elm.Compiler as Compiler
22import qualified Elm.Package as Package
23import qualified AST.Module as Module
24import qualified AST.Module.Name as ModuleName
25import qualified AST.Variable as Variable
26import qualified AST.Type as Type
29writeExpectedJsEnvVarName :: String
30writeExpectedJsEnvVarName =
31 "ELM_WRITE_NEW_EXPECTED"
34compilerTests :: Test
35compilerTests =
36 buildTest $
37 do goods <- testIf isSuccess =<< getElms "good"
38 bads <- testIf isFailure =<< getElms "bad"
39 expectedJsTests <- testMatchesExpected "good" "good-expected-js"
40 return $
41 testGroup "Compile Tests"
42 [ testGroup "Good Tests" goods
43 , testGroup "Bad Tests" bads
44 , testGroup "Expected JS Tests" expectedJsTests
45 ]
49-- GATHER FILES
52getElms :: FilePath -> IO [FilePath]
53getElms filePath =
54 find
55 (return True)
56 (extension ==? ".elm")
57 (testsDir </> filePath)
60testsDir :: FilePath
61testsDir =
62 "tests" </> "test-files"
64convertToExpectedJsFilePath :: String -> FilePath -> FilePath
65convertToExpectedJsFilePath expectedJsDir filePath =
66 testsDir
67 </> expectedJsDir
68 </> joinPath (drop 3 (splitDirectories filePath))
69 <.> ".js"
73-- TEST HELPERS
76essentialInterfaces :: Module.Interfaces
77essentialInterfaces =
78 Map.fromList
79 [
80 (ModuleName.inCore ["Debug"],
81 buildCoreInterface
82 [
83 ("crash", Type.Lambda (Type.Var "String") (Type.Var "a"))
84 ]
85 )
86 ]
89buildCoreInterface :: [(String, Type.Canonical)] -> Module.Interface
90buildCoreInterface members =
91 let
92 exports = map (Variable.Value . fst) members
93 imports = []
94 types = Map.fromList members
95 adts = Map.empty
96 aliases = Map.empty
97 fixities = []
98 in
99 Module.Interface Compiler.version Package.core exports imports types adts aliases fixities
102compileString :: FilePath -> String -> Either String Compiler.Result
103compileString filePath source =
104 let dependentModuleNames =
105 Map.keys essentialInterfaces
106 context =
107 Compiler.Context Package.core False dependentModuleNames
108 (dealiaser, _warnings, result) =
109 Compiler.compile context source essentialInterfaces
110 formatErrors errors =
111 concatMap (Compiler.errorToString dealiaser filePath source) errors
112 in
113 either (Left . formatErrors) Right result
116readFileOrErrorStr :: FilePath -> IO String
117readFileOrErrorStr filePath =
118 do strOrExc <- try $ readFile filePath
119 case strOrExc of
120 Right s ->
121 return s
123 Left (e :: IOException) ->
124 return (show e)
128-- RUN TESTS
131testIf
132 :: (Either String Compiler.Result -> Assertion)
133 -> [FilePath]
134 -> IO [Test]
135testIf handleResult filePaths =
136 let doTest filePath =
137 do source <- readFile filePath
138 let formattedResult = compileString filePath source
139 return $ testCase filePath (handleResult formattedResult)
140 in
141 traverse doTest filePaths
144doMatchesExpectedTest :: String -> FilePath -> IO Test
145doMatchesExpectedTest expectedJsDir filePath =
146 do source <- readFile filePath
147 expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
149 let formattedResult = compileString filePath source
150 let assertion = matchesExpected expectedJs formattedResult
152 return $ testCase filePath assertion
155doWriteNewExpectedTest :: String -> FilePath -> IO Test
156doWriteNewExpectedTest expectedJsDir filePath =
157 do source <- readFile filePath
158 let formattedResult = compileString filePath source
159 let expectedFilePath = convertToExpectedJsFilePath expectedJsDir filePath
160 let assertion =
161 case formattedResult of
162 Right (Compiler.Result _ _ js) ->
163 do createDirectoryIfMissing True (dropFileName expectedFilePath)
164 -- Force the evaluation of `js` before `writeFile`
165 -- so that if an error is raised we do not unintentionally write an empty file.
166 -- NB: `js` can be an empty string in the case of NoExpressions.elm
167 assertBool "" (Text.length js >= 0)
168 Text.writeFile expectedFilePath js
169 assertFailure ("Wrote new expected js: " ++ expectedFilePath)
171 _ ->
172 assertFailure "Compile failed. Could not write new expected js."
173 return $ testCase filePath assertion
176testMatchesExpected :: String -> String -> IO [Test]
177testMatchesExpected elmDir expectedJsDir =
178 do elmFiles <- getElms elmDir
179 envVar <- lookupEnv writeExpectedJsEnvVarName
180 if isJust envVar
181 then
182 traverse (doWriteNewExpectedTest expectedJsDir) elmFiles
183 else
184 traverse (doMatchesExpectedTest expectedJsDir) elmFiles
188-- CHECK RESULTS
191isSuccess :: Either String a -> Assertion
192isSuccess result =
193 case result of
194 Right _ ->
195 assertBool "" True
197 Left errorMessages ->
198 assertFailure errorMessages
201isFailure :: Either a b -> Assertion
202isFailure result =
203 case result of
204 Right _ ->
205 assertFailure "Compilation succeeded but should have failed"
207 Left _ ->
208 assertBool "" True
211matchesExpected :: String -> Either String Compiler.Result -> Assertion
212matchesExpected expectedJs result =
213 case result of
214 Right (Compiler.Result _ _ js) ->
215 assertEqual matchFailureMessage (Text.pack expectedJs) js
217 Left errorMessages ->
218 assertFailure $ "Compile failed:\n" ++ errorMessages
221matchFailureMessage :: String
222matchFailureMessage =
223 "Compiled JS did not match expected JS." ++
224 "\n If the change is intentional, rerun " ++
225 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"