Skip Cabal package tests that cannot run in the current environment

Cabal/Cabal.cabal

@@ -119,6 +119,7 @@ extra-source-files:
   tests/PackageTests/HaddockNewline/A.hs
   tests/PackageTests/HaddockNewline/HaddockNewline.cabal
   tests/PackageTests/HaddockNewline/Setup.hs
+  tests/PackageTests/Options.hs
   tests/PackageTests/OrderFlags/Foo.hs
   tests/PackageTests/OrderFlags/my.cabal
   tests/PackageTests/PathsModule/Executable/Main.hs

Cabal/tests/PackageTests.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
 -- The intention is that this will be the new unit test framework.
 -- Please add any working tests here.  This file should do nothing
 -- but import tests from other modules.
@@ -8,6 +6,7 @@
 
 module Main where
 
+import PackageTests.Options
 import PackageTests.PackageTester
 import PackageTests.Tests
 
@@ -16,7 +15,7 @@ import Distribution.Simple.Configure
     , interpretPackageDbFlags )
 import Distribution.Simple.Compiler (PackageDB(..), PackageDBStack)
 import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
-import Distribution.Simple.Program.Types (programPath, programVersion)
+import Distribution.Simple.Program.Types (Program(..), programPath, programVersion)
 import Distribution.Simple.Program.Builtin
     ( ghcProgram, ghcPkgProgram, haddockProgram )
 import Distribution.Simple.Program.Db (requireProgram)
@@ -28,7 +27,6 @@ import Distribution.ReadE (readEOrFail)
 
 import Control.Exception
 import Data.Proxy                      ( Proxy(..) )
-import Data.Typeable                   ( Typeable )
 import Distribution.Compat.Environment ( lookupEnv )
 import System.Directory
 import Test.Tasty
@@ -111,6 +109,12 @@ main = do
         Just str ->
             return (fromJust (simpleParse str))
 
+    with_ghc_version <- do
+         version <- programFindVersion ghcProgram normal with_ghc_path
+         case version of
+           Nothing -> error "Cannot determine version of GHC used for --with-ghc"
+           Just v -> return v
+
     -- Package DBs are not guaranteed to be absolute, so make them so in
     -- case a subprocess using the package DB needs a different CWD.
     db_stack_env <- lookupEnv "CABAL_PACKAGETESTS_DB_STACK"
@@ -157,6 +161,7 @@ main = do
                  , ghcVersion = ghc_version
                  , ghcPkgPath = ghc_pkg_path
                  , withGhcPath = with_ghc_path
+                 , withGhcVersion = with_ghc_version
                  , packageDBStack = packageDBStack2
                  , suiteVerbosity = verbosity
                  , absoluteCWD = test_dir
@@ -186,18 +191,8 @@ main = do
     putStrLn $ "Building shared ./Setup executable"
     rawCompileSetup verbosity suite [] "tests"
 
-    defaultMainWithIngredients options (tests suite)
-
--- | The tests are divided into two top-level trees, depending on whether they
--- require shared libraries. The option --skip-shared-library-tests can be used
--- when shared libraries are unavailable.
-tests :: SuiteConfig -> TestTree
-tests suite = askOption $ \(OptionSkipSharedLibraryTests skip) ->
-                testGroup "Package Tests" $
-                noSharedLibs : [sharedLibs | not skip]
-  where
-    sharedLibs = testGroup "SharedLibs" $ sharedLibTests suite
-    noSharedLibs = testGroup "NoSharedLibs" $ nonSharedLibTests suite
+    defaultMainWithIngredients options $
+        runTestTree "Package Tests" (tests suite)
 
 -- Reverse of 'interpretPackageDbFlags'.
 -- prop_idem stk b
@@ -282,17 +277,7 @@ getPersistBuildConfig_ filename = do
       Left err -> return (throw err)
       Right lbi -> return lbi
 
-newtype OptionSkipSharedLibraryTests = OptionSkipSharedLibraryTests Bool
-  deriving Typeable
-
-instance IsOption OptionSkipSharedLibraryTests where
-  defaultValue   = OptionSkipSharedLibraryTests False
-  parseValue     = fmap OptionSkipSharedLibraryTests . safeRead
-  optionName     = return "skip-shared-library-tests"
-  optionHelp     = return "Skip the tests that require shared libraries"
-  optionCLParser = flagCLParser Nothing (OptionSkipSharedLibraryTests True)
-
 options :: [Ingredient]
 options = includingOptions
-          [Option (Proxy :: Proxy OptionSkipSharedLibraryTests)] :
+          [Option (Proxy :: Proxy OptionEnableAllTests)] :
           defaultIngredients

