@@ -1,14 +1,11 @@
1module Main where
1module Main where
3import Control.Monad
3import Control.Monad
4+import Data.Char (isLetter)
4import Data.Typeable
5import Data.Typeable
5import Data.Proxy
6import Data.Proxy
6import Data.List
7import Data.List
7−import Data.Map.Strict as Map
8−import Data.IntSet as ISet
9−import Data.IntMap as IMap
8+import qualified Data.IntMap as IMap
10−import qualified Data.ByteString as BS
11−import qualified Data.ByteString.Char8 as BSC
13import System.Directory
10import System.Directory
14import System.Environment
11import System.Environment
@@ -19,7 +16,6 @@ import System.FilePath ((</>))
19import Options.Applicative
16import Options.Applicative
20import Test.Tasty
17import Test.Tasty
21import Test.Tasty.Golden
18import Test.Tasty.Golden
22−import Test.Tasty.Golden.Advanced
23import Test.Tasty.Runners
19import Test.Tasty.Runners
24import Test.Tasty.Options
20import Test.Tasty.Options
25import Test.Tasty.Ingredients.Rerun
21import Test.Tasty.Ingredients.Rerun
@@ -51,7 +47,7 @@ instance IsOption NodeOpt where
51 parseValue = fmap NodeOpt . safeRead
47 parseValue = fmap NodeOpt . safeRead
52 optionName = return nodeArg
48 optionName = return nodeArg
53 optionHelp = return nodeHelp
49 optionHelp = return nodeHelp
54− optionCLParser = fmap NodeOpt $ switch (long nodeArg <> help nodeHelp)
50+ optionCLParser = NodeOpt <$> switch (long nodeArg <> help nodeHelp)
56ingredients :: [Ingredient]
52ingredients :: [Ingredient]
57ingredients = defaultIngredients ++
53ingredients = defaultIngredients ++
@@ -63,43 +59,16 @@ ingredients = defaultIngredients ++
63-- Compare a given file contents against the golden file contents
59-- Compare a given file contents against the golden file contents
64-- A ripoff of goldenVsFile from Tasty.Golden
60-- A ripoff of goldenVsFile from Tasty.Golden
65test :: String -> String -> IO () -> TestTree
61test :: String -> String -> IO () -> TestTree
66−test name path act =
62+test testName path = goldenVsFileDiff testName diff ref output
67− goldenTest name (readFile ref) (act >> readFile new) cmp upd
69− ref = path </> "expected"
64+ ref = path </> "expected"
70− new = path </> "output"
65+ output = path </> "output"
71− cmp x y = return $ if normalize x == normalize y then Nothing
66+ diff ref new = ["diff", "--strip-trailing-cr", "-u", new, ref]
72− else Just $ printDiff (ref, x) (new, y)
74− -- just pretend that backslashes are slashes for comparison
75− -- purposes to avoid path problems, so don't write any tests
76− -- that depend on that distinction in other contexts.
77− -- Also compare CRLF and LF as equal, fixes a weird corner case
78− -- on Mac where basic010 and reg039 produces CRLF
80− normalize ('\r':'\n':xs) = '\n' : normalize xs
81− normalize ('\\':'\\':xs) = '/' : normalize xs
82− normalize ('\\':xs) = '/' : normalize xs
83− normalize (x : xs) = x : normalize xs
86−-- Takes the filepath and content of `expected` and `output`
87−-- and formats an error message stating their difference
88−printDiff :: (String, String) -> (String, String) -> String
89−printDiff (ref, x) (new, y) =
90− let printContent cnt =
91− if Data.List.null cnt
92− then " is empty...\n"
93− else " is: \n" ++ unlines (fmap ((++) " ") (lines cnt))
95− "Test mismatch!\n" ++
96− "Golden file " ++ ref ++ printContent x ++
97− "However, " ++ new ++ printContent y
99-- Should always output a 3-charater string from a postive Int
68-- Should always output a 3-charater string from a postive Int
100indexToString :: Int -> String
69indexToString :: Int -> String
101indexToString index = let str = show index in
70indexToString index = let str = show index in
102− (replicate (3 - length str) '0') ++ str
71+ replicate (3 - length str) '0' ++ str
104-- Turns the collection of TestFamily into actual tests usable by Tasty
73-- Turns the collection of TestFamily into actual tests usable by Tasty
105mkGoldenTests :: [TestFamily] -> Flags -> TestTree
74mkGoldenTests :: [TestFamily] -> Flags -> TestTree
@@ -124,10 +93,15 @@ runTest path flags = do
124 let run = (proc "bash" ("run" : flags)) {cwd = Just path,
93 let run = (proc "bash" ("run" : flags)) {cwd = Just path,
125 std_out = CreatePipe}
94 std_out = CreatePipe}
126 (_, output, _) <- readCreateProcessWithExitCode run ""
95 (_, output, _) <- readCreateProcessWithExitCode run ""
127− writeFile (path </> "output") output
96+ writeFile (path </> "output") (normalise output)
98+ -- Normalise paths e.g. ".\foo.idr" to "./foo.idr".
99+ normalise ('.' : '\\' : c : xs) | isLetter c = '.' : '/' : c : normalise xs
100+ normalise (x : xs) = x : normalise xs
129main :: IO ()
103main :: IO ()
131 defaultMainWithIngredients ingredients $
105 defaultMainWithIngredients ingredients $
132 askOption $ \(NodeOpt node) ->
106 askOption $ \(NodeOpt node) ->
133 let (codegen, flags) = if node then (JS, ["--codegen", "node"])
107 let (codegen, flags) = if node then (JS, ["--codegen", "node"])