@@ -1,247 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−module Test.Compiler (compilerTests) where
5−
6−import Control.Exception (try, IOException)
7−
8−import qualified Data.Text.Lazy as LText
9−import qualified Data.Text.Lazy.IO as LText
10−import qualified Data.Map as Map
11−import Data.Maybe (isJust)
12−import qualified Data.Text.IO as Text
13−import Data.Text (Text)
14−
15−import System.Directory (createDirectoryIfMissing)
16−import System.Environment (lookupEnv)
17−import System.FilePath ((</>), (<.>), dropFileName, joinPath, splitDirectories)
18−import System.FilePath.Find (find, (==?), extension)
19−
20−import Test.Framework
21−import Test.Framework.Providers.HUnit (testCase)
22−import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
23−
24−import qualified Elm.Compiler as Compiler
25−import qualified Elm.Package as Package
26−import qualified AST.Module as Module
27−import qualified AST.Module.Name as ModuleName
28−import qualified AST.Variable as Variable
29−import qualified AST.Type as Type
30−
31−
32−
33−-- TESTS
34−
35−
36−writeExpectedJsEnvVarName :: String
37−writeExpectedJsEnvVarName =
38− "ELM_WRITE_NEW_EXPECTED"
39−
40−
41−compilerTests :: Test
42−compilerTests =
43− buildTest $
44− do goods <- testIf isSuccess =<< getElms "good"
45− bads <- testIf isFailure =<< getElms "bad"
46− expectedJsTests <- testMatchesExpected "good" "good-expected-js"
47− return $
48− testGroup "Compile Tests"
49− [ testGroup "Good Tests" goods
50− , testGroup "Bad Tests" bads
51− , testGroup "Expected JS Tests" expectedJsTests
52− ]
53−
54−
55−
56−-- GATHER FILES
57−
58−
59−getElms :: FilePath -> IO [FilePath]
60−getElms filePath =
61− find
62− (return True)
63− (extension ==? ".elm")
64− (testsDir </> filePath)
65−
66−
67−testsDir :: FilePath
68−testsDir =
69− "tests" </> "test-files"
70−
71−
72−convertToExpectedJsFilePath :: String -> FilePath -> FilePath
73−convertToExpectedJsFilePath expectedJsDir filePath =
74− testsDir
75− </> expectedJsDir
76− </> joinPath (drop 3 (splitDirectories filePath))
77− <.> ".js"
78−
79−
80−
81−-- COMPILE HELPERS
82−
83−
84−compile :: FilePath -> Text -> Either String Compiler.Result
85−compile filePath source =
86− let
87− context =
88− Compiler.Context Package.core False importDict interfaces
89−
90− (dealiaser, _warnings, result) =
91− Compiler.compile context source
92−
93− formatErrors errors =
94− concatMap (Compiler.errorToString dealiaser filePath source) errors
95− in
96− either (Left . formatErrors) Right result
97−
98−
99−importDict :: Map.Map ModuleName.Raw ModuleName.Canonical
100−importDict =
101− let
102− toPair name =
103− ( ModuleName._module name, name )
104− in
105− Map.fromList $ map toPair $ Map.keys interfaces
106−
107−
108−interfaces :: Module.Interfaces
109−interfaces =
110− Map.fromList
111− [
112− (ModuleName.inCore "Debug",
113− buildCoreInterface
114− [
115− ("crash", Type.Lambda (Type.Var "String") (Type.Var "a"))
116− ]
117− )
118− ]
119−
120−
121−buildCoreInterface :: [(Text, Type.Canonical)] -> Module.Interface
122−buildCoreInterface members =
123− let
124− exports = map (Variable.Value . fst) members
125− imports = []
126− types = Map.fromList members
127− adts = Map.empty
128− aliases = Map.empty
129− fixities = []
130− in
131− Module.Interface Compiler.version Package.core exports imports types adts aliases fixities
132−
133−
134−
135−-- FILE HELPER
136−
137−
138−readFileOrErrorStr :: FilePath -> IO String
139−readFileOrErrorStr filePath =
140− do strOrExc <- try $ readFile filePath
141− case strOrExc of
142− Right s ->
143− return s
144−
145− Left (e :: IOException) ->
146− return (show e)
147−
148−
149−
150−-- RUN TESTS
151−
152−
153−testIf
154− :: (Either String Compiler.Result -> Assertion)
155− -> [FilePath]
156− -> IO [Test]
157−testIf handleResult filePaths =
158− let doTest filePath =
159− do source <- Text.readFile filePath
160− let formattedResult = compile filePath source
161− return $ testCase filePath (handleResult formattedResult)
162− in
163− traverse doTest filePaths
164−
165−
166−doMatchesExpectedTest :: String -> FilePath -> IO Test
167−doMatchesExpectedTest expectedJsDir filePath =
168− do source <- Text.readFile filePath
169− expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
170−
171− let formattedResult = compile filePath source
172− let assertion = matchesExpected expectedJs formattedResult
173−
174− return $ testCase filePath assertion
175−
176−
177−doWriteNewExpectedTest :: String -> FilePath -> IO Test
178−doWriteNewExpectedTest expectedJsDir filePath =
179− do source <- Text.readFile filePath
180− let formattedResult = compile filePath source
181− let expectedFilePath = convertToExpectedJsFilePath expectedJsDir filePath
182− let assertion =
183− case formattedResult of
184− Right (Compiler.Result _ _ js) ->
185− do createDirectoryIfMissing True (dropFileName expectedFilePath)
186− -- Force the evaluation of `js` before `writeFile`
187− -- so that if an error is raised we do not unintentionally write an empty file.
188− -- NB: `js` can be an empty string in the case of NoExpressions.elm
189− assertBool "" (LText.length js >= 0)
190− LText.writeFile expectedFilePath js
191− assertFailure ("Wrote new expected js: " ++ expectedFilePath)
192−
193− _ ->
194− assertFailure "Compile failed. Could not write new expected js."
195− return $ testCase filePath assertion
196−
197−
198−testMatchesExpected :: String -> String -> IO [Test]
199−testMatchesExpected elmDir expectedJsDir =
200− do elmFiles <- getElms elmDir
201− envVar <- lookupEnv writeExpectedJsEnvVarName
202− if isJust envVar
203− then
204− traverse (doWriteNewExpectedTest expectedJsDir) elmFiles
205− else
206− traverse (doMatchesExpectedTest expectedJsDir) elmFiles
207−
208−
209−
210−-- CHECK RESULTS
211−
212−
213−isSuccess :: Either String a -> Assertion
214−isSuccess result =
215− case result of
216− Right _ ->
217− assertBool "" True
218−
219− Left errorMessages ->
220− assertFailure errorMessages
221−
222−
223−isFailure :: Either a b -> Assertion
224−isFailure result =
225− case result of
226− Right _ ->
227− assertFailure "Compilation succeeded but should have failed"
228−
229− Left _ ->
230− assertBool "" True
231−
232−
233−matchesExpected :: String -> Either String Compiler.Result -> Assertion
234−matchesExpected expectedJs result =
235− case result of
236− Right (Compiler.Result _ _ js) ->
237− assertEqual matchFailureMessage (LText.pack expectedJs) js
238−
239− Left errorMessages ->
240− assertFailure $ "Compile failed:\n" ++ errorMessages
241−
242−
243−matchFailureMessage :: String
244−matchFailureMessage =
245− "Compiled JS did not match expected JS." ++
246− "\n If the change is intentional, rerun " ++
247− "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"