f7114e3 · rowtype-yoga/purescript-native

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

on golang help sign in

Speed up tests (#2110)

f7114e3Phil Freeman10 years ago

psci/PSCi.hs+9−7

compare with golang

unifiedsplit

@@ -13,7 +13,7 @@ import Prelude ()

13import Prelude.Compat

15import Data.Foldable (traverse_)

16−import Data.List (intercalate, nub, sort, find)

16+import Data.List (intercalate, nub, sort, find, foldl')

17import Data.Tuple (swap)

18import qualified Data.Map as M

@@ -127,13 +127,15 @@ makeIO f io = do

127 either (throwError . P.singleError . f) return e

128

129make :: PSCiState -> [P.Module] -> P.Make P.Environment

130+make st@PSCiState{..} ms = do

130−make st@PSCiState{..} ms = P.make actions' (map snd loadedModules ++ ms)

131+ externs <- P.make actions' (map snd loadedModules ++ ms)

132+ return $ foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment externs

131 where

133 where

132− filePathMap = M.fromList $ (first P.getModuleName . swap) `map` allModules

134+ filePathMap = M.fromList $ (first P.getModuleName . swap) `map` allModules

133− actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False

135+ actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False

134− actions' = actions { P.progress = const (return ()) }

136+ actions' = actions { P.progress = const (return ()) }

135− loadedModules = psciLoadedModules st

137+ loadedModules = psciLoadedModules st

136− allModules = map (first Right) loadedModules ++ map (Left P.RebuildAlways,) ms

138+ allModules = map (first Right) loadedModules ++ map (Left P.RebuildAlways,) ms

137

139

138

140

139-- Commands

141-- Commands

src/Language/PureScript.hs+1

@@ -16,6 +16,7 @@ import Language.PureScript.Comments as P

16import Language.PureScript.Crash as P

17import Language.PureScript.Environment as P

18import Language.PureScript.Errors as P hiding (indent)

19+import Language.PureScript.Externs as P

19import Language.PureScript.Kinds as P

20import Language.PureScript.Kinds as P

20import Language.PureScript.Linter as P

21import Language.PureScript.Linter as P

21import Language.PureScript.Make as P

22import Language.PureScript.Make as P

src/Language/PureScript/Ide/Externs.hs+22−23

@@ -41,10 +41,9 @@ import Language.PureScript.Ide.Types

41import Language.PureScript.Ide.Util

43import qualified Language.PureScript as P

44−import qualified Language.PureScript.Externs as PE

46readExternFile :: (MonadIO m, MonadError PscIdeError m) =>

45readExternFile :: (MonadIO m, MonadError PscIdeError m) =>

47− FilePath -> m PE.ExternsFile

46+ FilePath -> m P.ExternsFile

48readExternFile fp = do

47readExternFile fp = do

49 parseResult <- liftIO (decodeStrict <$> BS.readFile fp)

48 parseResult <- liftIO (decodeStrict <$> BS.readFile fp)

50 case parseResult of

49 case parseResult of

@@ -57,15 +56,15 @@ moduleNameToText = T.pack . P.runModuleName

57identToText :: P.Ident -> Text

56identToText :: P.Ident -> Text

58identToText = T.pack . P.runIdent

57identToText = T.pack . P.runIdent

60−convertExterns :: PE.ExternsFile -> Module

59+convertExterns :: P.ExternsFile -> Module

61convertExterns ef = (moduleName, exportDecls ++ importDecls ++ decls ++ operatorDecls ++ tyOperatorDecls)

60convertExterns ef = (moduleName, exportDecls ++ importDecls ++ decls ++ operatorDecls ++ tyOperatorDecls)

62 where

61 where

63− moduleName = moduleNameToText (PE.efModuleName ef)

62+ moduleName = moduleNameToText (P.efModuleName ef)

64− importDecls = convertImport <$> PE.efImports ef

63+ importDecls = convertImport <$> P.efImports ef

65− exportDecls = mapMaybe (convertExport . unwrapPositionedRef) (PE.efExports ef)

64+ exportDecls = mapMaybe (convertExport . unwrapPositionedRef) (P.efExports ef)

66− operatorDecls = convertOperator <$> PE.efFixities ef

65+ operatorDecls = convertOperator <$> P.efFixities ef

67− tyOperatorDecls = convertTypeOperator <$> PE.efTypeFixities ef

66+ tyOperatorDecls = convertTypeOperator <$> P.efTypeFixities ef

68− otherDecls = mapMaybe convertDecl (PE.efDeclarations ef)

67+ otherDecls = mapMaybe convertDecl (P.efDeclarations ef)

70 typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration otherDecls)

69 typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration otherDecls)

