git.iko.soy/elk
on 0ff8a91 help sign in
elk/tests/Test/Compiler.hs
223 lines 6.4 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)
10import System.Directory (createDirectoryIfMissing)
11import System.Environment (lookupEnv)
12import System.FilePath ((</>), (<.>), dropFileName, joinPath, splitDirectories)
13import System.FilePath.Find (find, (==?), extension)
15import Test.Framework
16import Test.Framework.Providers.HUnit (testCase)
17import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
19import qualified Elm.Compiler as Compiler
20import qualified Elm.Package as Package
21import qualified AST.Module as Module
22import qualified AST.Module.Name as ModuleName
23import qualified AST.Variable as Variable
24import qualified AST.Type as Type
27writeExpectedJsEnvVarName :: String
28writeExpectedJsEnvVarName =
29 "ELM_WRITE_NEW_EXPECTED"
32compilerTests :: Test
33compilerTests =
34 buildTest $
35 do goods <- testIf isSuccess =<< getElms "good"
36 bads <- testIf isFailure =<< getElms "bad"
37 expectedJsTests <- testMatchesExpected "good" "good-expected-js"
38 return $
39 testGroup "Compile Tests"
40 [ testGroup "Good Tests" goods
41 , testGroup "Bad Tests" bads
42 , testGroup "Expected JS Tests" expectedJsTests
43 ]
47-- GATHER FILES
50getElms :: FilePath -> IO [FilePath]
51getElms filePath =
52 find
53 (return True)
54 (extension ==? ".elm")
55 (testsDir </> filePath)
58testsDir :: FilePath
59testsDir =
60 "tests" </> "test-files"
62convertToExpectedJsFilePath :: String -> FilePath -> FilePath
63convertToExpectedJsFilePath expectedJsDir filePath =
64 testsDir
65 </> expectedJsDir
66 </> joinPath (drop 3 (splitDirectories filePath))
67 <.> ".js"
71-- TEST HELPERS
74essentialInterfaces :: Module.Interfaces
75essentialInterfaces =
76 Map.fromList
77 [
78 (ModuleName.inCore ["Debug"],
79 buildCoreInterface
80 [
81 ("crash", Type.Lambda (Type.Var "String") (Type.Var "a"))
82 ]
83 )
84 ]
87buildCoreInterface :: [(String, Type.Canonical)] -> Module.Interface
88buildCoreInterface members =
89 let
90 exports = map (Variable.Value . fst) members
91 imports = []
92 types = Map.fromList members
93 adts = Map.empty
94 aliases = Map.empty
95 fixities = []
96 in
97 Module.Interface Compiler.version Package.coreName exports types imports adts aliases fixities
100compileString :: FilePath -> String -> Either String Compiler.Result
101compileString filePath source =
102 let dependentModuleNames =
103 Map.keys essentialInterfaces
104 context =
105 Compiler.Context Package.coreName False dependentModuleNames
106 (dealiaser, _warnings, result) =
107 Compiler.compile context source essentialInterfaces
108 formatErrors errors =
109 concatMap (Compiler.errorToString dealiaser filePath source) errors
110 in
111 either (Left . formatErrors) Right result
114readFileOrErrorStr :: FilePath -> IO String
115readFileOrErrorStr filePath =
116 do strOrExc <- try $ readFile filePath
117 case strOrExc of
118 Right s ->
119 return s
121 Left (e :: IOException) ->
122 return (show e)
126-- RUN TESTS
129testIf
130 :: (Either String Compiler.Result -> Assertion)
131 -> [FilePath]
132 -> IO [Test]
133testIf handleResult filePaths =
134 let doTest filePath =
135 do source <- readFile filePath
136 let formattedResult = compileString filePath source
137 return $ testCase filePath (handleResult formattedResult)
138 in
139 traverse doTest filePaths
142doMatchesExpectedTest :: String -> FilePath -> IO Test
143doMatchesExpectedTest expectedJsDir filePath =
144 do source <- readFile filePath
145 expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
147 let formattedResult = compileString filePath source
148 let assertion = matchesExpected expectedJs formattedResult
150 return $ testCase filePath assertion
153doWriteNewExpectedTest :: String -> FilePath -> IO Test
154doWriteNewExpectedTest expectedJsDir filePath =
155 do source <- readFile filePath
156 let formattedResult = compileString filePath source
157 let expectedFilePath = convertToExpectedJsFilePath expectedJsDir filePath
158 let assertion =
159 case formattedResult of
160 Right (Compiler.Result _ _ js) ->
161 do createDirectoryIfMissing True (dropFileName expectedFilePath)
162 -- Force the evaluation of `js` before `writeFile`
163 -- so that if an error is raised we do not unintentionally write an empty file.
164 -- NB: `js` can be an empty string in the case of NoExpressions.elm
165 assertBool "" (length js >= 0)
166 writeFile expectedFilePath js
167 assertFailure ("Wrote new expected js: " ++ expectedFilePath)
169 _ ->
170 assertFailure "Compile failed. Could not write new expected js."
171 return $ testCase filePath assertion
174testMatchesExpected :: String -> String -> IO [Test]
175testMatchesExpected elmDir expectedJsDir =
176 do elmFiles <- getElms elmDir
177 envVar <- lookupEnv writeExpectedJsEnvVarName
178 if isJust envVar
179 then
180 traverse (doWriteNewExpectedTest expectedJsDir) elmFiles
181 else
182 traverse (doMatchesExpectedTest expectedJsDir) elmFiles
186-- CHECK RESULTS
189isSuccess :: Either String a -> Assertion
190isSuccess result =
191 case result of
192 Right _ ->
193 assertBool "" True
195 Left errorMessages ->
196 assertFailure errorMessages
199isFailure :: Either a b -> Assertion
200isFailure result =
201 case result of
202 Right _ ->
203 assertFailure "Compilation succeeded but should have failed"
205 Left _ ->
206 assertBool "" True
209matchesExpected :: String -> Either String Compiler.Result -> Assertion
210matchesExpected expectedJs result =
211 case result of
212 Right (Compiler.Result _ _ js) ->
213 assertEqual matchFailureMessage expectedJs js
215 Left errorMessages ->
216 assertFailure $ "Compile failed:\n" ++ errorMessages
219matchFailureMessage :: String
220matchFailureMessage =
221 "Compiled JS did not match expected JS." ++
222 "\n If the change is intentional, rerun " ++
223 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"