4ad522f · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Run all tests in one go and report all failures

4ad522fHarry Garrood11 years ago

tests/Main.hs+32−19

compare with golang

unifiedsplit

@@ -40,7 +40,7 @@ import qualified Language.PureScript.CodeGen.JS as J

40import qualified Language.PureScript.CoreFn as CF

42import Data.Char (isSpace)

43−import Data.Maybe (mapMaybe)

43+import Data.Maybe (mapMaybe, fromMaybe)

44import Data.List (isSuffixOf, sort, stripPrefix)

45import Data.Traversable (traverse)

46import Data.Time.Clock (UTCTime())

@@ -129,6 +129,8 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do

129 text <- readFile inputFile

130 return (inputFile, text)

131

132+type TestM = WriterT [(FilePath, String)] IO

133+

132compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment)

134compile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO (Either P.MultipleErrors P.Environment)

133compile inputFiles foreigns = runTest $ do

135compile inputFiles foreigns = runTest $ do

134 fs <- liftIO $ readInput inputFiles

136 fs <- liftIO $ readInput inputFiles

@@ -138,17 +140,17 @@ compile inputFiles foreigns = runTest $ do

138assert :: [FilePath] ->

140assert :: [FilePath] ->

139 M.Map P.ModuleName (FilePath, P.ForeignJS) ->

141 M.Map P.ModuleName (FilePath, P.ForeignJS) ->

140 (Either P.MultipleErrors P.Environment -> IO (Maybe String)) ->

142 (Either P.MultipleErrors P.Environment -> IO (Maybe String)) ->

141− IO ()

143+ TestM ()

142assert inputFiles foreigns f = do

144assert inputFiles foreigns f = do

143− e <- compile inputFiles foreigns

145+ e <- liftIO $ compile inputFiles foreigns

144− maybeErr <- f e

146+ maybeErr <- liftIO $ f e

145 case maybeErr of

147 case maybeErr of

146− Just err -> putStrLn err >> exitFailure

148+ Just err -> tell [(last inputFiles, err)]

147 Nothing -> return ()

149 Nothing -> return ()

148

150

149−assertCompiles :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()

151+assertCompiles :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> TestM ()

150assertCompiles inputFiles foreigns = do

152assertCompiles inputFiles foreigns = do

151− putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"

153+ liftIO . putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"

152 assert inputFiles foreigns $ \e ->

154 assert inputFiles foreigns $ \e ->

153 case e of

155 case e of

154 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs

156 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs

@@ -162,24 +164,25 @@ assertCompiles inputFiles foreigns = do

162 Just (ExitFailure _, _, err) -> return $ Just err

164 Just (ExitFailure _, _, err) -> return $ Just err

163 Nothing -> return $ Just "Couldn't find node.js executable"

165 Nothing -> return $ Just "Couldn't find node.js executable"

164

166

165−assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()

167+assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> TestM ()

166assertDoesNotCompile inputFiles foreigns = do

168assertDoesNotCompile inputFiles foreigns = do

167 let testFile = last inputFiles

169 let testFile = last inputFiles

168− putStrLn $ "Assert " ++ testFile ++ " does not compile"

170+ liftIO . putStrLn $ "Assert " ++ testFile ++ " does not compile"

169 shouldFailWith <- getShouldFailWith testFile

171 shouldFailWith <- getShouldFailWith testFile

170 assert inputFiles foreigns $ \e ->

172 assert inputFiles foreigns $ \e ->

171 case e of

173 case e of

172 Left errs -> do

174 Left errs -> do

173 putStrLn (P.prettyPrintMultipleErrors False errs)

175 putStrLn (P.prettyPrintMultipleErrors False errs)

174− if null shouldFailWith

176+ return $ if null shouldFailWith

175− then return Nothing

177+ then Just $ "shouldFailWith declaration is missing"

176− else return $ checkShouldFailWith shouldFailWith errs

178+ else checkShouldFailWith shouldFailWith errs

177 Right _ ->

179 Right _ ->

178 return $ Just "Should not have compiled"

180 return $ Just "Should not have compiled"

179

181

180 where

182 where

181 getShouldFailWith =

183 getShouldFailWith =

182 readFile

184 readFile

185+ >>> liftIO

183 >>> fmap ( lines

186 >>> fmap ( lines

184 >>> mapMaybe (stripPrefix "-- @shouldFailWith ")

187 >>> mapMaybe (stripPrefix "-- @shouldFailWith ")

185 >>> map trim

188 >>> map trim

@@ -214,14 +217,24 @@ main = do

214 Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles

217 Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles

215

218

216 let passing = cwd </> "examples" </> "passing"

219 let passing = cwd </> "examples" </> "passing"

217− passingTestCases <- getDirectoryContents passing

220+ passingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents passing

218− forM_ passingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $

219− assertCompiles (supportPurs ++ [passing </> inputFile]) foreigns

220 let failing = cwd </> "examples" </> "failing"

221 let failing = cwd </> "examples" </> "failing"

221− failingTestCases <- getDirectoryContents failing

222+ failingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents failing

222− forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $

223+

224+ failures <- execWriterT $ do

225+ forM_ passingTestCases $ \inputFile ->

226+ assertCompiles (supportPurs ++ [passing </> inputFile]) foreigns

227+ forM_ failingTestCases $ \inputFile ->

223− assertDoesNotCompile (supportPurs ++ [failing </> inputFile]) foreigns

228+ assertDoesNotCompile (supportPurs ++ [failing </> inputFile]) foreigns

229+

230+ if null failures

224− exitSuccess

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

225

238

226fetchSupportCode :: IO ()

239fetchSupportCode :: IO ()

227fetchSupportCode = do

240fetchSupportCode = do