diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 15fb8e74a89..e10ca7ea595 100644 --- a/Cabal/Cabal.cabal +++ b/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 diff --git a/Cabal/tests/PackageTests.hs b/Cabal/tests/PackageTests.hs index d3cff6b801d..aa49d59180d 100644 --- a/Cabal/tests/PackageTests.hs +++ b/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 diff --git a/Cabal/tests/PackageTests/Options.hs b/Cabal/tests/PackageTests/Options.hs new file mode 100644 index 00000000000..a3a07b8c895 --- /dev/null +++ b/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) diff --git a/Cabal/tests/PackageTests/PackageTester.hs b/Cabal/tests/PackageTests/PackageTester.hs index 87de0874b84..ae97edfd072 100644 --- a/Cabal/tests/PackageTests/PackageTester.hs +++ b/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 diff --git a/Cabal/tests/PackageTests/TestSuiteTests/ExeV10/Check.hs b/Cabal/tests/PackageTests/TestSuiteTests/ExeV10/Check.hs index f08dbf3f33a..c96ff48ad78 100644 --- a/Cabal/tests/PackageTests/TestSuiteTests/ExeV10/Check.hs +++ b/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 diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index ecb698ae750..d9f0ea5c342 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/Cabal/tests/PackageTests/Tests.hs @@ -1,4 +1,4 @@ -module PackageTests.Tests(sharedLibTests, nonSharedLibTests) where +module PackageTests.Tests(tests) where import PackageTests.PackageTester @@ -10,64 +10,58 @@ import qualified PackageTests.TestSuiteTests.ExeV10.Check import Control.Monad import Data.Version -import Test.Tasty (TestTree, testGroup, mkTimeout, localOption) -import qualified Test.Tasty.HUnit as HUnit +import Test.Tasty (mkTimeout, localOption) +import Test.Tasty.HUnit (testCase) --- | Tests that do not require shared libraries. - --- TODO: turn this into a "test-defining writer monad". --- This will let us handle scoping gracefully. -nonSharedLibTests :: SuiteConfig -> [TestTree] -nonSharedLibTests config = - tail [ undefined +tests :: SuiteConfig -> TestTreeM () +tests config = do --------------------------------------------------------------------- -- * External tests -- Test that Cabal parses 'benchmark' sections correctly - , tc "BenchmarkStanza" PackageTests.BenchmarkStanza.Check.suite + tc "BenchmarkStanza" PackageTests.BenchmarkStanza.Check.suite -- Test that Cabal parses 'test' sections correctly - , tc "TestStanza" PackageTests.TestStanza.Check.suite + tc "TestStanza" PackageTests.TestStanza.Check.suite -- Test that Cabal determinstically generates object archives - , tc "DeterministicAr" PackageTests.DeterministicAr.Check.suite + tc "DeterministicAr" PackageTests.DeterministicAr.Check.suite --------------------------------------------------------------------- -- * Test suite tests - , testGroup "TestSuiteTests" + groupTests "TestSuiteTests" $ do -- Test exitcode-stdio-1.0 test suites (and HPC) - [ testGroup "ExeV10" - (PackageTests.TestSuiteTests.ExeV10.Check.nonSharedLibTests config) + groupTests "ExeV10" + (PackageTests.TestSuiteTests.ExeV10.Check.tests config) -- Test detailed-0.9 test suites - , testGroup "LibV09" $ + groupTests "LibV09" $ let - tcs :: FilePath -> TestM a -> TestTree + tcs :: FilePath -> TestM a -> TestTreeM () tcs name m - = HUnit.testCase name (runTestM config ("TestSuiteTests/LibV09") - (Just name) m) - in -- Test if detailed-0.9 builds correctly - [ tcs "Build" $ cabal_build ["--enable-tests"] - - -- Tests for #2489, stdio deadlock - , localOption (mkTimeout $ 10 ^ (8 :: Int)) - . tcs "Deadlock" $ do - cabal_build ["--enable-tests"] - shouldFail $ cabal "test" [] - ] - ] + = testTree' $ testCase name (runTestM config ("TestSuiteTests/LibV09") + (Just name) m) + in do + -- Test if detailed-0.9 builds correctly + tcs "Build" $ cabal_build ["--enable-tests"] + + -- Tests for #2489, stdio deadlock + mapTestTrees (localOption (mkTimeout $ 10 ^ (8 :: Int))) + . tcs "Deadlock" $ do + cabal_build ["--enable-tests"] + shouldFail $ cabal "test" [] --------------------------------------------------------------------- -- * Inline tests -- Test if exitcode-stdio-1.0 benchmark builds correctly - , tc "BenchmarkExeV10" $ cabal_build ["--enable-benchmarks"] + tc "BenchmarkExeV10" $ cabal_build ["--enable-benchmarks"] -- Test --benchmark-option(s) flags on ./Setup bench - , tc "BenchmarkOptions" $ do + tc "BenchmarkOptions" $ do cabal_build ["--enable-benchmarks"] cabal "bench" [ "--benchmark-options=1 2 3" ] cabal "bench" [ "--benchmark-option=1" @@ -76,7 +70,7 @@ nonSharedLibTests config = ] -- Test --test-option(s) flags on ./Setup test - , tc "TestOptions" $ do + tc "TestOptions" $ do cabal_build ["--enable-tests"] cabal "test" ["--test-options=1 2 3"] cabal "test" [ "--test-option=1" @@ -86,36 +80,36 @@ nonSharedLibTests config = -- Test attempt to have executable depend on internal -- library, but cabal-version is too old. - , tc "BuildDeps/InternalLibrary0" $ do + tc "BuildDeps/InternalLibrary0" $ do r <- shouldFail $ cabal' "configure" [] -- Should tell you how to enable the desired behavior let sb = "library which is defined within the same package." assertOutputContains sb r -- Test executable depends on internal library. - , tc "BuildDeps/InternalLibrary1" $ cabal_build [] + tc "BuildDeps/InternalLibrary1" $ cabal_build [] -- Test that internal library is preferred to an installed on -- with the same name and version - , tc "BuildDeps/InternalLibrary2" $ internal_lib_test "internal" + tc "BuildDeps/InternalLibrary2" $ internal_lib_test "internal" -- Test that internal library is preferred to an installed on -- with the same name and LATER version - , tc "BuildDeps/InternalLibrary3" $ internal_lib_test "internal" + tc "BuildDeps/InternalLibrary3" $ internal_lib_test "internal" -- Test that an explicit dependency constraint which doesn't -- match the internal library causes us to use external library - , tc "BuildDeps/InternalLibrary4" $ internal_lib_test "installed" + tc "BuildDeps/InternalLibrary4" $ internal_lib_test "installed" -- Test "old build-dep behavior", where we should get the -- same package dependencies on all targets if cabal-version -- is sufficiently old. - , tc "BuildDeps/SameDepsAllRound" $ cabal_build [] + tc "BuildDeps/SameDepsAllRound" $ cabal_build [] -- Test "new build-dep behavior", where each target gets -- separate dependencies. This tests that an executable -- dep does not leak into the library. - , tc "BuildDeps/TargetSpecificDeps1" $ do + tc "BuildDeps/TargetSpecificDeps1" $ do cabal "configure" [] r <- shouldFail $ cabal' "build" [] assertBool "error should be in MyLibrary.hs" $ @@ -125,12 +119,12 @@ nonSharedLibTests config = -- This is a control on TargetSpecificDeps1; it should -- succeed. - , tc "BuildDeps/TargetSpecificDeps2" $ cabal_build [] + tc "BuildDeps/TargetSpecificDeps2" $ cabal_build [] -- Test "new build-dep behavior", where each target gets -- separate dependencies. This tests that an library -- dep does not leak into the executable. - , tc "BuildDeps/TargetSpecificDeps3" $ do + tc "BuildDeps/TargetSpecificDeps3" $ do cabal "configure" [] r <- shouldFail $ cabal' "build" [] assertBool "error should be in lemon.hs" $ @@ -139,34 +133,39 @@ nonSharedLibTests config = resultOutput r =~ "Could not find module.*Text\\.PrettyPrint" -- Test that Paths module is generated and available for executables. - , tc "PathsModule/Executable" $ cabal_build [] + tc "PathsModule/Executable" $ cabal_build [] -- Test that Paths module is generated and available for libraries. - , tc "PathsModule/Library" $ cabal_build [] + tc "PathsModule/Library" $ cabal_build [] -- Check that preprocessors (hsc2hs) are run - , tc "PreProcess" $ cabal_build ["--enable-tests", "--enable-benchmarks"] + tc "PreProcess" $ cabal_build ["--enable-tests", "--enable-benchmarks"] -- Check that preprocessors that generate extra C sources are handled - , tc "PreProcessExtraSources" $ cabal_build ["--enable-tests", "--enable-benchmarks"] + tc "PreProcessExtraSources" $ cabal_build ["--enable-tests", "--enable-benchmarks"] -- Test building a vanilla library/executable which uses Template Haskell - , tc "TemplateHaskell/vanilla" $ cabal_build [] + tc "TemplateHaskell/vanilla" $ cabal_build [] -- Test building a profiled library/executable which uses Template Haskell -- (Cabal has to build the non-profiled version first) - , tc "TemplateHaskell/profiling" $ cabal_build ["--enable-library-profiling", "--enable-profiling"] + tc "TemplateHaskell/profiling" $ cabal_build ["--enable-library-profiling", "--enable-profiling"] + + -- Test building a dynamic library/executable which uses Template + -- Haskell + testWhen (hasSharedLibraries config) $ + tc "TemplateHaskell/dynamic" $ cabal_build ["--enable-shared", "--enable-executable-dynamic"] -- Test building an executable whose main() function is defined in a C -- file - , tc "CMain" $ cabal_build [] + tc "CMain" $ cabal_build [] -- Test build when the library is empty, for #1241 - , tc "EmptyLib" $ + tc "EmptyLib" $ withPackage "empty" $ cabal_build [] -- Test that "./Setup haddock" works correctly - , tc "Haddock" $ do + tc "Haddock" $ do dist_dir <- distDir let haddocksDir = dist_dir "doc" "html" "Haddock" cabal "configure" [] @@ -177,21 +176,21 @@ nonSharedLibTests config = mapM_ (assertFindInFile "For hiding needles.") docFiles -- Test that Haddock with a newline in synopsis works correctly, #3004 - , tc "HaddockNewline" $ do + tc "HaddockNewline" $ do cabal "configure" [] cabal "haddock" [] -- Test that Cabal properly orders GHC flags passed to GHC (when -- there are multiple ghc-options fields.) - , tc "OrderFlags" $ cabal_build [] + tc "OrderFlags" $ cabal_build [] -- Test that reexported modules build correctly -- TODO: should also test that they import OK! - , tc "ReexportedModules" $ do + tc "ReexportedModules" $ do whenGhcVersion (>= Version [7,9] []) $ cabal_build [] -- Test that Cabal computes different IPIDs when the source changes. - , tc "UniqueIPID" . withPackageDb $ do + tc "UniqueIPID" . withPackageDb $ do withPackage "P1" $ cabal "configure" [] withPackage "P2" $ cabal "configure" [] withPackage "P1" $ cabal "build" [] @@ -205,7 +204,7 @@ nonSharedLibTests config = assertFailure $ "cabal has not calculated different Installed " ++ "package ID when source is changed." - , tc "DuplicateModuleName" $ do + tc "DuplicateModuleName" $ do cabal_build ["--enable-tests"] r1 <- shouldFail $ cabal' "test" ["foo"] assertOutputContains "test B" r1 @@ -214,7 +213,7 @@ nonSharedLibTests config = assertOutputContains "test C" r2 assertOutputContains "test A" r2 - , tc "TestNameCollision" $ do + tc "TestNameCollision" $ do withPackageDb $ do withPackage "parent" $ cabal_install [] withPackage "child" $ do @@ -222,7 +221,7 @@ nonSharedLibTests config = cabal "test" [] -- Test that '--allow-newer' works via the 'Setup.hs configure' interface. - , tc "AllowNewer" $ do + tc "AllowNewer" $ do shouldFail $ cabal "configure" [] cabal "configure" ["--allow-newer"] shouldFail $ cabal "configure" ["--allow-newer=baz,quux"] @@ -249,21 +248,22 @@ nonSharedLibTests config = -- Test that Cabal can choose flags to disable building a component when that -- component's dependencies are unavailable. The build should succeed without -- requiring the component's dependencies or imports. - , tc "BuildableField" $ do - r <- cabal' "configure" ["-v"] - assertOutputContains "Flags chosen: build-exe=False" r - cabal "build" [] - - , tc "GhcPkgGuess/SameDirectory" $ ghc_pkg_guess "ghc" - , tc "GhcPkgGuess/SameDirectoryVersion" $ ghc_pkg_guess "ghc-7.10" - , tc "GhcPkgGuess/SameDirectoryGhcVersion" $ ghc_pkg_guess "ghc-7.10" + tc "BuildableField" $ do + r <- cabal' "configure" ["-v"] + assertOutputContains "Flags chosen: build-exe=False" r + cabal "build" [] + + -- TODO: Enable these tests on Windows + unlessWindows $ do + tc "GhcPkgGuess/SameDirectory" $ ghc_pkg_guess "ghc" + tc "GhcPkgGuess/SameDirectoryVersion" $ ghc_pkg_guess "ghc-7.10" + tc "GhcPkgGuess/SameDirectoryGhcVersion" $ ghc_pkg_guess "ghc-7.10" + + unlessWindows $ do + tc "GhcPkgGuess/Symlink" $ ghc_pkg_guess "ghc" + tc "GhcPkgGuess/SymlinkVersion" $ ghc_pkg_guess "ghc" + tc "GhcPkgGuess/SymlinkGhcVersion" $ ghc_pkg_guess "ghc" - -- TODO: Disable these tests on Windows - , tc "GhcPkgGuess/Symlink" $ ghc_pkg_guess "ghc" - , tc "GhcPkgGuess/SymlinkVersion" $ ghc_pkg_guess "ghc" - , tc "GhcPkgGuess/SymlinkGhcVersion" $ ghc_pkg_guess "ghc" - - ] where ghc_pkg_guess bin_name = do cwd <- packageDir @@ -283,29 +283,5 @@ nonSharedLibTests config = ("foo foo myLibFunc " ++ expect) (concatOutput (resultOutput r)) - tc :: FilePath -> TestM a -> TestTree - tc = testCase config - --- | Tests that require shared libraries. -sharedLibTests :: SuiteConfig -> [TestTree] -sharedLibTests config = - tail [ undefined - - , testGroup "TestSuiteTests" - - -- Test exitcode-stdio-1.0 test suites (and HPC) using - -- --enable-executable-dynamic and --enable-shared - [ testGroup "ExeV10" - (PackageTests.TestSuiteTests.ExeV10.Check.sharedLibTests config) - ] - - -- Test building a dynamic library/executable which uses Template - -- Haskell - , testCase config "TemplateHaskell/dynamic" $ - cabal_build ["--enable-shared", "--enable-executable-dynamic"] - - ] - -testCase :: SuiteConfig -> FilePath -> TestM a -> TestTree -testCase config name m - = HUnit.testCase name (runTestM config name Nothing m) + tc :: FilePath -> TestM a -> TestTreeM () + tc name = testTree config name Nothing diff --git a/appveyor.yml b/appveyor.yml index e2845e2c3a7..d76d1c8cb60 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -14,7 +14,7 @@ build_script: - Setup configure --user --ghc-option=-Werror --enable-tests - Setup build - Setup test unit-tests --show-details=streaming - - Setup test package-tests --show-details=streaming --test-option=--skip-shared-library-tests --test-option=--pattern=!GhcPkgGuess + - Setup test package-tests --show-details=streaming - Setup install - cd ..\cabal-install - ghc --make -threaded -i -i. Setup.hs -Wall -Werror