f7114e3 · rowtype-yoga/purescript-native

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

Speed up tests (#2110)

commitf7114e3119c161ffa421b73badb9b752f0d2117a authorPhil Freeman <paf31@cantab.net> dateWed 11 May 2016, 11:44 (10 years ago) parent3ad48f1

6 files changed+73−54

compare with golang

unifiedsplit

psci/PSCi.hs+9−7 src/Language/PureScript.hs+1 src/Language/PureScript/Ide/Externs.hs+22−23 src/Language/PureScript/Ide/Rebuild.hs+1−2 src/Language/PureScript/Make.hs+5−4 tests/TestCompiler.hs+35−18

psci/PSCi.hs+9−7

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

1313import Prelude.Compat

1414

1515import Data.Foldable (traverse_)

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

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

1717import Data.Tuple (swap)

1818import qualified Data.Map as M

1919

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

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

128128

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

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

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

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

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

131133 where

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

133− actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False

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

135− loadedModules = psciLoadedModules st

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

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

135+ actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False

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

137+ loadedModules = psciLoadedModules st

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

137139

138140

139141-- Commands

src/Language/PureScript.hs+1

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

1616import Language.PureScript.Crash as P

1717import Language.PureScript.Environment as P

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

19+import Language.PureScript.Externs as P

1920import Language.PureScript.Kinds as P

2021import Language.PureScript.Linter as P

2122import Language.PureScript.Make as P

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

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

4141import Language.PureScript.Ide.Util

4242

4343import qualified Language.PureScript as P

44−import qualified Language.PureScript.Externs as PE

4544

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

47− FilePath -> m PE.ExternsFile

46+ FilePath -> m P.ExternsFile

4847readExternFile fp = do

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

5049 case parseResult of

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

5756identToText :: P.Ident -> Text

5857identToText = T.pack . P.runIdent

5958

60−convertExterns :: PE.ExternsFile -> Module

59+convertExterns :: P.ExternsFile -> Module

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

6261 where

63− moduleName = moduleNameToText (PE.efModuleName ef)

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

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

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

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

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

62+ moduleName = moduleNameToText (P.efModuleName ef)

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

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

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

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

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

6968

7069 typeClassFilter = foldMap removeTypeDeclarationsForClass (filter isTypeClassDeclaration otherDecls)

7170 decls = nub $ appEndo typeClassFilter otherDecls

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

8180isTypeClassDeclaration TypeClassDeclaration{} = True

8281isTypeClassDeclaration _ = False

8382

84−convertImport :: PE.ExternsImport -> ExternDecl

83+convertImport :: P.ExternsImport -> ExternDecl

8584convertImport ei = Dependency

86− (moduleNameToText (PE.eiModule ei))

85+ (moduleNameToText (P.eiModule ei))

8786 []

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

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

8988

9089convertExport :: P.DeclarationRef -> Maybe ExternDecl

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

9291convertExport _ = Nothing

9392

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

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

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

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

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

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

9796 TypeSynonymDeclaration edTypeSynonymName edTypeSynonymType

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

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

9998 DataConstructor (runProperNameT edDataCtorName) edDataCtorTypeCtor edDataCtorType

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

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

101100 ValueDeclaration (identToText edValueName) edValueType

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

103−convertDecl PE.EDInstance{} = Nothing

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

102+convertDecl P.EDInstance{} = Nothing

104103

105−convertOperator :: PE.ExternsFixity -> ExternDecl

106−convertOperator PE.ExternsFixity{..} =

104+convertOperator :: P.ExternsFixity -> ExternDecl

105+convertOperator P.ExternsFixity{..} =

107106 FixityDeclaration (Left efOperator)

108107

109−convertTypeOperator :: PE.ExternsTypeFixity -> ExternDecl

110−convertTypeOperator PE.ExternsTypeFixity{..} =

108+convertTypeOperator :: P.ExternsTypeFixity -> ExternDecl

109+convertTypeOperator P.ExternsTypeFixity{..} =

111110 FixityDeclaration (Right efTypeOperator)

112111

113112unwrapPositioned :: P.Declaration -> P.Declaration

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

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

1919import qualified Data.Set as S

2020import qualified Language.PureScript as P

2121import Language.PureScript.Errors.JSON

22−import qualified Language.PureScript.Externs as P

2322import System.FilePath (replaceExtension)

2423import System.Directory (doesFileExist)

2524import System.IO.UTF8 (readUTF8File)

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

5453 (result, warnings) <- liftIO

5554 . P.runMake P.defaultOptions

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

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

56+ $ m

5857 case result of

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

6059 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

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

147147 progress $ CompilingModule moduleName

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

149− lint m

149+ withPrim = importPrim m

150+ lint withPrim

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

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

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

152153 runCheck' env $ typeCheckModule desugared

153154 regrouped <- createBindingGroups moduleName . collapseBindingGroups $ elaborated

154155 let mod' = Module ss coms moduleName regrouped exps

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

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

168169 => MakeActions m

169170 -> [Module]

170− -> m Environment

171+ -> m [ExternsFile]

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

172173 checkModuleNamesAreUnique

173174

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

187188

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

189190 (_, 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

191192

192193 where

193194 checkModuleNamesAreUnique :: m ()

tests/TestCompiler.hs+35−18

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

5757spec :: Spec

5858spec = do

5959

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

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

6161 cwd <- getCurrentDirectory

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

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

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

6767 failingFiles <- getTestFiles failing <$> testGlob failing

6868 supportPurs <- supportFiles "purs"

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

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

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)

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

7178

7279 context ("Passing examples") $ do

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

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

7582 testForeigns <- loadForeigns testJS

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

83+ assertCompiles supportExterns testPurs (supportForeigns <> testForeigns)

7784

7885 context ("Failing examples") $ do

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

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

8188 expectedFailures <- runIO $ getShouldFailWith mainPath

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

8390 testForeigns <- loadForeigns testJS

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

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

8592

8693 where

8794

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

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

167174

168175compile

169− :: [FilePath]

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

177+ -> [FilePath]

170178 -> M.Map P.ModuleName FilePath

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

172−compile inputFiles foreigns = silence $ runTest $ do

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

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

173181 fs <- liftIO $ readInput inputFiles

174182 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)