71 decls = nub $ appEndo typeClassFilter otherDecls

70 decls = nub $ appEndo typeClassFilter otherDecls

@@ -81,33 +80,33 @@ isTypeClassDeclaration :: ExternDecl -> Bool

81isTypeClassDeclaration TypeClassDeclaration{} = True

80isTypeClassDeclaration TypeClassDeclaration{} = True

82isTypeClassDeclaration _ = False

81isTypeClassDeclaration _ = False

84−convertImport :: PE.ExternsImport -> ExternDecl

83+convertImport :: P.ExternsImport -> ExternDecl

85convertImport ei = Dependency

84convertImport ei = Dependency

86− (moduleNameToText (PE.eiModule ei))

85+ (moduleNameToText (P.eiModule ei))

87 []

86 []

88− (moduleNameToText <$> PE.eiImportedAs ei)

87+ (moduleNameToText <$> P.eiImportedAs ei)

90convertExport :: P.DeclarationRef -> Maybe ExternDecl

89convertExport :: P.DeclarationRef -> Maybe ExternDecl

91convertExport (P.ModuleRef mn) = Just (Export (moduleNameToText mn))

90convertExport (P.ModuleRef mn) = Just (Export (moduleNameToText mn))

92convertExport _ = Nothing

91convertExport _ = Nothing

94−convertDecl :: PE.ExternsDeclaration -> Maybe ExternDecl

93+convertDecl :: P.ExternsDeclaration -> Maybe ExternDecl

95−convertDecl PE.EDType{..} = Just $ TypeDeclaration edTypeName edTypeKind

94+convertDecl P.EDType{..} = Just $ TypeDeclaration edTypeName edTypeKind

96−convertDecl PE.EDTypeSynonym{..} = Just $

95+convertDecl P.EDTypeSynonym{..} = Just $

97 TypeSynonymDeclaration edTypeSynonymName edTypeSynonymType

96 TypeSynonymDeclaration edTypeSynonymName edTypeSynonymType

98−convertDecl PE.EDDataConstructor{..} = Just $

97+convertDecl P.EDDataConstructor{..} = Just $

99 DataConstructor (runProperNameT edDataCtorName) edDataCtorTypeCtor edDataCtorType

98 DataConstructor (runProperNameT edDataCtorName) edDataCtorTypeCtor edDataCtorType

100−convertDecl PE.EDValue{..} = Just $

99+convertDecl P.EDValue{..} = Just $

101 ValueDeclaration (identToText edValueName) edValueType

100 ValueDeclaration (identToText edValueName) edValueType

102−convertDecl PE.EDClass{..} = Just $ TypeClassDeclaration edClassName

101+convertDecl P.EDClass{..} = Just $ TypeClassDeclaration edClassName

103−convertDecl PE.EDInstance{} = Nothing

102+convertDecl P.EDInstance{} = Nothing

104

103

105−convertOperator :: PE.ExternsFixity -> ExternDecl

104+convertOperator :: P.ExternsFixity -> ExternDecl

106−convertOperator PE.ExternsFixity{..} =

105+convertOperator P.ExternsFixity{..} =

107 FixityDeclaration (Left efOperator)

106 FixityDeclaration (Left efOperator)

108

107

109−convertTypeOperator :: PE.ExternsTypeFixity -> ExternDecl

108+convertTypeOperator :: P.ExternsTypeFixity -> ExternDecl

110−convertTypeOperator PE.ExternsTypeFixity{..} =

109+convertTypeOperator P.ExternsTypeFixity{..} =

111 FixityDeclaration (Right efTypeOperator)

110 FixityDeclaration (Right efTypeOperator)

112

111

113unwrapPositioned :: P.Declaration -> P.Declaration

112unwrapPositioned :: P.Declaration -> P.Declaration

src/Language/PureScript/Ide/Rebuild.hs+1−2

@@ -19,7 +19,6 @@ import Data.Maybe (fromJust, mapMaybe)

19import qualified Data.Set as S

20import qualified Language.PureScript as P

21import Language.PureScript.Errors.JSON

22−import qualified Language.PureScript.Externs as P

23import System.FilePath (replaceExtension)

22import System.FilePath (replaceExtension)

24import System.Directory (doesFileExist)

23import System.Directory (doesFileExist)

25import System.IO.UTF8 (readUTF8File)

24import System.IO.UTF8 (readUTF8File)

@@ -54,7 +53,7 @@ rebuildFile path = do

54 (result, warnings) <- liftIO

53 (result, warnings) <- liftIO

