55a0109 · rowtype-yoga/purescript-native

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

on golang help sign in

Use HSpec for the compiler tests

55a0109Gary Burgess10 years ago

purescript.cabal+1−1

compare with golang

unifiedsplit

@@ -351,7 +351,7 @@ test-suite tests

351 Glob -any, aeson-better-errors -any, bytestring -any, aeson -any,

352 base-compat -any, haskeline >= 0.7.0.0, optparse-applicative -any,

353 boxes -any, HUnit -any, hspec -any, hspec-discover -any, stm -any, text -any,

354− vector -any, utf8-string -any

354+ vector -any, utf8-string -any, silently -any

355 ghc-options: -Wall

356 type: exitcode-stdio-1.0

357 main-is: Main.hs

tests/TestCompiler.hs+61−58

@@ -26,8 +26,8 @@ import Prelude.Compat

26import qualified Language.PureScript as P

28import Data.Char (isSpace)

29−import Data.Maybe (mapMaybe, fromMaybe)

29+import Data.Maybe (mapMaybe)

30−import Data.List (isSuffixOf, sort, stripPrefix)

30+import Data.List (isSuffixOf, sort, stripPrefix, intercalate)

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

33import qualified Data.Map as M

@@ -44,42 +44,55 @@ import System.Process hiding (cwd)

44import System.FilePath

45import System.Directory

46import System.IO.UTF8

47+import System.IO.Silently

47import qualified System.FilePath.Glob as Glob

48import qualified System.FilePath.Glob as Glob

49import TestUtils

50import TestUtils

51+import Test.Hspec

51main :: IO ()

53main :: IO ()

52−main = do

54+main = hspec spec

53− cwd <- getCurrentDirectory

55− let supportDir = cwd </> "tests" </> "support" </> "bower_components"

56+spec :: Spec

56− let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir

57+spec = do

58+ (supportPurs, foreigns, passing, passingTestCases, failing, failingTestCases) <- runIO $ do

59+ cwd <- getCurrentDirectory

58− supportPurs <- supportFiles "purs"

61+ let supportDir = cwd </> "tests" </> "support" </> "bower_components"

59− supportJS <- supportFiles "js"

62+ let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir

61− foreignFiles <- forM supportJS (\f -> (f,) <$> readUTF8File f)

64+ supportPurs <- supportFiles "purs"

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

65+ supportJS <- supportFiles "js"

64− let passing = cwd </> "examples" </> "passing"

67+ foreignFiles <- forM supportJS (\f -> (f,) <$> readUTF8File f)

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

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

66− let failing = cwd </> "examples" </> "failing"

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

69− failures <- execWriterT $ do

70+ let passing = cwd </> "examples" </> "passing"

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

72+

73+ let failing = cwd </> "examples" </> "failing"

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

75+

76+ return (supportPurs, foreigns, passing, passingTestCases, failing, failingTestCases)

77+

78+ context ("Passing examples") $ do

70 forM_ passingTestCases $ \inputFile ->

79 forM_ passingTestCases $ \inputFile ->

80+ it ("'" <> inputFile <> "' should compile and run without error") $ do

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

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

82+

83+ context ("Failing examples") $ do

72− forM_ failingTestCases $ \inputFile ->

84+ forM_ failingTestCases $ \inputFile -> do

85+ expectedFailures <- runIO $ getShouldFailWith (failing </> inputFile)

