@@ -1,32 +1,45 @@
11{-# OPTIONS_GHC -W #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
23module Test.Compiler (compilerTests) where
34
5+import Control.Exception (try, IOException)
6+
47import qualified Data.Map as Map
8+import Data.Maybe (isJust)
59import Data.Traversable (traverse)
610
7−import System.FilePath ((</>))
11+import System.Directory (createDirectoryIfMissing)
12+import System.Environment (lookupEnv)
13+import System.FilePath ((</>), (<.>), dropFileName, joinPath, splitDirectories)
814import System.FilePath.Find (find, (==?), extension)
915
1016import Test.Framework
1117import Test.Framework.Providers.HUnit (testCase)
12−import Test.HUnit (Assertion, assertFailure, assertBool)
18+import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
1319
1420import qualified Elm.Compiler as Compiler
1521import qualified Elm.Package as Package
1622
23+writeExpectedJsEnvVarName :: String
24+writeExpectedJsEnvVarName =
25+ "ELM_WRITE_NEW_EXPECTED"
26+
27+
1728compilerTests :: Test
1829compilerTests =
19− buildTest $ do
20− goods <- testIf isSuccess =<< getElms "good"
21− bads <- testIf isFailure =<< getElms "bad"
22− return $
23− testGroup "Compile Tests"
24− [ testGroup "Good Tests" goods
25− , testGroup "Bad Tests" bads
26− ]
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+ ]
2740
2841
29−-- GATHER ELM FILES
42+-- GATHER FILES
3043
3144getElms :: FilePath -> IO [FilePath]
3245getElms filePath =
@@ -40,29 +53,91 @@ testsDir :: FilePath
4053testsDir =
4154 "tests" </> "test-files"
4255
56+convertToExpectedJsFilePath :: String -> FilePath -> FilePath
57+convertToExpectedJsFilePath expectedJsDir filePath =
58+ testsDir
59+ </> expectedJsDir
60+ </> joinPath (drop 3 (splitDirectories filePath))
61+ <.> ".js"
62+
63+
64+-- TEST HELPERS
65+
66+compileString :: FilePath -> String -> Either String Compiler.Result
67+compileString 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
4376
44−-- RUN COMPILER
77+
78+readFileOrErrorStr :: FilePath -> IO String
79+readFileOrErrorStr filePath =
80+ do strOrExc <- try $ readFile filePath
81+ case strOrExc of
82+ Right s ->
83+ return s
84+
85+ Left (e :: IOException) ->
86+ return (show e)
87+
88+
89+-- RUN TESTS
4590
4691testIf
4792 :: (Either String Compiler.Result -> Assertion)
4893 -> [FilePath]
4994 -> IO [Test]
5095testIf handleResult filePaths =
51− traverse setupTest filePaths
52− where
53− setupTest filePath = do
54− source <- readFile filePath
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
102+
103+
104+doMatchesExpectedTest :: String -> FilePath -> IO Test
105+doMatchesExpectedTest expectedJsDir filePath =
106+ do source <- readFile filePath
107+ expectedJs <- readFileOrErrorStr (convertToExpectedJsFilePath expectedJsDir filePath)
55108
56− let context =
57− Compiler.Context Package.coreName True False []
58− let (dealiaser, _warnings, result) =
59− Compiler.compile context source Map.empty
60− let formatErrors errors =
61− concatMap (Compiler.errorToString dealiaser filePath source) errors
62− let formattedResult =
63− either (Left . formatErrors) Right result
109+ let formattedResult = compileString filePath source
110+ let assertion = matchesExpected expectedJs formattedResult
64111
65− return $ testCase filePath (handleResult formattedResult)
112+ return $ testCase filePath assertion
113+
114+
115+doWriteNewExpectedTest :: String -> FilePath -> IO Test
116+doWriteNewExpectedTest 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)
126+
127+ _ ->
128+ assertFailure "Compile failed. Could not write new expected js."
129+ return $ testCase filePath assertion
130+
131+
132+testMatchesExpected :: String -> String -> IO [Test]
133+testMatchesExpected 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
66141
67142
68143-- CHECK RESULTS
@@ -86,3 +161,19 @@ isFailure result =
86161 Left _ ->
87162 assertBool "" True
88163
164+
165+matchesExpected :: String -> Either String Compiler.Result -> Assertion
166+matchesExpected expectedJs result =
167+ case result of
168+ Right (Compiler.Result _ _ js) ->
169+ assertEqual matchFailureMessage expectedJs js
170+
171+ Left errorMessages ->
172+ assertFailure $ "Compile failed:\n" ++ errorMessages
173+
174+
175+matchFailureMessage :: String
176+matchFailureMessage =
177+ "Compiled JS did not match expected JS." ++
178+ "\n If the change is intentional, rerun " ++
179+ "the tests with environment variable: " ++ writeExpectedJsEnvVarName ++ "=1"