git.iko.soy/elk
on 780ee73 help sign in
elk/tests/Test/Compiler.hs
192 lines 5.5 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
24writeExpectedJsEnvVarName :: String
25writeExpectedJsEnvVarName =
26 "ELM_WRITE_NEW_EXPECTED"
29compilerTests :: Test
30compilerTests =
31 buildTest $
32 do goods <- testIf isSuccess =<< getElms "good"
33 bads <- testIf isFailure =<< getElms "bad"
34 expectedJsTests <- testMatchesExpected "good" "good-expected-js"
35 return $
36 testGroup "Compile Tests"
37 [ testGroup "Good Tests" goods
38 , testGroup "Bad Tests" bads
39 , testGroup "Expected JS Tests" expectedJsTests
40 ]
44-- GATHER FILES
47getElms :: FilePath -> IO [FilePath]
48getElms filePath =
49 find
50 (return True)
51 (extension ==? ".elm")
52 (testsDir </> filePath)
55testsDir :: FilePath
56testsDir =
57 "tests" </> "test-files"
59convertToExpectedJsFilePath :: String -> FilePath -> FilePath
60convertToExpectedJsFilePath expectedJsDir filePath =
61 testsDir
62 </> expectedJsDir
63 </> joinPath (drop 3 (splitDirectories filePath))
64 <.> ".js"
68-- TEST HELPERS
71compileString :: FilePath -> String -> Either String Compiler.Result
72compileString filePath source =
73 let context =
74 Compiler.Context Package.coreName True False []
75 (dealiaser, _warnings, result) =
76 Compiler.compile context source Map.empty
77 formatErrors errors =
78 concatMap (Compiler.errorToString dealiaser filePath source) errors
79 in
80 either (Left . formatErrors) Right result
83readFileOrErrorStr :: FilePath -> IO String
84readFileOrErrorStr filePath =
85 do strOrExc <- try $ readFile filePath
86 case strOrExc of
87 Right s ->
88 return s
90 Left (e :: IOException) ->
91 return (show e)
95-- RUN TESTS
98testIf
99 :: (Either String Compiler.Result -> Assertion)
100 -> [FilePath]
101 -> IO [Test]
102testIf handleResult filePaths =
103 let doTest filePath =
104 do source <- readFile filePath
105 let formattedResult = compileString filePath source
106 return $ testCase filePath (handleResult formattedResult)
107 in
108 traverse doTest filePaths
111doMatchesExpectedTest :: String -> FilePath -> IO Test
112doMatchesExpectedTest expectedJsDir filePath =
113 do source <- readFile filePath
114 expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
116 let formattedResult = compileString filePath source
117 let assertion = matchesExpected expectedJs formattedResult
119 return $ testCase filePath assertion
122doWriteNewExpectedTest :: String -> FilePath -> IO Test
123doWriteNewExpectedTest expectedJsDir filePath =
124 do source <- readFile filePath
125 let formattedResult = compileString filePath source
126 let expectedFilePath = convertToExpectedJsFilePath expectedJsDir filePath
127 let assertion =
128 case formattedResult of
129 Right (Compiler.Result _ _ js) ->
130 do createDirectoryIfMissing True (dropFileName expectedFilePath)
131 -- Force the evaluation of `js` before `writeFile`
132 -- so that if an error is raised we do not unintentionally write an empty file.
133 -- NB: `js` can be an empty string in the case of NoExpressions.elm
134 assertBool "" (length js >= 0)
135 writeFile expectedFilePath js
136 assertFailure ("Wrote new expected js: " ++ expectedFilePath)
138 _ ->
139 assertFailure "Compile failed. Could not write new expected js."
140 return $ testCase filePath assertion
143testMatchesExpected :: String -> String -> IO [Test]
144testMatchesExpected elmDir expectedJsDir =
145 do elmFiles <- getElms elmDir
146 envVar <- lookupEnv writeExpectedJsEnvVarName
147 if isJust envVar
148 then
149 traverse (doWriteNewExpectedTest expectedJsDir) elmFiles
150 else
151 traverse (doMatchesExpectedTest expectedJsDir) elmFiles
155-- CHECK RESULTS
158isSuccess :: Either String a -> Assertion
159isSuccess result =
160 case result of
161 Right _ ->
162 assertBool "" True
164 Left errorMessages ->
165 assertFailure errorMessages
168isFailure :: Either a b -> Assertion
169isFailure result =
170 case result of
171 Right _ ->
172 assertFailure "Compilation succeeded but should have failed"
174 Left _ ->
175 assertBool "" True
178matchesExpected :: String -> Either String Compiler.Result -> Assertion
179matchesExpected expectedJs result =
180 case result of
181 Right (Compiler.Result _ _ js) ->
182 assertEqual matchFailureMessage expectedJs js
184 Left errorMessages ->
185 assertFailure $ "Compile failed:\n" ++ errorMessages
188matchFailureMessage :: String
189matchFailureMessage =
190 "Compiled JS did not match expected JS." ++
191 "\n If the change is intentional, rerun " ++
192 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"