@@ -1,15 +1,18 @@
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
58import Data.Traversable (traverse)
69
7−import System.FilePath ((</>))
10+import System.FilePath ((</>), joinPath, splitDirectories)
811import System.FilePath.Find (find, (==?), extension)
912
1013import Test.Framework
1114import Test.Framework.Providers.HUnit (testCase)
12−import Test.HUnit (Assertion, assertFailure, assertBool)
15+import Test.HUnit (Assertion, assertFailure, assertBool, assertEqual)
1316
1417import qualified Elm.Compiler as Compiler
1518import qualified Elm.Package as Package
@@ -19,10 +22,12 @@ compilerTests =
1922 buildTest $ do
2023 goods <- testIf isSuccess =<< getElms "good"
2124 bads <- testIf isFailure =<< getElms "bad"
25+ expectedJsTests <- testMatchesExpected "good" "good-expected-js"
2226 return $
2327 testGroup "Compile Tests"
2428 [ testGroup "Good Tests" goods
2529 , testGroup "Bad Tests" bads
30+ , testGroup "Expected JS Tests" expectedJsTests
2631 ]
2732
2833
@@ -43,6 +48,18 @@ testsDir =
4348
4449-- RUN COMPILER
4550
51+compileString :: FilePath -> String -> Either String Compiler.Result
52+compileString filePath source =
53+ let context =
54+ Compiler.Context Package.coreName True False []
55+ (dealiaser, _warnings, result) =
56+ Compiler.compile context source Map.empty
57+ formatErrors errors =
58+ concatMap (Compiler.errorToString dealiaser filePath source) errors
59+ in
60+ either (Left . formatErrors) Right result
61+
62+
4663testIf
4764 :: (Either String Compiler.Result -> Assertion)
4865 -> [FilePath]
@@ -52,19 +69,34 @@ testIf handleResult filePaths =
5269 where
5370 setupTest filePath = do
5471 source <- readFile filePath
55−
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
72+ let formattedResult = compileString filePath source
6473
6574 return $ testCase filePath (handleResult formattedResult)
6675
6776
77+testMatchesExpected :: String -> String -> IO [Test]
78+testMatchesExpected elmDir expectedJsDir =
79+ traverse doTest =<< getElms elmDir
80+ where
81+ readFileOrErrorStr filePath = do
82+ strOrExc <- try $ readFile filePath
83+ case strOrExc of
84+ Right s -> return s
85+ Left (e :: IOException) -> return (show e)
86+
87+ doTest filePath = do
88+ source <- readFile filePath
89+
90+ let expectedFilePath =
91+ testsDir </> expectedJsDir </> joinPath (drop 3 (splitDirectories filePath)) ++ ".js"
92+ expectedJs <- readFileOrErrorStr expectedFilePath
93+
94+ let formattedResult = compileString filePath source
95+ assertion = matchesExpected expectedJs formattedResult
96+
97+ return $ testCase filePath assertion
98+
99+
68100-- CHECK RESULTS
69101
70102isSuccess :: Either String a -> Assertion
@@ -86,3 +118,19 @@ isFailure result =
86118 Left _ ->
87119 assertBool "" True
88120
121+
122+matchesExpected :: String -> Either String Compiler.Result -> Assertion
123+matchesExpected expectedJs result =
124+ case result of
125+ Right (Compiler.Result _ _ js) ->
126+ assertEqual matchFailureMessage expectedJs js
127+
128+ _ ->
129+ assertFailure "compile failed; could not match expected output"
130+
131+
132+matchFailureMessage :: String
133+matchFailureMessage =
134+ "Compiled JS did not match expected JS." ++
135+ "\n If the change is intentional, rerun " ++
136+ "the tests with environment variable: ELM_WRITE_NEW_EXPECTED=1"