diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 0.13.1 + +* Let test suite pass when no package index available [stackage#1165](https://github.com/fpco/stackage/issues/1165) + ## 0.13.0 * build-tool-overrides diff --git a/Stackage/CheckBuildPlan.hs b/Stackage/CheckBuildPlan.hs --- a/Stackage/CheckBuildPlan.hs +++ b/Stackage/CheckBuildPlan.hs @@ -142,7 +142,7 @@ [ display dep , "-" , display version - , " depended on by:" + , " is out of bounds for:" ] showUser :: (PkgUser, VersionRange) -> Text diff --git a/Stackage/PerformBuild.hs b/Stackage/PerformBuild.hs --- a/Stackage/PerformBuild.hs +++ b/Stackage/PerformBuild.hs @@ -17,9 +17,11 @@ import Control.Concurrent.Async (async) import Control.Concurrent.STM.TSem import Control.Monad.Writer.Strict (execWriter, tell) +import qualified Data.ByteString as S import qualified Data.Map as Map import Data.NonNull (fromNullable) -import Distribution.PackageDescription (buildType, packageDescription, BuildType (Simple)) +import Distribution.PackageDescription (buildType, packageDescription, BuildType (Simple), + condTestSuites) import Filesystem (canonicalizePath, createTree, getWorkingDirectory, removeTree, rename, removeFile) @@ -37,8 +39,9 @@ import System.Environment (getEnvironment) import System.Exit import System.IO (IOMode (WriteMode), - openBinaryFile) + openBinaryFile, hFlush) import System.IO.Temp (withSystemTempDirectory) +import System.Timeout (timeout) data BuildException = BuildException (Map PackageName BuildFailure) [Text] deriving Typeable @@ -97,7 +100,7 @@ -> IO a waitForDeps toolMap packageMap activeComps bp pi action = do atomically $ do - mapM_ checkPackage $ Map.keys $ filterUnused $ sdPackages $ ppDesc $ piPlan pi + mapM_ checkPackage $ addCabal $ Map.keysSet $ filterUnused $ sdPackages $ ppDesc $ piPlan pi forM_ (Map.keys $ filterUnused $ sdTools $ ppDesc $ piPlan pi) $ \exe -> do case lookup exe toolMap >>= fromNullable . map checkPackage . setToList of Nothing @@ -127,6 +130,11 @@ isCore = (`member` siCorePackages (bpSystemInfo bp)) isCoreExe = (`member` siCoreExecutables (bpSystemInfo bp)) + -- Since we build every package using the Cabal library, it's an implicit + -- dependency of everything + addCabal :: Set PackageName -> Set PackageName + addCabal = insertSet (PackageName "Cabal") + withCounter :: TVar Int -> IO a -> IO a withCounter counter = bracket_ (atomically $ modifyTVar counter (+ 1)) @@ -295,12 +303,31 @@ , version ] + quote :: Text -> Text + quote s + | any special s = tshow s + | otherwise = s + where + special ' ' = True + special '\'' = True + special '"' = True + special _ = False + + runIn :: FilePath -> IO Handle -> Text -> [Text] -> IO () runIn wdir getOutH cmd args = do outH <- getOutH + S.hPut outH $ encodeUtf8 $ concat + [ "> " + , pack wdir + , "$ " + , unwords $ map quote $ cmd : args + , "\n" + ] + hFlush outH withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle -> (return () :: IO ()) where - cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args)) + cp outH = (proc (unpack cmd) (map unpack args)) { cwd = Just wdir , std_out = UseHandle outH , std_err = UseHandle outH @@ -323,7 +350,6 @@ ] libOut = pbLogDir unpack namever "build.out" testOut = pbLogDir unpack namever "test.out" - testRunOut = pbLogDir unpack namever "test-run.out" wf fp inner' = do ref <- newIORef Nothing @@ -387,18 +413,24 @@ runChild getOutH a b cabal args = run "runghc" $ runghcArgs $ "Setup" : args - isUnpacked <- newIORef False + gpdRef <- newIORef Nothing let withUnpacked inner' = do - unlessM (readIORef isUnpacked) $ do - log' $ "Unpacking " ++ namever - runParent getOutH "stack" ["unpack", namever] + mgpd <- readIORef gpdRef + gpd <- + case mgpd of + Just gpd -> return gpd + Nothing -> do + log' $ "Unpacking " ++ namever + runParent getOutH "stack" ["unpack", namever] - createSetupHs childDir name - writeIORef isUnpacked True - inner' + gpd <- createSetupHs childDir name + writeIORef gpdRef $ Just gpd + return gpd + inner' gpd + isConfiged <- newIORef False - let withConfiged inner' = withUnpacked $ do + let withConfiged inner' = withUnpacked $ \_gpd -> do unlessM (readIORef isConfiged) $ do log' $ "Configuring " ++ namever cabal $ "configure" : configArgs @@ -509,7 +541,7 @@ let needTest = pbEnableTests && checkPrevResult prevTestResult pcTests && not pcSkipBuild - when needTest $ withUnpacked $ do + when needTest $ withUnpacked $ \gpd -> do log' $ "Test configure " ++ namever cabal $ "configure" : "--enable-tests" : configArgs @@ -517,9 +549,34 @@ log' $ "Test build " ++ namever cabal ["build"] - log' $ "Test run " ++ namever - cabal ["test", "--log=" ++ pack testRunOut] + let tests = map fst $ condTestSuites gpd + forM_ tests $ \test -> do + log' $ concat + [ "Test run " + , namever + , " (" + , pack test + , ")" + ] + let exe = "dist/build" test test + exists <- liftIO $ doesFileExist $ childDir exe + if exists + then do + mres <- timeout maximumTestSuiteTime $ run (pack exe) [] + case mres of + Just () -> return () + Nothing -> error $ concat + [ "Test suite timed out: " + , unpack namever + , ":" + , test + ] + else do + outH <- getOutH + hPutStrLn outH $ "Test suite not built: " ++ test + hFlush outH + savePreviousResult pb Test pident $ either (const False) (const True) eres case (eres, pcTests) of (Left e, ExpectSuccess) -> throwM e @@ -541,6 +598,10 @@ Just bf -> bf Nothing -> BuildFailureException exc +-- | Maximum time (in microseconds) to run a single test suite +maximumTestSuiteTime :: Int +maximumTestSuiteTime = 10 * 60 * 1000 * 1000 -- ten minutes + renameOrCopy :: FilePath -> FilePath -> IO () renameOrCopy src dest = rename (fromString src) (fromString dest) @@ -683,20 +744,16 @@ -- Also deletes any Setup.lhs if necessary createSetupHs :: FilePath -> Text -- ^ package name - -> IO () + -> IO GenericPackageDescription createSetupHs dir name = do - simple <- isSimple cabalFP + bs <- readFile cabalFP + gpd <- gpdFromLBS cabalFP (fromStrict bs) + let simple = buildType (packageDescription gpd) == Just Simple when simple $ do _ <- tryIO $ removeFile $ fromString setuplhs writeFile setuphs $ asByteString "import Distribution.Simple\nmain = defaultMain\n" + return gpd where cabalFP = dir unpack name <.> "cabal" setuphs = dir "Setup.hs" setuplhs = dir "Setup.lhs" - --- | Check if the given cabal file has a simple build plan -isSimple :: FilePath -> IO Bool -isSimple fp = do - bs <- readFile fp - gpd <- gpdFromLBS fp (fromStrict bs) - return $ buildType (packageDescription gpd) == Just Simple diff --git a/stackage-curator.cabal b/stackage-curator.cabal --- a/stackage-curator.cabal +++ b/stackage-curator.cabal @@ -1,5 +1,5 @@ name: stackage-curator -version: 0.13.0 +version: 0.13.1 synopsis: Tools for curating Stackage bundles description: Please see for a description and documentation. homepage: https://github.com/fpco/stackage @@ -128,6 +128,7 @@ , containers , http-client , http-client-tls + , directory source-repository head type: git diff --git a/test/Stackage/PackageIndexSpec.hs b/test/Stackage/PackageIndexSpec.hs --- a/test/Stackage/PackageIndexSpec.hs +++ b/test/Stackage/PackageIndexSpec.hs @@ -5,11 +5,12 @@ import Stackage.Prelude import Test.Hspec import Distribution.Package (packageId) +import System.Directory (doesFileExist, getAppUserDataDirectory) spec :: Spec spec = do - it "works" $ (runResourceT $ sourcePackageIndex $$ sinkNull :: IO ()) - it "getLatestDescriptions gives reasonable results" $ do + it "works" $ ifIndexExists $ (runResourceT $ sourcePackageIndex $$ sinkNull :: IO ()) + it "getLatestDescriptions gives reasonable results" $ ifIndexExists $ do let f x y = (display x, display y) `member` asSet (setFromList [ (asText "base", asText "4.5.0.0") , ("does-not-exist", "9999999999999999999") @@ -19,3 +20,12 @@ p <- simpleParse $ asText "base" v <- simpleParse $ asText "4.5.0.0" (spdVersion <$> m) `shouldBe` singletonMap p v + +ifIndexExists :: IO () -> IO () +ifIndexExists inner = do + stack <- getAppUserDataDirectory "stack" + let fp = stack "indices" "Hackage" "00-index.tar" + exists <- doesFileExist fp + if exists + then inner + else pendingWith "00-index.tar not available, skipping test"