86+ it ("'" <> inputFile <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $ do

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

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

74−

88+

75− if null failures

89+ where

76− then pure ()

90+

77− else do

91+ getShouldFailWith :: FilePath -> IO [String]

78− putStrLn "Failures:"

92+ getShouldFailWith = fmap extractFailWiths . readUTF8File

79− forM_ failures $ \(fp, err) ->

93+ where

80− let fp' = fromMaybe fp $ stripPrefix (failing ++ [pathSeparator]) fp

94+ extractFailWiths = lines >>> mapMaybe (stripPrefix "-- @shouldFailWith ") >>> map trim

81− in putStrLn $ fp' ++ ": " ++ err

95+ trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse

82− exitFailure

84modulesDir :: FilePath

97modulesDir :: FilePath

85modulesDir = ".test_modules" </> "node_modules"

98modulesDir = ".test_modules" </> "node_modules"

@@ -113,26 +126,27 @@ type TestM = WriterT [(FilePath, String)] IO

113runTest :: P.Make a -> IO (Either P.MultipleErrors a)

126runTest :: P.Make a -> IO (Either P.MultipleErrors a)

114runTest = fmap fst . P.runMake P.defaultOptions

127runTest = fmap fst . P.runMake P.defaultOptions

115

128

129+compile

130+ :: [FilePath]

131+ -> M.Map P.ModuleName FilePath

116−compile :: [FilePath] -> M.Map P.ModuleName FilePath -> IO (Either P.MultipleErrors P.Environment)

132+ -> IO (Either P.MultipleErrors P.Environment)

117−compile inputFiles foreigns = runTest $ do

133+compile inputFiles foreigns = silence $ runTest $ do

118 fs <- liftIO $ readInput inputFiles

134 fs <- liftIO $ readInput inputFiles

119 ms <- P.parseModulesFromFiles id fs

135 ms <- P.parseModulesFromFiles id fs

120 P.make (makeActions foreigns) (map snd ms)

136 P.make (makeActions foreigns) (map snd ms)

121

137

138+assert

122−assert :: [FilePath] ->

139+ :: [FilePath]

123− M.Map P.ModuleName FilePath ->

140+ -> M.Map P.ModuleName FilePath

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

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

125− TestM ()

142+ -> Expectation

126assert inputFiles foreigns f = do

143assert inputFiles foreigns f = do

127− e <- liftIO $ compile inputFiles foreigns

144+ e <- compile inputFiles foreigns

128− maybeErr <- liftIO $ f e

145+ maybeErr <- f e

129− case maybeErr of

146+ maybe (return ()) expectationFailure maybeErr

130− Just err -> tell [(last inputFiles, err)]

131− Nothing -> return ()

132

147

133−assertCompiles :: [FilePath] -> M.Map P.ModuleName FilePath -> TestM ()

148+assertCompiles :: [FilePath] -> M.Map P.ModuleName FilePath -> Expectation

134assertCompiles inputFiles foreigns = do

149assertCompiles inputFiles foreigns = do

135− liftIO . putStrLn $ "Assert " ++ last inputFiles ++ " compiles successfully"

136 assert inputFiles foreigns $ \e ->

150 assert inputFiles foreigns $ \e ->

137 case e of

151 case e of

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

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

@@ -142,19 +156,19 @@ assertCompiles inputFiles foreigns = do

142 writeFile entryPoint "require('Main').main()"

156 writeFile entryPoint "require('Main').main()"

143 result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process

157 result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process

144 case result of

158 case result of

145− Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing

159+ Just (ExitSuccess, _, _) -> return Nothing

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

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

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

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

148

162

163+assertDoesNotCompile

164+ :: [FilePath]

149−assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName FilePath -> TestM ()

165+ -> M.Map P.ModuleName FilePath

166+ -> [String]

167+ -> Expectation

150−assertDoesNotCompile inputFiles foreigns = do

168+assertDoesNotCompile inputFiles foreigns shouldFailWith = do

151− let testFile = last inputFiles

152− liftIO . putStrLn $ "Assert " ++ testFile ++ " does not compile"

153− shouldFailWith <- getShouldFailWith testFile

154 assert inputFiles foreigns $ \e ->

169 assert inputFiles foreigns $ \e ->

155 case e of

170 case e of

156 Left errs -> do

171 Left errs -> do

157− putStrLn (P.prettyPrintMultipleErrors False errs)

158 return $ if null shouldFailWith

172 return $ if null shouldFailWith

159 then Just $ "shouldFailWith declaration is missing (errors were: "

173 then Just $ "shouldFailWith declaration is missing (errors were: "

160 ++ show (map P.errorCode (P.runMultipleErrors errs))

174 ++ show (map P.errorCode (P.runMultipleErrors errs))

@@ -164,19 +178,8 @@ assertDoesNotCompile inputFiles foreigns = do

164 return $ Just "Should not have compiled"

178 return $ Just "Should not have compiled"

165

179

166 where

180 where

167− getShouldFailWith =

168− readUTF8File

169− >>> liftIO

170− >>> fmap ( lines

171− >>> mapMaybe (stripPrefix "-- @shouldFailWith ")

172− >>> map trim

173− )

174−

175 checkShouldFailWith expected errs =

181 checkShouldFailWith expected errs =

176 let actual = map P.errorCode $ P.runMultipleErrors errs

182 let actual = map P.errorCode $ P.runMultipleErrors errs

177 in if sort expected == sort actual

183 in if sort expected == sort actual

178 then Nothing

184 then Nothing

179 else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual

185 else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual

180−

181− trim =

182− dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse