git.iko.soy/elk
on 8aec074 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)
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
22writeExpectedJsEnvVarName :: String
23writeExpectedJsEnvVarName =
24 "ELM_WRITE_NEW_EXPECTED"
27compilerTests :: Test
28compilerTests =
29 buildTest $
30 do goods <- testIf isSuccess =<< getElms "good"
31 bads <- testIf isFailure =<< getElms "bad"
32 expectedJsTests <- testMatchesExpected "good" "good-expected-js"
33 return $
34 testGroup "Compile Tests"
35 [ testGroup "Good Tests" goods
36 , testGroup "Bad Tests" bads
37 , testGroup "Expected JS Tests" expectedJsTests
38 ]
41-- GATHER FILES
43getElms :: FilePath -> IO [FilePath]
44getElms filePath =
45 find
46 (return True)
47 (extension ==? ".elm")
48 (testsDir </> filePath)
51testsDir :: FilePath
52testsDir =
53 "tests" </> "test-files"
55convertToExpectedJsFilePath :: String -> FilePath -> FilePath
56convertToExpectedJsFilePath expectedJsDir filePath =
57 testsDir
58 </> expectedJsDir
59 </> joinPath (drop 3 (splitDirectories filePath))
60 <.> ".js"
63-- TEST HELPERS
65compileString :: FilePath -> String -> Either String Compiler.Result
66compileString filePath source =
67 let context =
68 Compiler.Context Package.coreName True False []
69 (dealiaser, _warnings, result) =
70 Compiler.compile context source Map.empty
71 formatErrors errors =
72 concatMap (Compiler.errorToString dealiaser filePath source) errors
73 in
74 either (Left . formatErrors) Right result
77readFileOrErrorStr :: FilePath -> IO String
78readFileOrErrorStr filePath =
79 do strOrExc <- try $ readFile filePath
80 case strOrExc of
81 Right s ->
82 return s
84 Left (e :: IOException) ->
85 return (show e)
88-- RUN TESTS
90testIf
91 :: (Either String Compiler.Result -> Assertion)
92 -> [FilePath]
93 -> IO [Test]
94testIf handleResult filePaths =
95 let doTest filePath =
96 do source <- readFile filePath
97 let formattedResult = compileString filePath source
98 return $ testCase filePath (handleResult formattedResult)
99 in
100 traverse doTest filePaths
103doMatchesExpectedTest :: String -> FilePath -> IO Test
104doMatchesExpectedTest expectedJsDir filePath =
105 do source <- readFile filePath
106 expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
108 let formattedResult = compileString filePath source
109 let assertion = matchesExpected expectedJs formattedResult
111 return $ testCase filePath assertion
114doWriteNewExpectedTest :: String -> FilePath -> IO Test
115doWriteNewExpectedTest expectedJsDir filePath =
116 do source <- readFile filePath
117 let formattedResult = compileString filePath source
118 let expectedFilePath = convertToExpectedJsFilePath expectedJsDir filePath
119 let assertion =
120 case formattedResult of
121 Right (Compiler.Result _ _ js) ->
122 do createDirectoryIfMissing True (dropFileName expectedFilePath)
123 -- Force the evaluation of `js` before `writeFile`
124 -- so that if an error is raised we do not unintentionally write an empty file.
125 -- NB: `js` can be an empty string in the case of NoExpressions.elm
126 assertBool "" (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"