content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE RankNTypes #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Distribution.Simple.Test
  -- Copyright   :  Thomas Tuegel 2010
  -- License     :  BSD3
  --
  -- Maintainer  :  cabal-devel@haskell.org
  -- Portability :  portable
  --
  -- This is the entry point into testing a built package. It performs the
  -- \"@.\/setup test@\" action. It runs test suites designated in the package
  -- description and reports on the results.
  
  module Distribution.Simple.Test
      ( test
      ) where
  
  import Prelude ()
  import Distribution.Compat.Prelude
  
  import Distribution.Types.UnqualComponentName
  import qualified Distribution.PackageDescription as PD
  import Distribution.Simple.Compiler
  import Distribution.Simple.Hpc
  import Distribution.Simple.InstallDirs
  import qualified Distribution.Simple.LocalBuildInfo as LBI
  import qualified Distribution.Types.LocalBuildInfo as LBI
  import Distribution.Simple.Setup
  import Distribution.Simple.UserHooks
  import qualified Distribution.Simple.Test.ExeV10 as ExeV10
  import qualified Distribution.Simple.Test.LibV09 as LibV09
  import Distribution.Simple.Test.Log
  import Distribution.Simple.Utils
  import Distribution.TestSuite
  import Distribution.Text
  
  import System.Directory
      ( createDirectoryIfMissing, doesFileExist, getDirectoryContents
      , removeFile )
  import System.Exit ( ExitCode(..), exitFailure, exitWith )
  import System.FilePath ( (</>) )
  
  -- |Perform the \"@.\/setup test@\" action.
  test :: Args                    -- ^positional command-line arguments
       -> PD.PackageDescription   -- ^information from the .cabal file
       -> LBI.LocalBuildInfo      -- ^information from the configure step
       -> TestFlags               -- ^flags sent to test
       -> IO ()
  test args pkg_descr lbi flags = do
      let verbosity = fromFlag $ testVerbosity flags
          machineTemplate = fromFlag $ testMachineLog flags
          distPref = fromFlag $ testDistPref flags
          testLogDir = distPref </> "test"
          testNames = args
          pkgTests = PD.testSuites pkg_descr
          enabledTests = LBI.enabledTestLBIs pkg_descr lbi
  
          doTest :: ((PD.TestSuite, LBI.ComponentLocalBuildInfo),
                      Maybe TestSuiteLog) -> IO TestSuiteLog
          doTest ((suite, clbi), _) =
              case PD.testInterface suite of
                PD.TestSuiteExeV10 _ _ ->
                    ExeV10.runTest pkg_descr lbi clbi flags suite
  
                PD.TestSuiteLibV09 _ _ ->
                    LibV09.runTest pkg_descr lbi clbi flags suite
  
                _ -> return TestSuiteLog
                    { testSuiteName = PD.testName suite
                    , testLogs = TestLog
                        { testName = unUnqualComponentName $ PD.testName suite
                        , testOptionsReturned = []
                        , testResult =
                            Error $ "No support for running test suite type: "
                                    ++ show (disp $ PD.testType suite)
                        }
                    , logFile = ""
                    }
  
      when (not $ PD.hasTests pkg_descr) $ do
          notice verbosity "Package has no test suites."
          exitWith ExitSuccess
  
      when (PD.hasTests pkg_descr && null enabledTests) $
          die' verbosity $
                "No test suites enabled. Did you remember to configure with "
             ++ "\'--enable-tests\'?"
  
      testsToRun <- case testNames of
              [] -> return $ zip enabledTests $ repeat Nothing
              names -> flip traverse names $ \tName ->
                  let testMap = zip enabledNames enabledTests
                      enabledNames = map (PD.testName . fst) enabledTests
                      allNames = map PD.testName pkgTests
                      tCompName = mkUnqualComponentName tName
                  in case lookup tCompName testMap of
                      Just t -> return (t, Nothing)
                      _ | tCompName `elem` allNames ->
                            die' verbosity $ "Package configured with test suite "
                                  ++ tName ++ " disabled."
                        | otherwise -> die' verbosity $ "no such test: " ++ tName
  
      createDirectoryIfMissing True testLogDir
  
      -- Delete ordinary files from test log directory.
      getDirectoryContents testLogDir
          >>= filterM doesFileExist . map (testLogDir </>)
          >>= traverse_ removeFile
  
      let totalSuites = length testsToRun
      notice verbosity $ "Running " ++ show totalSuites ++ " test suites..."
      suites <- traverse doTest testsToRun
      let packageLog = (localPackageLog pkg_descr lbi) { testSuites = suites }
          packageLogFile = (</>) testLogDir
              $ packageLogPath machineTemplate pkg_descr lbi
      allOk <- summarizePackage verbosity packageLog
      writeFile packageLogFile $ show packageLog
  
      when (LBI.testCoverage lbi) $
          markupPackage verbosity lbi distPref (display $ PD.package pkg_descr) $
              map (fst . fst) testsToRun
  
      unless allOk exitFailure
  
  packageLogPath :: PathTemplate
                 -> PD.PackageDescription
                 -> LBI.LocalBuildInfo
                 -> FilePath
  packageLogPath template pkg_descr lbi =
      fromPathTemplate $ substPathTemplate env template
      where
          env = initialPathTemplateEnv
                  (PD.package pkg_descr) (LBI.localUnitId lbi)
                  (compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi)
  