git.iko.soy/elk
on bb35d68 help sign in
elk/tests/Test/Compiler.hs
228 lines 6.6 kB history raw
1{-# OPTIONS_GHC -W #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4module Test.Compiler (compilerTests) where
6import Control.Exception (try, IOException)
8import qualified Data.Text.Lazy as LText
9import qualified Data.Text.Lazy.IO as LText
10import qualified Data.Map as Map
11import Data.Maybe (isJust)
12import qualified Data.Text.IO as Text
13import Data.Text (Text)
15import System.Directory (createDirectoryIfMissing)
16import System.Environment (lookupEnv)
17import System.FilePath ((</>), (<.>), dropFileName, joinPath, splitDirectories)
18import System.FilePath.Find (find, (==?), extension)
20import Test.Framework
21import Test.Framework.Providers.HUnit (testCase)
22import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
24import qualified Elm.Compiler as Compiler
25import qualified Elm.Package as Package
26import qualified AST.Module as Module
27import qualified AST.Module.Name as ModuleName
28import qualified AST.Variable as Variable
29import qualified AST.Type as Type
32writeExpectedJsEnvVarName :: String
33writeExpectedJsEnvVarName =
34 "ELM_WRITE_NEW_EXPECTED"
37compilerTests :: Test
38compilerTests =
39 buildTest $
40 do goods <- testIf isSuccess =<< getElms "good"
41 bads <- testIf isFailure =<< getElms "bad"
42 expectedJsTests <- testMatchesExpected "good" "good-expected-js"
43 return $
44 testGroup "Compile Tests"
45 [ testGroup "Good Tests" goods
46 , testGroup "Bad Tests" bads
47 , testGroup "Expected JS Tests" expectedJsTests
48 ]
52-- GATHER FILES
55getElms :: FilePath -> IO [FilePath]
56getElms filePath =
57 find
58 (return True)
59 (extension ==? ".elm")
60 (testsDir </> filePath)
63testsDir :: FilePath
64testsDir =
65 "tests" </> "test-files"
67convertToExpectedJsFilePath :: String -> FilePath -> FilePath
68convertToExpectedJsFilePath expectedJsDir filePath =
69 testsDir
70 </> expectedJsDir
71 </> joinPath (drop 3 (splitDirectories filePath))
72 <.> ".js"
76-- TEST HELPERS
79essentialInterfaces :: Module.Interfaces
80essentialInterfaces =
81 Map.fromList
82 [
83 (ModuleName.inCore "Debug",
84 buildCoreInterface
85 [
86 ("crash", Type.Lambda (Type.Var "String") (Type.Var "a"))
87 ]
88 )
89 ]
92buildCoreInterface :: [(Text, Type.Canonical)] -> Module.Interface
93buildCoreInterface members =
94 let
95 exports = map (Variable.Value . fst) members
96 imports = []
97 types = Map.fromList members
98 adts = Map.empty
99 aliases = Map.empty
100 fixities = []
101 in
102 Module.Interface Compiler.version Package.core exports imports types adts aliases fixities
105compile :: FilePath -> Text -> Either String Compiler.Result
106compile filePath source =
107 let dependentModuleNames =
108 Map.keys essentialInterfaces
109 context =
110 Compiler.Context Package.core False dependentModuleNames
111 (dealiaser, _warnings, result) =
112 Compiler.compile context source essentialInterfaces
113 formatErrors errors =
114 concatMap (Compiler.errorToString dealiaser filePath source) errors
115 in
116 either (Left . formatErrors) Right result
119readFileOrErrorStr :: FilePath -> IO String
120readFileOrErrorStr filePath =
121 do strOrExc <- try $ readFile filePath
122 case strOrExc of
123 Right s ->
124 return s
126 Left (e :: IOException) ->
127 return (show e)
131-- RUN TESTS
134testIf
135 :: (Either String Compiler.Result -> Assertion)
136 -> [FilePath]
137 -> IO [Test]
138testIf handleResult filePaths =
139 let doTest filePath =
140 do source <- Text.readFile filePath
141 let formattedResult = compile filePath source
142 return $ testCase filePath (handleResult formattedResult)
143 in
144 traverse doTest filePaths
147doMatchesExpectedTest :: String -> FilePath -> IO Test
148doMatchesExpectedTest expectedJsDir filePath =
149 do source <- Text.readFile filePath
150 expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
152 let formattedResult = compile filePath source
153 let assertion = matchesExpected expectedJs formattedResult
155 return $ testCase filePath assertion
158doWriteNewExpectedTest :: String -> FilePath -> IO Test
159doWriteNewExpectedTest expectedJsDir filePath =
160 do source <- Text.readFile filePath
161 let formattedResult = compile filePath source
162 let expectedFilePath = convertToExpectedJsFilePath expectedJsDir filePath
163 let assertion =
164 case formattedResult of
165 Right (Compiler.Result _ _ js) ->
166 do createDirectoryIfMissing True (dropFileName expectedFilePath)
167 -- Force the evaluation of `js` before `writeFile`
168 -- so that if an error is raised we do not unintentionally write an empty file.
169 -- NB: `js` can be an empty string in the case of NoExpressions.elm
170 assertBool "" (LText.length js >= 0)
171 LText.writeFile expectedFilePath js
172 assertFailure ("Wrote new expected js: " ++ expectedFilePath)
174 _ ->
175 assertFailure "Compile failed. Could not write new expected js."
176 return $ testCase filePath assertion
179testMatchesExpected :: String -> String -> IO [Test]
180testMatchesExpected elmDir expectedJsDir =
181 do elmFiles <- getElms elmDir
182 envVar <- lookupEnv writeExpectedJsEnvVarName
183 if isJust envVar
184 then
185 traverse (doWriteNewExpectedTest expectedJsDir) elmFiles
186 else
187 traverse (doMatchesExpectedTest expectedJsDir) elmFiles
191-- CHECK RESULTS
194isSuccess :: Either String a -> Assertion
195isSuccess result =
196 case result of
197 Right _ ->
198 assertBool "" True
200 Left errorMessages ->
201 assertFailure errorMessages
204isFailure :: Either a b -> Assertion
205isFailure result =
206 case result of
207 Right _ ->
208 assertFailure "Compilation succeeded but should have failed"
210 Left _ ->
211 assertBool "" True
214matchesExpected :: String -> Either String Compiler.Result -> Assertion
215matchesExpected expectedJs result =
216 case result of
217 Right (Compiler.Result _ _ js) ->
218 assertEqual matchFailureMessage (LText.pack expectedJs) js
220 Left errorMessages ->
221 assertFailure $ "Compile failed:\n" ++ errorMessages
224matchFailureMessage :: String
225matchFailureMessage =
226 "Compiled JS did not match expected JS." ++
227 "\n If the change is intentional, rerun " ++
228 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"