git.iko.soy/elk
on ac4e451 help sign in
elk/tests/Test/Compiler.hs
179 lines 5.2 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 writeFile expectedFilePath js
125 assertFailure ("Wrote new expected js: " ++ expectedFilePath)
127 _ ->
128 assertFailure "Compile failed. Could not write new expected js."
129 return $ testCase filePath assertion
132testMatchesExpected :: String -> String -> IO [Test]
133testMatchesExpected elmDir expectedJsDir =
134 do elmFiles <- getElms elmDir
135 envVar <- lookupEnv writeExpectedJsEnvVarName
136 if isJust envVar
137 then
138 traverse (doWriteNewExpectedTest expectedJsDir) elmFiles
139 else
140 traverse (doMatchesExpectedTest expectedJsDir) elmFiles
143-- CHECK RESULTS
145isSuccess :: Either String a -> Assertion
146isSuccess result =
147 case result of
148 Right _ ->
149 assertBool "" True
151 Left errorMessages ->
152 assertFailure errorMessages
155isFailure :: Either a b -> Assertion
156isFailure result =
157 case result of
158 Right _ ->
159 assertFailure "Compilation succeeded but should have failed"
161 Left _ ->
162 assertBool "" True
165matchesExpected :: String -> Either String Compiler.Result -> Assertion
166matchesExpected expectedJs result =
167 case result of
168 Right (Compiler.Result _ _ js) ->
169 assertEqual matchFailureMessage expectedJs js
171 Left errorMessages ->
172 assertFailure $ "Compile failed:\n" ++ errorMessages
175matchFailureMessage :: String
176matchFailureMessage =
177 "Compiled JS did not match expected JS." ++
178 "\n If the change is intentional, rerun " ++
179 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"