summaryrefslogtreecommitdiff
path: root/tests/TestMake.hs
diff options
context:
space:
mode:
authorhdgarrood <>2019-10-20 21:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-10-20 21:32:00 (GMT)
commit5ad3069b08d142e1b278a1c0cb495de9ea7441a2 (patch)
treefb67390b7a61a787ecc6dde0217468ae02bdcfb4 /tests/TestMake.hs
parent196340405320c2706aef57bcfe40cf4790e62de3 (diff)
version 0.13.40.13.4
Diffstat (limited to 'tests/TestMake.hs')
-rw-r--r--tests/TestMake.hs216
1 files changed, 216 insertions, 0 deletions
diff --git a/tests/TestMake.hs b/tests/TestMake.hs
new file mode 100644
index 0000000..dadee27
--- /dev/null
+++ b/tests/TestMake.hs
@@ -0,0 +1,216 @@
+-- Tests for the compiler's handling of incremental builds, i.e. the code in
+-- Language.PureScript.Make.
+
+module TestMake where
+
+import Prelude ()
+import Prelude.Compat
+
+import qualified Language.PureScript as P
+import qualified Language.PureScript.CST as CST
+
+import Control.Monad
+import Control.Exception (tryJust)
+import Control.Monad.IO.Class (liftIO)
+import Control.Concurrent.MVar (readMVar, newMVar, modifyMVar_)
+import Data.Time.Calendar
+import Data.Time.Clock
+import qualified Data.Text as T
+import Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.Map as M
+
+import System.FilePath
+import System.Directory
+import System.IO.Error (isDoesNotExistError)
+import System.IO.UTF8 (readUTF8FilesT, writeUTF8FileT)
+
+import Test.Tasty
+import Test.Tasty.Hspec
+
+utcMidnightOnDate :: Integer -> Int -> Int -> UTCTime
+utcMidnightOnDate day month year = UTCTime (fromGregorian day month year) (secondsToDiffTime 0)
+
+timestampA, timestampB, timestampC, timestampD, timestampE, timestampF :: UTCTime
+timestampA = utcMidnightOnDate 2019 1 1
+timestampB = utcMidnightOnDate 2019 1 2
+timestampC = utcMidnightOnDate 2019 1 3
+timestampD = utcMidnightOnDate 2019 1 4
+timestampE = utcMidnightOnDate 2019 1 5
+timestampF = utcMidnightOnDate 2019 1 6
+
+main :: IO TestTree
+main = testSpec "make" spec
+
+spec :: Spec
+spec = do
+ let sourcesDir = "tests/purs/make"
+ let moduleNames = Set.fromList . map P.moduleNameFromString
+ before_ (rimraf modulesDir >> rimraf sourcesDir >> createDirectory sourcesDir) $ do
+ it "does not recompile if there are no changes" $ do
+ let modulePath = sourcesDir </> "Module.purs"
+
+ writeFileWithTimestamp modulePath timestampA "module Module where\nfoo = 0\n"
+ compile [modulePath] `shouldReturn` moduleNames ["Module"]
+ compile [modulePath] `shouldReturn` moduleNames []
+
+ it "recompiles if files have changed" $ do
+ let modulePath = sourcesDir </> "Module.purs"
+
+ writeFileWithTimestamp modulePath timestampA "module Module where\nfoo = 0\n"
+ compile [modulePath] `shouldReturn` moduleNames ["Module"]
+ writeFileWithTimestamp modulePath timestampB "module Module where\nfoo = 1\n"
+ compile [modulePath] `shouldReturn` moduleNames ["Module"]
+
+ it "does not recompile if hashes have not changed" $ do
+ let modulePath = sourcesDir </> "Module.purs"
+ moduleContent = "module Module where\nfoo = 0\n"
+
+ writeFileWithTimestamp modulePath timestampA moduleContent
+ compile [modulePath] `shouldReturn` moduleNames ["Module"]
+ writeFileWithTimestamp modulePath timestampB moduleContent
+ compile [modulePath] `shouldReturn` moduleNames []
+
+ it "recompiles if the file path for a module has changed" $ do
+ let modulePath1 = sourcesDir </> "Module1.purs"
+ modulePath2 = sourcesDir </> "Module2.purs"
+ moduleContent = "module Module where\nfoo = 0\n"
+
+ writeFileWithTimestamp modulePath1 timestampA moduleContent
+ writeFileWithTimestamp modulePath2 timestampA moduleContent
+
+ compile [modulePath1] `shouldReturn` moduleNames ["Module"]
+ compile [modulePath2] `shouldReturn` moduleNames ["Module"]
+
+ it "recompiles if an FFI file was added" $ do
+ let moduleBasePath = sourcesDir </> "Module"
+ modulePath = moduleBasePath ++ ".purs"
+ moduleFFIPath = moduleBasePath ++ ".js"
+ moduleContent = "module Module where\nfoo = 0\n"
+
+ writeFileWithTimestamp modulePath timestampA moduleContent
+ compile [modulePath] `shouldReturn` moduleNames ["Module"]
+
+ writeFileWithTimestamp moduleFFIPath timestampB "exports.bar = 1;\n"
+ compile [modulePath] `shouldReturn` moduleNames ["Module"]
+
+ it "recompiles if an FFI file was removed" $ do
+ let moduleBasePath = sourcesDir </> "Module"
+ modulePath = moduleBasePath ++ ".purs"
+ moduleFFIPath = moduleBasePath ++ ".js"
+ moduleContent = "module Module where\nfoo = 0\n"
+
+ writeFileWithTimestamp modulePath timestampA moduleContent
+ writeFileWithTimestamp moduleFFIPath timestampB "exports.bar = 1;\n"
+ compile [modulePath] `shouldReturn` moduleNames ["Module"]
+
+ removeFile moduleFFIPath
+ compile [modulePath] `shouldReturn` moduleNames ["Module"]
+
+ it "recompiles downstream modules when a module is rebuilt" $ do
+ let moduleAPath = sourcesDir </> "A.purs"
+ moduleBPath = sourcesDir </> "B.purs"
+ moduleAContent1 = "module A where\nfoo = 0\n"
+ moduleAContent2 = "module A where\nfoo = 1\n"
+ moduleBContent = "module B where\nimport A (foo)\nbar = foo\n"
+
+ writeFileWithTimestamp moduleAPath timestampA moduleAContent1
+ writeFileWithTimestamp moduleBPath timestampB moduleBContent
+ compile [moduleAPath, moduleBPath] `shouldReturn` moduleNames ["A", "B"]
+
+ writeFileWithTimestamp moduleAPath timestampC moduleAContent2
+ compile [moduleAPath, moduleBPath] `shouldReturn` moduleNames ["A", "B"]
+
+ it "only recompiles downstream modules when a module is rebuilt" $ do
+ let moduleAPath = sourcesDir </> "A.purs"
+ moduleBPath = sourcesDir </> "B.purs"
+ moduleCPath = sourcesDir </> "C.purs"
+ modulePaths = [moduleAPath, moduleBPath, moduleCPath]
+ moduleAContent1 = "module A where\nfoo = 0\n"
+ moduleAContent2 = "module A where\nfoo = 1\n"
+ moduleBContent = "module B where\nimport A (foo)\nbar = foo\n"
+ moduleCContent = "module C where\nbaz = 3\n"
+
+ writeFileWithTimestamp moduleAPath timestampA moduleAContent1
+ writeFileWithTimestamp moduleBPath timestampB moduleBContent
+ writeFileWithTimestamp moduleCPath timestampC moduleCContent
+ compile modulePaths `shouldReturn` moduleNames ["A", "B", "C"]
+
+ writeFileWithTimestamp moduleAPath timestampD moduleAContent2
+ compile modulePaths `shouldReturn` moduleNames ["A", "B"]
+
+ it "does not necessarily recompile modules which were not part of the previous batch" $ do
+ let moduleAPath = sourcesDir </> "A.purs"
+ moduleBPath = sourcesDir </> "B.purs"
+ moduleCPath = sourcesDir </> "C.purs"
+ modulePaths = [moduleAPath, moduleBPath, moduleCPath]
+ batch1 = [moduleAPath, moduleBPath]
+ batch2 = [moduleAPath, moduleCPath]
+ moduleAContent = "module A where\nfoo = 0\n"
+ moduleBContent = "module B where\nimport A (foo)\nbar = foo\n"
+ moduleCContent = "module C where\nbaz = 3\n"
+
+ writeFileWithTimestamp moduleAPath timestampA moduleAContent
+ writeFileWithTimestamp moduleBPath timestampB moduleBContent
+ writeFileWithTimestamp moduleCPath timestampC moduleCContent
+ compile modulePaths `shouldReturn` moduleNames ["A", "B", "C"]
+
+ compile batch1 `shouldReturn` moduleNames []
+ compile batch2 `shouldReturn` moduleNames []
+
+ it "recompiles if a module fails to compile" $ do
+ let modulePath = sourcesDir </> "Module.purs"
+ moduleContent = "module Module where\nfoo :: Int\nfoo = \"not an int\"\n"
+
+ writeFileWithTimestamp modulePath timestampA moduleContent
+ compileAllowingFailures [modulePath] `shouldReturn` moduleNames ["Module"]
+ compileAllowingFailures [modulePath] `shouldReturn` moduleNames ["Module"]
+
+rimraf :: FilePath -> IO ()
+rimraf =
+ void . tryJust (guard . isDoesNotExistError) . removeDirectoryRecursive
+
+-- | Returns a set of the modules for which a rebuild was attempted, including
+-- the make result.
+compileWithResult :: [FilePath] -> IO (Either P.MultipleErrors [P.ExternsFile], Set P.ModuleName)
+compileWithResult input = do
+ recompiled <- newMVar Set.empty
+ moduleFiles <- readUTF8FilesT input
+ (makeResult, _) <- P.runMake P.defaultOptions $ do
+ ms <- CST.parseModulesFromFiles id moduleFiles
+ let filePathMap = M.fromList $ map (\(fp, pm) -> (P.getModuleName $ CST.resPartial pm, Right fp)) ms
+ foreigns <- P.inferForeignModules filePathMap
+ let makeActions =
+ (P.buildMakeActions modulesDir filePathMap foreigns True)
+ { P.progress = \(P.CompilingModule mn) ->
+ liftIO $ modifyMVar_ recompiled (return . Set.insert mn)
+ }
+ P.make makeActions (map snd ms)
+
+ recompiledModules <- readMVar recompiled
+ pure (makeResult, recompiledModules)
+
+-- | Compile, returning the set of modules which were rebuilt, and failing if
+-- any errors occurred.
+compile :: [FilePath] -> IO (Set P.ModuleName)
+compile input = do
+ (result, recompiled) <- compileWithResult input
+ case result of
+ Left errs ->
+ fail (P.prettyPrintMultipleErrors P.defaultPPEOptions errs)
+ Right _ ->
+ pure recompiled
+
+compileAllowingFailures :: [FilePath] -> IO (Set P.ModuleName)
+compileAllowingFailures input = fmap snd (compileWithResult input)
+
+writeFileWithTimestamp :: FilePath -> UTCTime -> T.Text -> IO ()
+writeFileWithTimestamp path mtime contents = do
+ writeUTF8FileT path contents
+ setModificationTime path mtime
+
+-- | Use a different output directory to ensure that we don't get interference
+-- from other test results
+modulesDir :: FilePath
+modulesDir = ".test_modules" </> "make"
+