git.iko.soy/elk
on 532cdfc help sign in
elk/tests/Test/Compiler.hs
167 lines 4.8 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 $ do
31 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 = do
79 source <- readFile filePath
80 let formattedResult = compileString filePath source
82 return $ testCase filePath (handleResult formattedResult)
85testMatchesExpected :: String -> String -> IO [Test]
86testMatchesExpected elmDir expectedJsDir = do
87 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 = do
102 strOrExc <- try $ readFile filePath
103 case strOrExc of
104 Right s -> return s
105 Left (e :: IOException) -> return (show e)
107 doTest filePath = do
108 source <- readFile filePath
109 expectedJs <- readFileOrErrorStr (getExpectedFilePath filePath)
111 let formattedResult = compileString filePath source
112 assertion = matchesExpected expectedJs formattedResult
114 return $ testCase filePath assertion
116 writeNewExpected filePath = do
117 source <- readFile filePath
118 let formattedResult = compileString filePath source
119 expectedFilePath = getExpectedFilePath filePath
120 assertion =
121 case formattedResult of
122 Right (Compiler.Result _ _ js) -> do
123 createDirectoryIfMissing True (dropFileName expectedFilePath)
124 writeFile expectedFilePath js
125 assertFailure ("Wrote new expected js: " ++ expectedFilePath)
126 _ ->
127 assertFailure "Compile failed. Could not write new expected js."
128 return $ testCase filePath assertion
131-- CHECK RESULTS
133isSuccess :: Either String a -> Assertion
134isSuccess result =
135 case result of
136 Right _ ->
137 assertBool "" True
139 Left errorMessages ->
140 assertFailure errorMessages
143isFailure :: Either a b -> Assertion
144isFailure result =
145 case result of
146 Right _ ->
147 assertFailure "Compilation succeeded but should have failed"
149 Left _ ->
150 assertBool "" True
153matchesExpected :: String -> Either String Compiler.Result -> Assertion
154matchesExpected expectedJs result =
155 case result of
156 Right (Compiler.Result _ _ js) ->
157 assertEqual matchFailureMessage expectedJs js
159 _ ->
160 assertFailure "Compile failed. There is nothing to match expected output."
163matchFailureMessage :: String
164matchFailureMessage =
165 "Compiled JS did not match expected JS." ++
166 "\n If the change is intentional, rerun " ++
167 "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"