55 . P.runMake P.defaultOptions

54 . P.runMake P.defaultOptions

56 . P.rebuildModule (ma { P.progress = const (pure ()) }) externs

55 . P.rebuildModule (ma { P.progress = const (pure ()) }) externs

57− $ P.addDefaultImport (P.ModuleName [P.ProperName "Prim"]) m

56+ $ m

58 case result of

57 case result of

59 Left errors -> throwError . RebuildError $ toJSONErrors False P.Error errors

58 Left errors -> throwError . RebuildError $ toJSONErrors False P.Error errors

60 Right _ -> pure . RebuildSuccess $ toJSONErrors False P.Warning warnings

59 Right _ -> pure . RebuildSuccess $ toJSONErrors False P.Warning warnings

src/Language/PureScript/Make.hs+5−4

@@ -146,9 +146,10 @@ rebuildModule :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options

146rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do

147 progress $ CompilingModule moduleName

148 let env = foldl' (flip applyExternsFileToEnvironment) initEnvironment externs

149+ withPrim = importPrim m

149− lint m

150+ lint withPrim

150 ((Module ss coms _ elaborated exps, env'), nextVar) <- runSupplyT 0 $ do

151 ((Module ss coms _ elaborated exps, env'), nextVar) <- runSupplyT 0 $ do

151− [desugared] <- desugar externs [m]

152+ [desugared] <- desugar externs [withPrim]

152 runCheck' env $ typeCheckModule desugared

153 runCheck' env $ typeCheckModule desugared

153 regrouped <- createBindingGroups moduleName . collapseBindingGroups $ elaborated

154 regrouped <- createBindingGroups moduleName . collapseBindingGroups $ elaborated

154 let mod' = Module ss coms moduleName regrouped exps

155 let mod' = Module ss coms moduleName regrouped exps

@@ -167,7 +168,7 @@ rebuildModule MakeActions{..} externs m@(Module _ _ moduleName _ _) = do

167make :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

168make :: forall m. (Monad m, MonadBaseControl IO m, MonadReader Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

168 => MakeActions m

169 => MakeActions m

169 -> [Module]

170 -> [Module]

170− -> m Environment

171+ -> m [ExternsFile]

171make ma@MakeActions{..} ms = do

172make ma@MakeActions{..} ms = do

172 checkModuleNamesAreUnique

173 checkModuleNamesAreUnique

173

174

@@ -187,7 +188,7 @@ make ma@MakeActions{..} ms = do

187

188

188 -- Bundle up all the externs and return them as an Environment

189 -- Bundle up all the externs and return them as an Environment

189 (_, externs) <- unzip . fromMaybe (internalError "make: externs were missing but no errors reported.") . sequence <$> for barriers (takeMVar . fst . snd)

190 (_, externs) <- unzip . fromMaybe (internalError "make: externs were missing but no errors reported.") . sequence <$> for barriers (takeMVar . fst . snd)

190− return $ foldl' (flip applyExternsFileToEnvironment) initEnvironment externs

191+ return externs

191

192

192 where

193 where

193 checkModuleNamesAreUnique :: m ()

194 checkModuleNamesAreUnique :: m ()

tests/TestCompiler.hs+35−18

@@ -57,7 +57,7 @@ main = hspec spec

57spec :: Spec

58spec = do

60− (supportPurs, supportForeigns, passingTestCases, failingTestCases) <- runIO $ do

60+ (supportExterns, supportForeigns, passingTestCases, failingTestCases) <- runIO $ do

61 cwd <- getCurrentDirectory

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

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

@@ -67,13 +67,20 @@ spec = do

67 failingFiles <- getTestFiles failing <$> testGlob failing

68 supportPurs <- supportFiles "purs"

69 supportForeigns <- loadForeigns =<< supportFiles "js"

70+ supportPursFiles <- readInput supportPurs

71+ supportExterns <- runExceptT $ do

72+ modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles

73+ externs <- ExceptT . runTest $ P.make (makeActions supportForeigns) (map snd modules)

74+ return (zip (map snd modules) externs)

75+ case supportExterns of

76+ Left errs -> fail (P.prettyPrintMultipleErrors False errs)

70− return (supportPurs, supportForeigns, passingFiles, failingFiles)

77+ Right externs -> return (externs, supportForeigns, passingFiles, failingFiles)

72 context ("Passing examples") $ do

79 context ("Passing examples") $ do

73 forM_ passingTestCases $ \(testPurs, testJS) ->

80 forM_ passingTestCases $ \(testPurs, testJS) ->

74 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $ do

81 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $ do

75 testForeigns <- loadForeigns testJS

82 testForeigns <- loadForeigns testJS

76− assertCompiles (supportPurs ++ testPurs) (supportForeigns <> testForeigns)

83+ assertCompiles supportExterns testPurs (supportForeigns <> testForeigns)

78 context ("Failing examples") $ do

85 context ("Failing examples") $ do

79 forM_ failingTestCases $ \(testPurs, testJS) -> do

86 forM_ failingTestCases $ \(testPurs, testJS) -> do

@@ -81,7 +88,7 @@ spec = do

81 expectedFailures <- runIO $ getShouldFailWith mainPath

88 expectedFailures <- runIO $ getShouldFailWith mainPath

82 it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $ do

89 it ("'" <> takeFileName mainPath <> "' should fail with '" <> intercalate "', '" expectedFailures <> "'") $ do

83 testForeigns <- loadForeigns testJS

90 testForeigns <- loadForeigns testJS

84− assertDoesNotCompile (supportPurs ++ testPurs) (supportForeigns <> testForeigns) expectedFailures

91+ assertDoesNotCompile supportExterns testPurs (supportForeigns <> testForeigns) expectedFailures

86 where

93 where

@@ -166,27 +173,36 @@ runTest :: P.Make a -> IO (Either P.MultipleErrors a)

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

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

167

174

168compile

175compile

176+ :: [(P.Module, P.ExternsFile)]

169− :: [FilePath]

177+ -> [FilePath]

170 -> M.Map P.ModuleName FilePath

178 -> M.Map P.ModuleName FilePath

171− -> IO (Either P.MultipleErrors P.Environment)

179+ -> IO (Either P.MultipleErrors [P.ExternsFile])

172−compile inputFiles foreigns = silence $ runTest $ do

180+compile supportExterns inputFiles foreigns = silence $ runTest $ do

173 fs <- liftIO $ readInput inputFiles

181 fs <- liftIO $ readInput inputFiles

174 ms <- P.parseModulesFromFiles id fs

182 ms <- P.parseModulesFromFiles id fs

175− P.make (makeActions foreigns) (map snd ms)

183+ let actions = makeActions foreigns

184+ case ms of

185+ [singleModule] -> pure <$> P.rebuildModule actions (map snd supportExterns) (snd singleModule)

186+ _ -> P.make actions (map fst supportExterns ++ map snd ms)

176

187

177assert

188assert

189+ :: [(P.Module, P.ExternsFile)]

178− :: [FilePath]

190+ -> [FilePath]

179 -> M.Map P.ModuleName FilePath

191 -> M.Map P.ModuleName FilePath

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

192+ -> (Either P.MultipleErrors [P.ExternsFile] -> IO (Maybe String))

181 -> Expectation

193 -> Expectation

182−assert inputFiles foreigns f = do

194+assert supportExterns inputFiles foreigns f = do

183− e <- compile inputFiles foreigns

195+ e <- compile supportExterns inputFiles foreigns

184 maybeErr <- f e

196 maybeErr <- f e

185 maybe (return ()) expectationFailure maybeErr

197 maybe (return ()) expectationFailure maybeErr

186

198

199+assertCompiles

200+ :: [(P.Module, P.ExternsFile)]

201+ -> [FilePath]

187−assertCompiles :: [FilePath] -> M.Map P.ModuleName FilePath -> Expectation

202+ -> M.Map P.ModuleName FilePath

203+ -> Expectation

188−assertCompiles inputFiles foreigns = do

204+assertCompiles supportExterns inputFiles foreigns = do

189− assert inputFiles foreigns $ \e ->

205+ assert supportExterns inputFiles foreigns $ \e ->

190 case e of

206 case e of

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

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

192 Right _ -> do

208 Right _ -> do

@@ -203,12 +219,13 @@ assertCompiles inputFiles foreigns = do

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

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

204

220

205assertDoesNotCompile

221assertDoesNotCompile

222+ :: [(P.Module, P.ExternsFile)]

206− :: [FilePath]

223+ -> [FilePath]

207 -> M.Map P.ModuleName FilePath

224 -> M.Map P.ModuleName FilePath

208 -> [String]

225 -> [String]

209 -> Expectation

226 -> Expectation

210−assertDoesNotCompile inputFiles foreigns shouldFailWith = do

227+assertDoesNotCompile supportExterns inputFiles foreigns shouldFailWith = do

211− assert inputFiles foreigns $ \e ->

228+ assert supportExterns inputFiles foreigns $ \e ->

212 case e of

229 case e of

213 Left errs -> do

230 Left errs -> do

214 return $ if null shouldFailWith

231 return $ if null shouldFailWith