git.iko.soy/elk
on c6d490e help sign in
elk/tests/Test/Compiler.hs
171 lines 4.9 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 ELM 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"
57-- RUN COMPILER
59compileString :: FilePath -> String -> Either String Compiler.Result
60compileString filePath source =
61 let context =
62 Compiler.Context Package.coreName True False []
63 (dealiaser, _warnings, result) =
64 Compiler.compile context source Map.empty
65 formatErrors errors =
66 concatMap (Compiler.errorToString dealiaser filePath source) errors
67 in
68 either (Left . formatErrors) Right result
71testIf
72 :: (Either String Compiler.Result -> Assertion)
73 -> [FilePath]
74 -> IO [Test]
75testIf handleResult filePaths =
76 traverse setupTest filePaths
77 where
78 setupTest filePath =
79 do source <- readFile filePath
80 let formattedResult = compileString filePath source
82 return $ testCase filePath (handleResult formattedResult)
85testMatchesExpected :: String -> String -> IO [Test]
86testMatchesExpected elmDir expectedJsDir =
87 do elmFiles <- getElms elmDir
88 envVar <- lookupEnv writeExpectedJsEnvVarName
89 if isJust envVar
90 then
91 traverse writeNewExpected elmFiles
92 else
93 traverse doTest elmFiles
94 where
95 getExpectedFilePath filePath =
96 testsDir
97 </> expectedJsDir
98 </> joinPath (drop 3 (splitDirectories filePath))
99 <.> ".js"
101 readFileOrErrorStr filePath =
102 do strOrExc <- try $ readFile filePath
103 case strOrExc of
104 Right s ->
105 return s
107 Left (e :: IOException) ->
108 return (show e)
110 doTest filePath =
111 do source <- readFile filePath
112 expectedJs <- readFileOrErrorStr (getExpectedFilePath filePath)
114 let formattedResult = compileString filePath source
115 let assertion = matchesExpected expectedJs formattedResult
117 return $ testCase filePath assertion
119 writeNewExpected filePath =
120 do source <- readFile filePath
121 let formattedResult = compileString filePath source
122 let expectedFilePath = getExpectedFilePath filePath
123 let assertion =
124 case formattedResult of
125 Right (Compiler.Result _ _ js) ->
126 do createDirectoryIfMissing True (dropFileName expectedFilePath)
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
135-- CHECK RESULTS
137isSuccess :: Either String a -> Assertion
138isSuccess result =
139 case result of
140 Right _ ->
141 assertBool "" True
143 Left errorMessages ->
144 assertFailure errorMessages
147isFailure :: Either a b -> Assertion
148isFailure result =
149 case result of
150 Right _ ->
151 assertFailure "Compilation succeeded but should have failed"
153 Left _ ->
154 assertBool "" True
157matchesExpected :: String -> Either String Compiler.Result -> Assertion
158matchesExpected expectedJs result =
159 case result of
160 Right (Compiler.Result _ _ js) ->
161 assertEqual matchFailureMessage expectedJs js
163 Left errorMessages ->
164 assertFailure $ "Compile failed:\n" ++ errorMessages
167matchFailureMessage :: String
168matchFailureMessage =
169 "Compiled JS did not match expected JS." ++
170 "\n If the change is intentional, rerun " ++
171 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"