Cabal/tests/PackageTests/Options.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module PackageTests.Options
+    ( OptionEnableAllTests(..)
+    ) where
+
+import Data.Typeable (Typeable)
+
+import Test.Tasty.Options (IsOption(..), flagCLParser, safeRead)
+
+newtype OptionEnableAllTests = OptionEnableAllTests Bool
+  deriving Typeable
+
+instance IsOption OptionEnableAllTests where
+  defaultValue   = OptionEnableAllTests False
+  parseValue     = fmap OptionEnableAllTests . safeRead
+  optionName     = return "enable-all-tests"
+  optionHelp     = return "Enable all tests"
+  optionCLParser = flagCLParser Nothing (OptionEnableAllTests True)

Cabal/tests/PackageTests/PackageTester.hs

@@ -49,6 +49,18 @@ module PackageTests.PackageTester
     , assertFindInFile
     , concatOutput
 
+    -- * Test trees
+    , TestTreeM
+    , runTestTree
+    , testTree
+    , testTree'
+    , groupTests
+    , mapTestTrees
+    , testWhen
+    , testUnless
+    , unlessWindows
+    , hasSharedLibraries
+
     , getPersistBuildConfig
 
     -- Common utilities
@@ -58,9 +70,12 @@ module PackageTests.PackageTester
     , module Text.Regex.Posix
     ) where
 
+import PackageTests.Options
+
 import Distribution.Compat.CreatePipe (createPipe)
 import Distribution.Simple.Compiler (PackageDBStack, PackageDB(..))
 import Distribution.Simple.Program.Run (getEffectiveEnvironment)
+import Distribution.System (OS(Windows), buildOS)
 import Distribution.Simple.Utils
     ( printRawCommandAndArgsAndEnv, withFileContents )
 import Distribution.Simple.Configure
@@ -78,7 +93,9 @@ import Text.Regex.Posix
 
 import qualified Control.Exception as E
 import Control.Monad
+import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Writer
 import Control.Monad.IO.Class
 import qualified Data.ByteString.Char8 as C
 import Data.List
@@ -92,6 +109,7 @@ import System.FilePath
 import System.IO
 import System.IO.Error (isDoesNotExistError)
 import System.Process (runProcess, waitForProcess, showCommandForUser)
+import Test.Tasty (TestTree, askOption, testGroup)
 
 -- | Our test monad maintains an environment recording the global test
 -- suite configuration 'SuiteConfig', and the local per-test
@@ -140,6 +158,8 @@ data SuiteConfig = SuiteConfig
     , ghcPkgPath :: FilePath
     -- | Path to GHC that we should use to "./Setup --with-ghc"
     , withGhcPath :: FilePath
+    -- | Version of GHC at 'withGhcPath'.
+    , withGhcVersion :: Version
     -- | The build directory that was used to build Cabal (used
     -- to compile Setup scripts.)
     , cabalDistPref :: FilePath
@@ -604,6 +624,47 @@ assertFindInFile needle path =
 concatOutput :: String -> String
 concatOutput = unwords . lines . filter ((/=) '\r')
 
+------------------------------------------------------------------------
+-- * Test trees
+
+-- | Monad for creating test trees. The option --enable-all-tests determines
+-- whether to filter tests with 'testWhen' and 'testUnless'.
+type TestTreeM = WriterT [TestTree] (Reader OptionEnableAllTests)
+
+runTestTree :: String -> TestTreeM () -> TestTree
+runTestTree name ts = askOption $
+                      testGroup name . runReader (execWriterT ts)
+
+testTree :: SuiteConfig -> String -> Maybe String -> TestM a -> TestTreeM ()
+testTree config name subname m =
+    testTree' $ HUnit.testCase name $ runTestM config name subname m
+
+testTree' :: TestTree -> TestTreeM ()
+testTree' tc = tell [tc]
+
+-- | Create a test group from the output of the given action.
+groupTests :: String -> TestTreeM () -> TestTreeM ()
+groupTests name = censor (\ts -> [testGroup name ts])
+
+-- | Apply a function to each top-level test tree.
+mapTestTrees :: (TestTree -> TestTree) -> TestTreeM a -> TestTreeM a
+mapTestTrees = censor . map
+
+testWhen :: Bool -> TestTreeM () -> TestTreeM ()
+testWhen c test = do
+  OptionEnableAllTests enableAll <- lift ask
+  when (enableAll || c) test
+
+testUnless :: Bool -> TestTreeM () -> TestTreeM ()
+testUnless = testWhen . not
+
+unlessWindows :: TestTreeM () -> TestTreeM ()
+unlessWindows = testUnless (buildOS == Windows)
+
+hasSharedLibraries :: SuiteConfig -> Bool
+hasSharedLibraries config =
+    buildOS /= Windows || withGhcVersion config < Version [7,8] []
+
 ------------------------------------------------------------------------
 -- Verbosity
 

Cabal/tests/PackageTests/TestSuiteTests/ExeV10/Check.hs

@@ -1,13 +1,9 @@
-module PackageTests.TestSuiteTests.ExeV10.Check (
-    sharedLibTests
-  , nonSharedLibTests
-  ) where
+module PackageTests.TestSuiteTests.ExeV10.Check (tests) where
 
 import qualified Control.Exception as E (IOException, catch)
