git.iko.soy/elk
on 2297bbf help sign in
elk/tests/Test/Compiler.hs
182 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)
9import Data.Traversable (traverse)
11import System.Directory (createDirectoryIfMissing)
12import System.Environment (lookupEnv)
13import System.FilePath ((</>), (<.>), dropFileName, joinPath, splitDirectories)
14import System.FilePath.Find (find, (==?), extension)
16import Test.Framework
17import Test.Framework.Providers.HUnit (testCase)
18import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
20import qualified Elm.Compiler as Compiler
21import qualified Elm.Package as Package
23writeExpectedJsEnvVarName :: String
24writeExpectedJsEnvVarName =
25 "ELM_WRITE_NEW_EXPECTED"
28compilerTests :: Test
29compilerTests =
30 buildTest $
31 do goods <- testIf isSuccess =<< getElms "good"
32 bads <- testIf isFailure =<< getElms "bad"
33 expectedJsTests <- testMatchesExpected "good" "good-expected-js"
34 return $
35 testGroup "Compile Tests"
36 [ testGroup "Good Tests" goods
37 , testGroup "Bad Tests" bads
38 , testGroup "Expected JS Tests" expectedJsTests
39 ]
42-- GATHER FILES
44getElms :: FilePath -> IO [FilePath]
45getElms filePath =
46 find
47 (return True)
48 (extension ==? ".elm")
49 (testsDir </> filePath)
52testsDir :: FilePath
53testsDir =
54 "tests" </> "test-files"
56convertToExpectedJsFilePath :: String -> FilePath -> FilePath
57convertToExpectedJsFilePath expectedJsDir filePath =
58 testsDir
59 </> expectedJsDir
60 </> joinPath (drop 3 (splitDirectories filePath))
61 <.> ".js"
64-- TEST HELPERS
66compileString :: FilePath -> String -> Either String Compiler.Result
67compileString filePath source =
68 let context =
69 Compiler.Context Package.coreName True False []
70 (dealiaser, _warnings, result) =
71 Compiler.compile context source Map.empty
72 formatErrors errors =
73 concatMap (Compiler.errorToString dealiaser filePath source) errors
74 in
75 either (Left . formatErrors) Right result
78readFileOrErrorStr :: FilePath -> IO String
79readFileOrErrorStr filePath =
80 do strOrExc <- try $ readFile filePath
81 case strOrExc of
82 Right s ->
83 return s
85 Left (e :: IOException) ->
86 return (show e)
89-- RUN TESTS
91testIf
92 :: (Either String Compiler.Result -> Assertion)
93 -> [FilePath]
94 -> IO [Test]
95testIf handleResult filePaths =
96 let doTest filePath =
97 do source <- readFile filePath
98 let formattedResult = compileString filePath source
99 return $ testCase filePath (handleResult formattedResult)
100 in
101 traverse doTest filePaths
104doMatchesExpectedTest :: String -> FilePath -> IO Test
105doMatchesExpectedTest expectedJsDir filePath =
106 do source <- readFile filePath
107 expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
109 let formattedResult = compileString filePath source
110 let assertion = matchesExpected expectedJs formattedResult
112 return $ testCase filePath assertion
115doWriteNewExpectedTest :: String -> FilePath -> IO Test
116doWriteNewExpectedTest expectedJsDir filePath =
117 do source <- readFile filePath
118 let formattedResult = compileString filePath source
119 let expectedFilePath = convertToExpectedJsFilePath expectedJsDir filePath
120 let assertion =
121 case formattedResult of
122 Right (Compiler.Result _ _ js) ->
123 do createDirectoryIfMissing True (dropFileName expectedFilePath)
124 -- Force the evaluation of "js" before "writeFile"
125 -- so that if an error is raised we do not write an empty file.
126 assertBool "Error: no content generated" (length js > 0)
127 writeFile expectedFilePath js
128 assertFailure ("Wrote new expected js: " ++ expectedFilePath)
130 _ ->
131 assertFailure "Compile failed. Could not write new expected js."
132 return $ testCase filePath assertion
135testMatchesExpected :: String -> String -> IO [Test]
136testMatchesExpected elmDir expectedJsDir =
137 do elmFiles <- getElms elmDir
138 envVar <- lookupEnv writeExpectedJsEnvVarName
139 if isJust envVar
140 then
141 traverse (doWriteNewExpectedTest expectedJsDir) elmFiles
142 else
143 traverse (doMatchesExpectedTest expectedJsDir) elmFiles
146-- CHECK RESULTS
148isSuccess :: Either String a -> Assertion
149isSuccess result =
150 case result of
151 Right _ ->
152 assertBool "" True
154 Left errorMessages ->
155 assertFailure errorMessages
158isFailure :: Either a b -> Assertion
159isFailure result =
160 case result of
161 Right _ ->
162 assertFailure "Compilation succeeded but should have failed"
164 Left _ ->
165 assertBool "" True
168matchesExpected :: String -> Either String Compiler.Result -> Assertion
169matchesExpected expectedJs result =
170 case result of
171 Right (Compiler.Result _ _ js) ->
172 assertEqual matchFailureMessage expectedJs js
174 Left errorMessages ->
175 assertFailure $ "Compile failed:\n" ++ errorMessages
178matchFailureMessage :: String
179matchFailureMessage =
180 "Compiled JS did not match expected JS." ++
181 "\n If the change is intentional, rerun " ++
182 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"