176187

177188assert

178− :: [FilePath]

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

190+ -> [FilePath]

179191 -> M.Map P.ModuleName FilePath

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

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

181193 -> Expectation

182−assert inputFiles foreigns f = do

183− e <- compile inputFiles foreigns

194+assert supportExterns inputFiles foreigns f = do

195+ e <- compile supportExterns inputFiles foreigns

184196 maybeErr <- f e

185197 maybe (return ()) expectationFailure maybeErr

186198

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

188−assertCompiles inputFiles foreigns = do

189− assert inputFiles foreigns $ \e ->

199+assertCompiles

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

201+ -> [FilePath]

202+ -> M.Map P.ModuleName FilePath

203+ -> Expectation

204+assertCompiles supportExterns inputFiles foreigns = do

205+ assert supportExterns inputFiles foreigns $ \e ->

190206 case e of

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

192208 Right _ -> do

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

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

204220

205221assertDoesNotCompile

206− :: [FilePath]

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

223+ -> [FilePath]

207224 -> M.Map P.ModuleName FilePath

208225 -> [String]

209226 -> Expectation

210−assertDoesNotCompile inputFiles foreigns shouldFailWith = do

211− assert inputFiles foreigns $ \e ->

227+assertDoesNotCompile supportExterns inputFiles foreigns shouldFailWith = do

228+ assert supportExterns inputFiles foreigns $ \e ->

212229 case e of

213230 Left errs -> do

214231 return $ if null shouldFailWith