@@ -40,7 +40,7 @@ import qualified Language.PureScript.CodeGen.JS as J
4040import qualified Language.PureScript.CoreFn as CF
4141
4242import Data.Char (isSpace)
43−import Data.Maybe (mapMaybe)
43+import Data.Maybe (mapMaybe, fromMaybe)
4444import Data.List (isSuffixOf, sort, stripPrefix)
4545import Data.Traversable (traverse)
4646import Data.Time.Clock (UTCTime())
@@ -129,6 +129,8 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do
129129 text <- readFile inputFile
130130 return (inputFile, text)
131131
132+type TestM = WriterT [(FilePath, String)] IO
133+
132134compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment)
133135compile inputFiles foreigns = runTest $ do
134136 fs <- liftIO $ readInput inputFiles
@@ -138,17 +140,17 @@ compile inputFiles foreigns = runTest $ do
138140assert :: [FilePath] ->
139141 M.Map P.ModuleName (FilePath, P.ForeignJS) ->
140142 (Either P.MultipleErrors P.Environment -> IO (Maybe String)) ->
141− IO ()
143+ TestM ()
142144assert inputFiles foreigns f = do
143− e <- compile inputFiles foreigns
144− maybeErr <- f e
145+ e <- liftIO $ compile inputFiles foreigns
146+ maybeErr <- liftIO $ f e
145147 case maybeErr of
146− Just err -> putStrLn err >> exitFailure
148+ Just err -> tell [(last inputFiles, err)]
147149 Nothing -> return ()
148150
149−assertCompiles :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()
151+assertCompiles :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> TestM ()
150152assertCompiles inputFiles foreigns = do
151− putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"
153+ liftIO . putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"
152154 assert inputFiles foreigns $ \e ->
153155 case e of
154156 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs
@@ -162,24 +164,25 @@ assertCompiles inputFiles foreigns = do
162164 Just (ExitFailure _, _, err) -> return $ Just err
163165 Nothing -> return $ Just "Couldn't find node.js executable"
164166
165−assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()
167+assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> TestM ()
166168assertDoesNotCompile inputFiles foreigns = do
167169 let testFile = last inputFiles
168− putStrLn $ "Assert " ++ testFile ++ " does not compile"
170+ liftIO . putStrLn $ "Assert " ++ testFile ++ " does not compile"
169171 shouldFailWith <- getShouldFailWith testFile
170172 assert inputFiles foreigns $ \e ->
171173 case e of
172174 Left errs -> do
173175 putStrLn (P.prettyPrintMultipleErrors False errs)
174− if null shouldFailWith
175− then return Nothing
176− else return $ checkShouldFailWith shouldFailWith errs
176+ return $ if null shouldFailWith
177+ then Just $ "shouldFailWith declaration is missing"
178+ else checkShouldFailWith shouldFailWith errs
177179 Right _ ->
178180 return $ Just "Should not have compiled"
179181
180182 where
181183 getShouldFailWith =
182184 readFile
185+ >>> liftIO
183186 >>> fmap ( lines
184187 >>> mapMaybe (stripPrefix "-- @shouldFailWith ")
185188 >>> map trim
@@ -214,14 +217,24 @@ main = do
214217 Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles
215218
216219 let passing = cwd </> "examples" </> "passing"
217− passingTestCases <- getDirectoryContents passing
218− forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
219− assertCompiles (supportPurs ++ [passing </> inputFile]) foreigns
220+ passingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents passing
220221 let failing = cwd </> "examples" </> "failing"
221− failingTestCases <- getDirectoryContents failing
222− forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
223− assertDoesNotCompile (supportPurs ++ [failing </> inputFile]) foreigns
224− exitSuccess
222+ failingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents failing
223+
224+ failures <- execWriterT $ do
225+ forM_ passingTestCases $ \inputFile ->
226+ assertCompiles (supportPurs ++ [passing </> inputFile]) foreigns
227+ forM_ failingTestCases $ \inputFile ->
228+ assertDoesNotCompile (supportPurs ++ [failing </> inputFile]) foreigns
229+
230+ if null failures
231+ then exitSuccess
232+ else do
233+ putStrLn "Failures:"
234+ forM_ failures $ \(fp, err) ->
235+ let fp' = fromMaybe fp $ stripPrefix (failing ++ [pathSeparator]) fp
236+ in putStrLn $ fp' ++ ": " ++ err
237+ exitFailure
225238
226239fetchSupportCode :: IO ()
227240fetchSupportCode = do