-import Control.Monad (when)
+import Control.Monad (forM_, liftM4, when)
 import Data.Maybe (catMaybes)
 import System.FilePath
-import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase)
 
 import Distribution.Compiler (CompilerFlavor(..), CompilerId(..))
@@ -24,21 +20,18 @@ import Distribution.Version (Version(..), orLaterVersion)
 
 import PackageTests.PackageTester
 
-sharedLibTests :: SuiteConfig -> [TestTree]
-sharedLibTests config = [testGroup "WithHpc" $ hpcTestMatrix True config]
-
-nonSharedLibTests :: SuiteConfig -> [TestTree]
-nonSharedLibTests config =
+tests :: SuiteConfig -> TestTreeM ()
+tests config = do
     -- TODO: hierarchy and subnaming is a little unfortunate
-    [ tc "Test" "Default" $ do
+    tc "Test" "Default" $ do
         cabal_build ["--enable-tests"]
         -- This one runs both tests, including the very LONG Foo
         -- test which prints a lot of output
         cabal "test" ["--show-details=direct"]
-    , testGroup "WithHpc" $ hpcTestMatrix False config
-    , testGroup "WithoutHpc"
+    groupTests "WithHpc" $ hpcTestMatrix config
+    groupTests "WithoutHpc" $ do
       -- Ensures that even if -fhpc is manually provided no .tix file is output.
-      [ tc "NoTix" "NoHpcNoTix" $ do
+      tc "NoTix" "NoHpcNoTix" $ do
             dist_dir <- distDir
             cabal_build
               [ "--enable-tests"
@@ -51,7 +44,7 @@ nonSharedLibTests config =
             shouldNotExist $ tixFilePath dist_dir way "test-Short"
       -- Ensures that even if a .tix file happens to be left around
       -- markup isn't generated.
-      , tc "NoMarkup" "NoHpcNoMarkup" $ do
+      tc "NoMarkup" "NoHpcNoMarkup" $ do
             dist_dir <- distDir
             let tixFile = tixFilePath dist_dir Vanilla "test-Short"
             withEnv [("HPCTIXFILE", Just tixFile)] $ do
@@ -62,20 +55,15 @@ nonSharedLibTests config =
                   , "--ghc-option=" ++ dist_dir ++ "/hpc/vanilla" ]
                 cabal "test" ["test-Short", "--show-details=direct"]
             shouldNotExist $ htmlDir dist_dir Vanilla "test-Short" </> "hpc_index.html"
-      ]
-    ]
   where
-    tc :: String -> String -> TestM a -> TestTree
+    tc :: String -> String -> TestM a -> TestTreeM ()
     tc name subname m
-        = testCase name
+        = testTree' $ testCase name
             (runTestM config "TestSuiteTests/ExeV10" (Just subname) m)
 
-hpcTestMatrix :: Bool -> SuiteConfig -> [TestTree]
-hpcTestMatrix useSharedLibs config = do
-    libProf <- [True, False]
-    exeProf <- [True, False]
-    exeDyn <- [True, False]
-    shared <- [True, False]
+hpcTestMatrix :: SuiteConfig -> TestTreeM ()
+hpcTestMatrix config = forM_ (choose4 [True, False]) $
+                       \(libProf, exeProf, exeDyn, shared) -> do
     let name | null suffixes = "Vanilla"
              | otherwise = intercalate "-" suffixes
           where
@@ -95,13 +83,10 @@ hpcTestMatrix useSharedLibs config = do
             enable cond flag
               | cond = Just $ "--enable-" ++ flag
               | otherwise = Nothing
-    -- In order to avoid duplicate tests, each combination should be used for
-    -- exactly one value of 'useSharedLibs'.
-    if (exeDyn || shared) /= useSharedLibs
-      then []
-      -- Ensure that both .tix file and markup are generated if coverage
-      -- is enabled.
-      else return $ tc name ("WithHpc-" ++ name) $ do
+    -- Ensure that both .tix file and markup are generated if coverage
+    -- is enabled.
+    testUnless ((exeDyn || shared) && not (hasSharedLibraries config)) $
+      tc name ("WithHpc-" ++ name) $ do
         isCorrectVersion <- liftIO $ correctHpcVersion
         when isCorrectVersion $ do
             dist_dir <- distDir
@@ -121,11 +106,14 @@ hpcTestMatrix useSharedLibs config = do
                 , htmlDir dist_dir way "test-Short" </> "hpc_index.html"
                 ]
   where
-    tc :: String -> String -> TestM a -> TestTree
+    tc :: String -> String -> TestM a -> TestTreeM ()
     tc name subname m
-        = testCase name
+        = testTree' $ testCase name
             (runTestM config "TestSuiteTests/ExeV10" (Just subname) m)
 
+    choose4 :: [a] -> [(a, a, a, a)]
+    choose4 xs = liftM4 (,,,) xs xs xs xs
+
 -- | Checks for a suitable HPC version for testing.
 correctHpcVersion :: IO Bool
 correctHpcVersion = do